more wip

.clj-kondo/config.edn

@@ -45,15 +45,6 @@
   :redundant-do
   {:level :off}
 
-  :earmuffed-var-not-dynamic
-  {:level :off}
-
-  :dynamic-var-not-earmuffed
-  {:level :off}
-
-  :used-underscored-binding
-  {:level :warning}
-
   :unused-binding
   {:exclude-destructured-as true
    :exclude-destructured-keys-in-fn-args false

CHANGES.md

@@ -1,28 +1,14 @@
 # CHANGELOG
 
-## :rocket: Next
+## :rocket: Next (1.17)
 
 ### :boom: Breaking changes & Deprecations
-
-### :sparkles: New features
-
-### :bug: Bugs fixed
-
-### :arrow_up: Deps updates
-
-### :heart: Community contributions by (Thank you!)
-
-
-## 1.17.0
-
 ### :sparkles: New features
 
 - Adds layout flex functionality for boards
 - Better overlays interactions on boards inside boards [Taiga #4386](https://tree.taiga.io/project/penpot/us/4386)
 - Show board miniature in manual overlay setting [Taiga #4475](https://tree.taiga.io/project/penpot/issue/4475)
 - Handoff visual improvements [Taiga #3124](https://tree.taiga.io/project/penpot/us/3124)
-- Dynamic alignment only in sight [Github 1971](https://github.com/penpot/penpot/issues/1971)
-- Add some accessibility to shortcut panel [Taiga #4713](https://tree.taiga.io/project/penpot/issue/4713)
 
 ### :bug: Bugs fixed
 
@@ -33,43 +19,11 @@
 - Fix twitter support account link [Taiga #4279](https://tree.taiga.io/project/penpot/issue/4279)
 - Fix lang autodetect issue [Taiga #4277](https://tree.taiga.io/project/penpot/issue/4277)
 - Fix adding an extra page on import [Taiga #4543](https://tree.taiga.io/project/penpot/task/4543)
-- Fix unable to select text at assets inputs in firefox [Taiga #4572](https://tree.taiga.io/project/penpot/issue/4572)
-- Fix component sync when converting to path [Taiga #3642](https://tree.taiga.io/project/penpot/issue/3642)
-- Fix style for team invite in deutsch [Taiga #4614](https://tree.taiga.io/project/penpot/issue/4614)
-- Fix problem with text edition in Safari [Taiga #4046](https://tree.taiga.io/project/penpot/issue/4046)
-- Fix show outline with rounded corners on rects [Taiga #4053](https://tree.taiga.io/project/penpot/issue/4053)
-- Fix wrong interaction between comments and panning modes [Taiga #4297](https://tree.taiga.io/project/penpot/issue/4297)
-- Fix bad element positioning on interaction with fixed scroll [Github #2660](https://github.com/penpot/penpot/issues/2660)
-- Fix display type of component library not persistent [Taiga #4512](https://tree.taiga.io/project/penpot/issue/4512)
-- Fix problem when moving texts with keyboard [#2690](https://github.com/penpot/penpot/issues/2690)
-- Fix problem when drawing boxes won't detect mouse-up [Taiga #4618](https://tree.taiga.io/project/penpot/issue/4618)
-- Fix missing loading icon on shared libraries [Taiga #4148](https://tree.taiga.io/project/penpot/issue/4148)
-- Fix selection stroke missing in properties of multiple texts [Taiga #4048](https://tree.taiga.io/project/penpot/issue/4048)
-- Fix missing create component menu for frames [Github #2670](https://github.com/penpot/penpot/issues/2670)
-- Fix "currentColor" is not converted when importing SVG [Github 2276](https://github.com/penpot/penpot/issues/2276)
-- Fix incorrect color in properties of multiple bool shapes [Taiga #4355](https://tree.taiga.io/project/penpot/issue/4355)
-- Fix pressing the enter key gives you an internal error [Github 2675](https://github.com/penpot/penpot/issues/2675) [Github 2577](https://github.com/penpot/penpot/issues/2577)
-- Fix confirm group name with enter doesn't work in assets modal [Taiga #4506](https://tree.taiga.io/project/penpot/issue/4506)
-- Fix group/ungroup shapes inside a component [Taiga #4052](https://tree.taiga.io/project/penpot/issue/4052)
-- Fix wrong update of text in components [Taiga #4646](https://tree.taiga.io/project/penpot/issue/4646)
-- Fix problem with SVG imports with style [#2605](https://github.com/penpot/penpot/issues/2605)
-- Fix ghost shapes after sync groups in components [Taiga #4649](https://tree.taiga.io/project/penpot/issue/4649)
-- Fix layer orders messed up on move, group, reparent and undo [Github #2672](https://github.com/penpot/penpot/issues/2672)
-- Fix max height in library dialog [Github #2335](https://github.com/penpot/penpot/issues/2335)
-- Fix undo ungroup (shift+g) scrambles positions [Taiga #4674](https://tree.taiga.io/project/penpot/issue/4674)
-- Fix justified text is stretched [Github #2539](https://github.com/penpot/penpot/issues/2539)
-- Fix mousewheel on viewer inspector [Taiga #4221](https://tree.taiga.io/project/penpot/issue/4221)
-- Fix path edition activated on boards [Taiga #4105](https://tree.taiga.io/project/penpot/issue/4105)
-- Fix hidden layers inside groups become visible after the group visibility is changed[Taiga #4710](https://tree.taiga.io/project/penpot/issue/4710)
-- Fix format of HSLA color on viewer [Taiga #4393](https://tree.taiga.io/project/penpot/issue/4393)
-- Fix some typos [Taiga #4724](https://tree.taiga.io/project/penpot/issue/4724)
 
+### :arrow_up: Deps updates
+### :heart: Community contributions by (Thank you!)
 ## 1.16.2-beta
 
-### :bug: Bugs fixed
-
-- Fix strage cursor behaviour after clicking viewport with text pool [Github #2447](https://github.com/penpot/penpot/issues/2447)
-
 ## 1.16.1-beta
 
 ### :bug: Bugs fixed
@@ -137,6 +91,7 @@
 - Fix grid not syncing immediately in multiuser [Taiga #4339](https://tree.taiga.io/project/penpot/issue/4339)
 - Fix custom font upload fails silently for unsupported formats [Taiga #4279](https://tree.taiga.io/project/penpot/issue/4280)
 
+### :arrow_up: Deps updates
 ### :heart: Community contributions by (Thank you!)
 
 - To @andrewzhurov for many code contributions on this release.

backend/deps.edn

@@ -1,12 +1,12 @@
 {:deps
  {penpot/common {:local/root "../common"}
   org.clojure/clojure {:mvn/version "1.11.1"}
-  org.clojure/core.async {:mvn/version "1.6.673"}
+  org.clojure/core.async {:mvn/version "1.5.648"}
 
   ;; Logging
-  org.zeromq/jeromq {:mvn/version "0.5.3"}
+  org.zeromq/jeromq {:mvn/version "0.5.2"}
 
-  com.github.luben/zstd-jni {:mvn/version "1.5.2-5"}
+  com.github.luben/zstd-jni {:mvn/version "1.5.2-4"}
   org.clojure/data.fressian {:mvn/version "1.0.0"}
 
   io.prometheus/simpleclient {:mvn/version "0.16.0"}
@@ -18,7 +18,7 @@
 
   io.prometheus/simpleclient_httpserver {:mvn/version "0.16.0"}
 
-  io.lettuce/lettuce-core {:mvn/version "6.2.2.RELEASE"}
+  io.lettuce/lettuce-core {:mvn/version "6.2.1.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
   funcool/yetti
@@ -27,9 +27,9 @@
    :git/url "https://github.com/funcool/yetti.git"
    :exclusions [org.slf4j/slf4j-api]}
 
-  com.github.seancorfield/next.jdbc {:mvn/version "1.3.847"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.3.834"}
   metosin/reitit-core {:mvn/version "0.5.18"}
-  org.postgresql/postgresql {:mvn/version "42.5.1"}
+  org.postgresql/postgresql {:mvn/version "42.5.0"}
   com.zaxxer/HikariCP {:mvn/version "5.0.1"}
 
   io.whitfin/siphash {:mvn/version "2.0.0"}
@@ -37,9 +37,9 @@
   buddy/buddy-hashers {:mvn/version "1.8.158"}
   buddy/buddy-sign {:mvn/version "3.4.333"}
 
-  com.github.ben-manes.caffeine/caffeine {:mvn/version "3.1.2"}
+  com.github.ben-manes.caffeine/caffeine {:mvn/version "3.1.1"}
 
-  org.jsoup/jsoup {:mvn/version "1.15.3"}
+  org.jsoup/jsoup {:mvn/version "1.15.1"}
   org.im4java/im4java
   {:git/tag "1.4.0-penpot-2"
    :git/sha "e2b3e16"
@@ -51,12 +51,11 @@
   integrant/integrant {:mvn/version "0.8.0"}
 
   dawran6/emoji {:mvn/version "0.1.5"}
-  markdown-clj/markdown-clj {:mvn/version "1.11.4"}
+  markdown-clj/markdown-clj {:mvn/version "1.11.3"}
 
   ;; Pretty Print specs
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
-  software.amazon.awssdk/s3 {:mvn/version "2.19.8"}
-  }
+  software.amazon.awssdk/s3 {:mvn/version "2.17.278"}}
 
  :paths ["src" "resources" "target/classes"]
  :aliases
@@ -70,10 +69,8 @@
     mockery/mockery {:mvn/version "RELEASE"}}
    :extra-paths ["test" "dev"]}
 
-
   :build
-  {:extra-deps
-   {io.github.clojure/tools.build {:git/tag "v0.9.0" :git/sha "8c93e0c"}}
+  {:extra-deps {io.github.clojure/tools.build {:git/tag "v0.8.3" :git/sha "0d20256"}}
    :ns-default build}
 
   :test

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

@@ -6,21 +6,14 @@
     <div class="tags">
       {% if item.deprecated %}
         <span class="tag">
-          <span>DEPRECATED</span>
-        </span>
-      {% endif %}
-
-      {% if item.auth %}
-        <span class="tag">
-          <span>AUTH</span>
-        </span>
-      {% endif %}
-      
-      {% if item.webhook %}
-        <span class="tag">
-          <span>WEBHOOK</span>
+          <span>Deprecated:</span>
+          <span>since v{{item.deprecated}}</span>,
         </span>
       {% endif %}
+      <span class="tag">
+        <span>Auth:</span>
+        <span>{% if item.auth %}YES{% else %}NO{% endif %}</span>
+      </span>
     </div>
   </div>
   <div class="rpc-row-detail hidden">

backend/resources/rlimit.edn

@@ -3,8 +3,8 @@
 {:default
  [[:default :window "200000/h"]]
 
- #{:command/get-teams}
+ #{:query/teams}
  [[:burst :bucket "5/1/5s"]]
 
- #{:command/get-profile}
- [[:burst :bucket "60/60/1m"]]}
+ #{:query/profile}
+ [[:burst :bucket "100/60/1m"]]}

backend/scripts/build

@@ -13,9 +13,9 @@ cp ../CHANGES.md target/classes/changelog.md;
 clojure -T:build jar;
 mv target/penpot.jar target/dist/penpot.jar
 cp scripts/run.template.sh target/dist/run.sh;
-cp scripts/manage.py target/dist/manage.py
+cp scripts/manage.template.sh target/dist/manage.sh;
 chmod +x target/dist/run.sh;
-chmod +x target/dist/manage.py
+chmod +x target/dist/manage.sh;
 
 # Prefetch
 bb ./scripts/prefetch-templates.clj resources/app/onboarding.edn builtin-templates/

backend/scripts/manage.py

@@ -1,167 +0,0 @@
-#!/usr/bin/env python3
-#
-# 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
-
-import argparse
-import json
-import socket
-import sys
-
-from getpass import getpass
-from urllib.parse import urlparse
-
-PREPL_URI = "tcp://localhost:6063"
-
-def get_prepl_conninfo():
-    uri_data = urlparse(PREPL_URI)
-    if uri_data.scheme != "tcp":
-        raise RuntimeException(f"invalid PREPL_URI: {PREPL_URI}")
-
-    if not isinstance(uri_data.netloc, str):
-        raise RuntimeException(f"invalid PREPL_URI: {PREPL_URI}")
-
-    host, port = uri_data.netloc.split(":", 2)
-
-    if port is None:
-        port = 6063
-
-    if isinstance(port, str):
-        port = int(port)
-
-    return host, port
-
-def send_eval(expr):
-    host, port = get_prepl_conninfo()
-
-    with socket.socket(socket.AF_INET, socket.SOCK_STREAM) as s:
-        s.connect((host, port))
-        s.send(expr.encode("utf-8"))
-        s.send(b":repl/quit\n\n")
-
-        with s.makefile() as f:
-            result = json.load(f)
-            tag = result.get("tag", None)
-            if tag != "ret":
-                raise RuntimeException("unexpected response from PREPL")
-            return result.get("val", None), result.get("exception", None)
-
-def encode(val):
-    return json.dumps(json.dumps(val))
-
-def print_error(res):
-    for error in res["via"]:
-        print("ERR:", error["message"])
-        break
-
-def run_cmd(params):
-    expr = "(app.srepl.ext/run-json-cmd {})".format(encode(params))
-    res, failed = send_eval(expr)
-    if failed:
-        print_error(res)
-        sys.exit(-1)
-
-    return res
-
-def create_profile(fullname, email, password):
-    params = {
-        "cmd": "create-profile",
-        "params": {
-            "fullname": fullname,
-            "email": email,
-            "password": password
-        }
-    }
-
-    res = run_cmd(params)
-    print(f"Created: {res['email']} / {res['id']}")
-
-def update_profile(email, fullname, password, is_active):
-    params = {
-        "cmd": "update-profile",
-        "params": {
-            "email": email,
-            "fullname": fullname,
-            "password": password,
-            "is_active": is_active
-        }
-    }
-
-    res = run_cmd(params)
-    if res is True:
-        print(f"Updated")
-    else:
-        print(f"No profile found with email {email}")
-
-def derive_password(password):
-    params = {
-        "cmd": "derive-password",
-        "params": {
-            "password": password,
-        }
-    }
-
-    res = run_cmd(params)
-    print(f"Derived password: \"{res}\"")
-
-available_commands = [
-    "create-profile",
-    "update-profile",
-    "derive-password"
-]
-
-parser = argparse.ArgumentParser(
-    description=(
-        "Penpot Command Line Interface (CLI)"
-    )
-)
-
-parser.add_argument("-V", "--version", action="version", version="Penpot CLI %%develop%%")
-parser.add_argument("action", action="store", choices=available_commands)
-parser.add_argument("-n", "--fullname", help="Fullname", action="store")
-parser.add_argument("-e", "--email", help="Email", action="store")
-parser.add_argument("-p", "--password", help="Password", action="store")
-parser.add_argument("-c", "--connect", help="Connect to PREPL", action="store", default="tcp://localhost:6063")
-
-args = parser.parse_args()
-
-PREPL_URI = args.connect
-
-if args.action == "create-profile":
-    email = args.email
-    password = args.password
-    fullname = args.fullname
-
-    if email is None:
-        email = input("Email: ")
-
-    if fullname is None:
-        fullname = input("Fullname: ")
-
-    if password is None:
-        password = getpass("Password: ")
-
-    create_profile(fullname, email, password)
-
-elif args.action == "update-profile":
-    email = args.email
-    password = args.password
-
-    if email is None:
-        email = input("Email: ")
-
-    if password is None:
-        password = getpass("Password: ")
-
-    update_profile(email, None, password, None)
-
-elif args.action == "derive-password":
-    password = args.password
-
-    if password is None:
-        password = getpass("Password: ")
-
-    derive_password(password)

backend/scripts/manage.template.sh

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

backend/scripts/repl

@@ -2,21 +2,7 @@
 
 export PENPOT_HOST=devenv
 export PENPOT_TENANT=dev
-export PENPOT_FLAGS="\
-       $PENPOT_FLAGS \
-       enable-backend-asserts \
-       enable-audit-log \
-       enable-transit-readable-response \
-       enable-demo-users \
-       disable-secure-session-cookies \
-       enable-smtp \
-       enable-prepl-server \
-       enable-urepl-server \
-       enable-rpc-climit \
-       enable-rpc-rlimit \
-       enable-soft-rpc-rlimit \
-       enable-webhooks \
-       enable-access-tokens";
+export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp"
 
 # export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot"
 # export PENPOT_DATABASE_USERNAME="penpot"
@@ -45,12 +31,11 @@ export PENPOT_STORAGE_ASSETS_S3_BUCKET=penpot
 export OPTIONS="
        -A:jmx-remote -A:dev \
        -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-       -J-Djdk.attach.allowAttachSelf \
        -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
-       -J-Xms50m \
-       -J-Xmx1024m \
-       -J-XX:+UseZGC \
+       -J-XX:+UseG1GC \
        -J-XX:-OmitStackTraceInFastThrow \
+       -J-Xms50m -J-Xmx1024m \
+       -J-Djdk.attach.allowAttachSelf \
        -J-XX:+UnlockDiagnosticVMOptions \
        -J-XX:+DebugNonSafepoints";
 

backend/scripts/start-dev

@@ -2,7 +2,7 @@
 
 export PENPOT_HOST=devenv
 export PENPOT_TENANT=dev
-export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp enable-webhooks"
+export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp"
 
 set -ex
 

backend/src/app/auth.clj

@@ -1,26 +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.auth
-  (:require
-   [buddy.hashers :as hashers]))
-
-(defn derive-password
-  [password]
-  (hashers/derive password
-                  {:alg :argon2id
-                   :memory 16384
-                   :iterations 20
-                   :parallelism 2}))
-
-(defn verify-password
-  [attempt password]
-  (try
-    (hashers/verify attempt password)
-    (catch Throwable _
-      {:update false
-       :valid false})))
-

backend/src/app/auth/ldap.clj

@@ -41,18 +41,15 @@
   (reduce-kv clojure.string/replace s replacements))
 
 (defn- search-user
-  [{:keys [::conn base-dn] :as cfg} email]
-  (let [query  (replace-several (:query cfg) ":username" email)
-        attrs  [(:attrs-username cfg)
-                (:attrs-email cfg)
-                (:attrs-fullname cfg)]
+  [{:keys [conn attrs base-dn] :as cfg} email]
+  (let [query   (replace-several (:query cfg) ":username" email)
         params  {:filter query
                  :sizelimit 1
                  :attributes attrs}]
     (first (ldap/search conn base-dn params))))
 
 (defn- retrieve-user
-  [{:keys [::conn] :as cfg} {:keys [email password]}]
+  [{:keys [conn] :as cfg} {:keys [email password]}]
   (when-let [{:keys [dn] :as user} (search-user cfg email)]
     (when (ldap/bind? conn dn password)
       {:fullname (get user (-> cfg :attrs-fullname keyword))
@@ -69,7 +66,7 @@
 (defn authenticate
   [cfg params]
   (with-open [conn (connect cfg)]
-    (when-let [user (-> (assoc cfg ::conn conn)
+    (when-let [user (-> (assoc cfg :conn conn)
                         (retrieve-user params))]
       (when-not (s/valid? ::info-data user)
         (let [explain (s/explain-str ::info-data user)]
@@ -103,6 +100,17 @@
                  :host (:host cfg) :port (:port cfg) :cause cause)
         nil))))
 
+(defn- prepare-attributes
+  [cfg]
+  (assoc cfg :attrs [(:attrs-username cfg)
+                     (:attrs-email cfg)
+                     (:attrs-fullname cfg)]))
+
+(defmethod ig/init-key ::provider
+  [_ cfg]
+  (when (:enabled? cfg)
+    (some-> cfg try-connectivity prepare-attributes)))
+
 (s/def ::enabled? ::us/boolean)
 (s/def ::host ::cf/ldap-host)
 (s/def ::port ::cf/ldap-port)
@@ -116,7 +124,8 @@
 (s/def ::attrs-fullname ::cf/ldap-attrs-fullname)
 (s/def ::attrs-username ::cf/ldap-attrs-username)
 
-(s/def ::provider-params
+(defmethod ig/pre-init-spec ::provider
+  [_]
   (s/keys :opt-un [::host ::port
                    ::ssl ::tls
                    ::enabled?
@@ -126,14 +135,3 @@
                    ::attrs-email
                    ::attrs-username
                    ::attrs-fullname]))
-(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)
-    (try-connectivity cfg)))

backend/src/app/auth/oidc.clj

@@ -21,7 +21,7 @@
    [app.http.session :as session]
    [app.loggers.audit :as audit]
    [app.main :as-alias main]
-   [app.rpc.commands.profile :as profile]
+   [app.rpc.queries.profile :as profile]
    [app.tokens :as tokens]
    [app.util.json :as json]
    [app.util.time :as dt]
@@ -349,7 +349,7 @@
                    ::fullname
                    ::props]))
 
-(defn get-info
+(defn retrieve-info
   [{:keys [provider] :as cfg} {:keys [params] :as request}]
   (letfn [(validate-oidc [info]
             ;; If the provider is OIDC, we can proceed to check
@@ -396,12 +396,14 @@
           (p/then' validate-oidc)
           (p/then' (partial post-process state))))))
 
-(defn- get-profile
+(defn- retrieve-profile
   [{:keys [::db/pool ::wrk/executor] :as cfg} info]
   (px/with-dispatch executor
     (with-open [conn (db/open pool)]
       (some->> (:email info)
-               (profile/get-profile-by-email conn)))))
+               (profile/retrieve-profile-data-by-email conn)
+               (profile/populate-additional-data conn)
+               (profile/decode-profile-row)))))
 
 (defn- redirect-response
   [uri]
@@ -415,9 +417,9 @@
     (redirect-response uri)))
 
 (defn- generate-redirect
-  [cfg request info profile]
+  [{:keys [::session/session] :as cfg} request info profile]
   (if profile
-    (let [sxf    (session/create-fn cfg (:id profile))
+    (let [sxf    (session/create-fn session (:id profile))
           token  (or (:invitation-token info)
                      (tokens/generate (::main/props cfg)
                                       {:iss :auth
@@ -434,7 +436,7 @@
 
       (when-let [collector (::audit/collector cfg)]
         (audit/submit! collector {:type "command"
-                                  :name "login-with-password"
+                                  :name "login"
                                   :profile-id (:id profile)
                                   :ip-addr (audit/parse-client-ip request)
                                   :props (audit/profile->props profile)}))
@@ -469,8 +471,8 @@
 (defn- callback-handler
   [cfg request]
   (letfn [(process-request []
-            (p/let [info    (get-info cfg request)
-                    profile (get-profile cfg info)]
+            (p/let [info    (retrieve-info cfg request)
+                    profile (retrieve-profile cfg info)]
               (generate-redirect cfg request info profile)))
 
           (handle-error [cause]
@@ -522,24 +524,23 @@
 
 (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
+  (s/keys :req [::http/client
                 ::wrk/executor
                 ::main/props
                 ::db/pool
-                ::providers]))
+                ::providers
+                ::session/session]))
 
 (defmethod ig/init-key ::routes
-  [_ {:keys [::wrk/executor] :as cfg}]
+  [_ {:keys [::wrk/executor ::session/session] :as cfg}]
   (let [cfg (update cfg :provider d/without-nils)]
-    ["" {:middleware [[session/authz cfg]
+    ["" {:middleware [[(:middleware session)]
                       [hmw/with-dispatch executor]
                       [hmw/with-config cfg]
-                      [provider-lookup]]}
+                      [provider-lookup]
+                      ]}
      ["/auth/oauth"
       ["/:provider"
        {:handler auth-handler
@@ -547,3 +548,4 @@
       ["/:provider/callback"
        {:handler callback-handler
         :allowed-methods #{:get}}]]]))
+

backend/src/app/cli/manage.clj

@@ -10,8 +10,9 @@
    [app.common.logging :as l]
    [app.db :as db]
    [app.main :as main]
-   [app.rpc.commands.auth :as auth]
-   [app.rpc.commands.profile :as profile]
+   [app.rpc.commands.auth :as cmd.auth]
+   [app.rpc.mutations.profile :as profile]
+   [app.rpc.queries.profile :refer [retrieve-profile-data-by-email]]
    [clojure.string :as str]
    [clojure.tools.cli :refer [parse-opts]]
    [integrant.core :as ig])
@@ -54,17 +55,16 @@
                                          :type :password}))]
     (try
       (db/with-atomic [conn (:app.db/pool system)]
-        (->> (auth/create-profile! conn
-                                  {:fullname fullname
-                                   :email email
-                                   :password password
-                                   :is-active true
-                                   :is-demo false})
-             (auth/create-profile-rels! conn)))
+        (->> (cmd.auth/create-profile conn
+                                     {:fullname fullname
+                                      :email email
+                                      :password password
+                                      :is-active true
+                                      :is-demo false})
+             (cmd.auth/create-profile-relations conn)))
 
       (when (pos? (:verbosity options))
         (println "User created successfully."))
-
       (System/exit 0)
 
       (catch Exception _e
@@ -79,7 +79,7 @@
       (db/with-atomic [conn (:app.db/pool system)]
         (let [email    (or (:email options)
                            (read-from-console {:label "Email:"}))
-              profile  (profile/get-profile-by-email conn email)]
+              profile  (retrieve-profile-data-by-email conn email)]
           (when-not profile
             (when (pos? (:verbosity options))
               (println "Profile does not exists."))

backend/src/app/config.clj

@@ -61,9 +61,11 @@
 
    :public-uri "http://localhost:3449"
    :host "localhost"
-   :tenant "default"
+   :tenant "main"
 
    :redis-uri "redis://redis/0"
+   :srepl-host "127.0.0.1"
+   :srepl-port 6062
 
    :assets-storage-backend :assets-fs
    :storage-assets-fs-directory "assets"
@@ -100,7 +102,7 @@
 (s/def ::audit-log-archive-uri ::us/string)
 (s/def ::audit-log-http-handler-concurrency ::us/integer)
 
-(s/def ::admins ::us/set-of-valid-emails)
+(s/def ::admins ::us/set-of-strings)
 (s/def ::file-change-snapshot-every ::us/integer)
 (s/def ::file-change-snapshot-timeout ::dt/duration)
 
@@ -125,17 +127,6 @@
 (s/def ::database-min-pool-size ::us/integer)
 (s/def ::database-max-pool-size ::us/integer)
 
-(s/def ::quotes-teams-per-profile ::us/integer)
-(s/def ::quotes-access-tokens-per-profile ::us/integer)
-(s/def ::quotes-projects-per-team ::us/integer)
-(s/def ::quotes-invitations-per-team ::us/integer)
-(s/def ::quotes-profiles-per-team ::us/integer)
-(s/def ::quotes-files-per-project ::us/integer)
-(s/def ::quotes-files-per-team ::us/integer)
-(s/def ::quotes-font-variants-per-team ::us/integer)
-(s/def ::quotes-comment-threads-per-file ::us/integer)
-(s/def ::quotes-comments-per-file ::us/integer)
-
 (s/def ::default-blob-version ::us/integer)
 (s/def ::error-report-webhook ::us/string)
 (s/def ::user-feedback-destination ::us/string)
@@ -195,15 +186,18 @@
 (s/def ::smtp-ssl ::us/boolean)
 (s/def ::smtp-tls ::us/boolean)
 (s/def ::smtp-username (s/nilable ::us/string))
-(s/def ::urepl-host ::us/string)
-(s/def ::urepl-port ::us/integer)
-(s/def ::prepl-host ::us/string)
-(s/def ::prepl-port ::us/integer)
+(s/def ::srepl-host ::us/string)
+(s/def ::srepl-port ::us/integer)
 (s/def ::assets-storage-backend ::us/keyword)
+(s/def ::fdata-storage-backend ::us/keyword)
 (s/def ::storage-assets-fs-directory ::us/string)
 (s/def ::storage-assets-s3-bucket ::us/string)
 (s/def ::storage-assets-s3-region ::us/keyword)
 (s/def ::storage-assets-s3-endpoint ::us/string)
+(s/def ::storage-fdata-s3-bucket ::us/string)
+(s/def ::storage-fdata-s3-region ::us/keyword)
+(s/def ::storage-fdata-s3-prefix ::us/string)
+(s/def ::storage-fdata-s3-endpoint ::us/string)
 (s/def ::telemetry-uri ::us/string)
 (s/def ::telemetry-with-taiga ::us/boolean)
 (s/def ::tenant ::us/string)
@@ -280,18 +274,6 @@
                    ::profile-complaint-max-age
                    ::profile-complaint-threshold
                    ::public-uri
-
-                   ::quotes-teams-per-profile
-                   ::quotes-access-tokens-per-profile
-                   ::quotes-projects-per-team
-                   ::quotes-invitations-per-team
-                   ::quotes-profiles-per-team
-                   ::quotes-files-per-project
-                   ::quotes-files-per-team
-                   ::quotes-font-variants-per-team
-                   ::quotes-comment-threads-per-file
-                   ::quotes-comments-per-file
-
                    ::redis-uri
                    ::registration-domain-whitelist
                    ::rpc-rlimit-config
@@ -310,16 +292,19 @@
                    ::smtp-tls
                    ::smtp-username
 
-                   ::urepl-host
-                   ::urepl-port
-                   ::prepl-host
-                   ::prepl-port
+                   ::srepl-host
+                   ::srepl-port
 
                    ::assets-storage-backend
                    ::storage-assets-fs-directory
                    ::storage-assets-s3-bucket
                    ::storage-assets-s3-region
                    ::storage-assets-s3-endpoint
+                   ::fdata-storage-backend
+                   ::storage-fdata-s3-bucket
+                   ::storage-fdata-s3-region
+                   ::storage-fdata-s3-prefix
+                   ::storage-fdata-s3-endpoint
                    ::telemetry-enabled
                    ::telemetry-uri
                    ::telemetry-referer

backend/src/app/db.clj

@@ -167,7 +167,6 @@
   (instance? javax.sql.DataSource v))
 
 (s/def ::pool pool?)
-(s/def ::conn-or-pool some?)
 
 (defn closed?
   [pool]
@@ -233,46 +232,44 @@
   [pool]
   (jdbc/get-connection pool))
 
-(def ^:private default-opts
-  {:builder-fn sql/as-kebab-maps})
-
 (defn exec!
   ([ds sv]
-   (jdbc/execute! ds sv default-opts))
+   (exec! ds sv {}))
   ([ds sv opts]
-   (jdbc/execute! ds sv (merge default-opts opts))))
+   (jdbc/execute! ds sv (assoc opts :builder-fn sql/as-kebab-maps))))
 
 (defn exec-one!
-  ([ds sv]
-   (jdbc/execute-one! ds sv default-opts))
+  ([ds sv] (exec-one! ds sv {}))
   ([ds sv opts]
-   (jdbc/execute-one! ds sv
-                      (-> (merge default-opts opts)
-                          (assoc :return-keys (::return-keys? opts false))))))
+   (jdbc/execute-one! ds sv (assoc opts :builder-fn sql/as-kebab-maps))))
 
 (defn insert!
-  [ds table params & {:as opts}]
-  (exec-one! ds
-             (sql/insert table params opts)
-             (merge {::return-keys? true} opts)))
+  ([ds table params] (insert! ds table params nil))
+  ([ds table params opts]
+   (exec-one! ds
+              (sql/insert table params opts)
+              (merge {:return-keys true} opts))))
 
 (defn insert-multi!
-  [ds table cols rows & {:as opts}]
-  (exec! ds
-         (sql/insert-multi table cols rows opts)
-         (merge {::return-keys? true} opts)))
+  ([ds table cols rows] (insert-multi! ds table cols rows nil))
+  ([ds table cols rows opts]
+   (exec! ds
+          (sql/insert-multi table cols rows opts)
+          (merge {:return-keys true} opts))))
 
 (defn update!
-  [ds table params where & {:as opts}]
-  (exec-one! ds
-             (sql/update table params where opts)
-             (merge {::return-keys? true} opts)))
+  ([ds table params where] (update! ds table params where nil))
+  ([ds table params where opts]
+   (exec-one! ds
+              (sql/update table params where opts)
+              (merge {:return-keys true} opts))))
 
 (defn delete!
-  [ds table params & {:as opts}]
-  (exec-one! ds
-             (sql/delete table params opts)
-             (merge {::return-keys? true} opts)))
+  ([ds table params] (delete! ds table params nil))
+  ([ds table params opts]
+   (exec-one! ds
+              (sql/delete table params opts)
+              (assoc opts :return-keys true))))
 
 (defn is-row-deleted?
   [{:keys [deleted-at]}]
@@ -281,34 +278,56 @@
           (inst-ms (dt/now)))))
 
 (defn get*
-  "Retrieve a single row from database that matches a simple filters. Do
-  not raises exceptions."
-  [ds table params & {:as opts}]
-  (let [rows (exec! ds (sql/select table params opts))
-        rows (cond->> rows
-               (::remove-deleted? opts true)
-               (remove is-row-deleted?))]
-    (first rows)))
+  "Internal function for retrieve a single row from database that
+  matches a simple filters."
+  ([ds table params]
+   (get* ds table params nil))
+  ([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}]
+   (let [rows (exec! ds (sql/select table params opts))
+         rows (cond->> rows
+                check-deleted?
+                (remove is-row-deleted?))]
+     (first rows))))
 
 (defn get
-  "Retrieve a single row from database that matches a simple
-  filters. Raises :not-found exception if no object is found."
-  [ds table params & {:as opts}]
-  (let [row (get* ds table params opts)]
-    (when (and (not row) (::check-deleted? opts true))
-      (ex/raise :type :not-found
-                :code :object-not-found
-                :table table
-                :hint "database object not found"))
-    row))
+  ([ds table params]
+   (get ds table params nil))
+  ([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}]
+   (let [row (get* ds table params opts)]
+     (when (and (not row) check-deleted?)
+       (ex/raise :type :not-found
+                 :code :object-not-found
+                 :table table
+                 :hint "database object not found"))
+     row)))
+
+(defn get-by-params
+  "DEPRECATED"
+  ([ds table params]
+   (get-by-params ds table params nil))
+  ([ds table params {:keys [check-not-found] :or {check-not-found true} :as opts}]
+   (let [row (get* ds table params (assoc opts :check-deleted? check-not-found))]
+     (when (and (not row) check-not-found)
+       (ex/raise :type :not-found
+                 :code :object-not-found
+                 :table table
+                 :hint "database object not found"))
+     row)))
 
 (defn get-by-id
-  [ds table id & {:as opts}]
-  (get ds table {:id id} opts))
+  ([ds table id]
+   (get ds table {:id id} nil))
+  ([ds table id opts]
+   (let [opts (cond-> opts
+                (contains? opts :check-not-found)
+                (assoc :check-deleted? (:check-not-found opts)))]
+     (get ds table {:id id} opts))))
 
 (defn query
-  [ds table params & {:as opts}]
-  (exec! ds (sql/select table params opts)))
+  ([ds table params]
+   (query ds table params nil))
+  ([ds table params opts]
+   (exec! ds (sql/select table params opts))))
 
 (defn pgobject?
   ([v]

backend/src/app/db/sql.clj

@@ -7,7 +7,6 @@
 (ns app.db.sql
   (:refer-clojure :exclude [update])
   (:require
-   [app.db :as-alias db]
    [clojure.string :as str]
    [next.jdbc.optional :as jdbc-opt]
    [next.jdbc.sql.builder :as sql]))
@@ -44,10 +43,8 @@
   ([table where-params opts]
    (let [opts (merge default-opts opts)
          opts (cond-> opts
-                (::db/for-update? opts) (assoc :suffix "FOR UPDATE")
-                (::db/for-share? opts)  (assoc :suffix "FOR KEY SHARE")
-                (:for-update opts)      (assoc :suffix "FOR UPDATE")
-                (:for-key-share opts)   (assoc :suffix "FOR KEY SHARE"))]
+                (:for-update opts)    (assoc :suffix "FOR UPDATE")
+                (:for-key-share opts) (assoc :suffix "FOR KEY SHARE"))]
      (sql/for-query table where-params opts))))
 
 (defn update

backend/src/app/emails.clj

@@ -257,17 +257,15 @@
   "Schedule an already defined email to be sent using asynchronously
   using worker task."
   [{:keys [::conn ::factory] :as context}]
+  (us/verify fn? factory)
   (us/verify some? conn)
-  (let [email (if factory
-                (factory context)
-                (dissoc context ::conn))]
-    (wrk/submit! (merge
-                  {::wrk/task :sendmail
-                   ::wrk/delay 0
-                   ::wrk/max-retries 4
-                   ::wrk/priority 200
-                   ::wrk/conn conn}
-                  email))))
+  (let [email (factory context)]
+    (wrk/submit! (assoc email
+                        ::wrk/task :sendmail
+                        ::wrk/delay 0
+                        ::wrk/max-retries 4
+                        ::wrk/priority 200
+                        ::wrk/conn conn))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SENDMAIL FN / TASK HANDLER

backend/src/app/http.clj

@@ -6,22 +6,13 @@
 
 (ns app.http
   (:require
-   [app.auth.oidc :as-alias oidc]
    [app.common.data :as d]
    [app.common.logging :as l]
    [app.common.transit :as t]
-   [app.db :as-alias db]
-   [app.http.access-token :as actoken]
-   [app.http.assets :as-alias assets]
-   [app.http.awsns :as-alias awsns]
-   [app.http.debug :as-alias debug]
    [app.http.errors :as errors]
    [app.http.middleware :as mw]
    [app.http.session :as session]
-   [app.http.websocket :as-alias ws]
    [app.metrics :as mtx]
-   [app.rpc :as-alias rpc]
-   [app.rpc.doc :as-alias rpc.doc]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
@@ -73,6 +64,7 @@
                  :http/max-body-size (:max-body-size cfg)
                  :http/max-multipart-body-size (:max-multipart-body-size cfg)
                  :xnio/io-threads (:io-threads cfg)
+                 :xnio/worker-threads (:worker-threads cfg)
                  :xnio/dispatch (:executor cfg)
                  :ring/async true}
 
@@ -99,7 +91,9 @@
               (let [params  (:path-params match)
                     result  (:result match)
                     handler (or (:handler result) not-found-handler)
-                    request (assoc request :path-params params)]
+                    request (-> request
+                                (assoc :path-params params)
+                                (update :params merge params))]
                 (handler request respond raise))
               (not-found-handler request respond raise)))
 
@@ -121,41 +115,64 @@
 ;; HTTP ROUTER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(s/def ::assets map?)
+(s/def ::awsns-handler fn?)
+(s/def ::debug-routes (s/nilable vector?))
+(s/def ::doc-routes (s/nilable vector?))
+(s/def ::feedback fn?)
+(s/def ::oauth map?)
+(s/def ::oidc-routes (s/nilable vector?))
+(s/def ::rpc-routes (s/nilable vector?))
+(s/def ::session ::session/session)
+(s/def ::storage map?)
+(s/def ::ws fn?)
+
 (defmethod ig/pre-init-spec ::router [_]
-  (s/keys :req [::session/manager
-                ::actoken/manager
-                ::ws/routes
-                ::rpc/routes
-                ::rpc.doc/routes
-                ::oidc/routes
-                ::assets/routes
-                ::debug/routes
-                ::db/pool
-                ::mtx/routes
-                ::awsns/routes]))
+  (s/keys :req-un [::mtx/metrics
+                   ::ws
+                   ::storage
+                   ::assets
+                   ::session
+                   ::feedback
+                   ::awsns-handler
+                   ::debug-routes
+                   ::oidc-routes
+                   ::rpc-routes
+                   ::doc-routes]))
 
 (defmethod ig/init-key ::router
-  [_ cfg]
+  [_ {:keys [ws session metrics assets feedback] :as cfg}]
   (rr/router
    [["" {:middleware [[mw/server-timing]
                       [mw/format-response]
                       [mw/params]
                       [mw/parse-request]
-                      [session/soft-auth cfg]
-                      [actoken/soft-auth cfg]
+                      [session/middleware-1 session]
                       [mw/errors errors/handle]
                       [mw/restrict-methods]]}
 
-     (::mtx/routes cfg)
-     (::assets/routes cfg)
-     (::debug/routes cfg)
+     ["/metrics" {:handler (::mtx/handler metrics)
+                  :allowed-methods #{:get}}]
+
+     ["/assets" {:middleware [[session/middleware-2 session]]}
+      ["/by-id/:id" {:handler (:objects-handler assets)}]
+      ["/by-file-media-id/:id" {:handler (:file-objects-handler assets)}]
+      ["/by-file-media-id/:id/thumbnail" {:handler (:file-thumbnails-handler assets)}]]
+
+     (:debug-routes cfg)
 
      ["/webhooks"
-      (::awsns/routes cfg)]
+      ["/sns" {:handler (:awsns-handler cfg)
+               :allowed-methods #{:post}}]]
 
-     (::ws/routes cfg)
+     ["/ws/notifications" {:middleware [[session/middleware-2 session]]
+                           :handler ws
+                           :allowed-methods #{:get}}]
 
-     ["/api" {:middleware [[mw/cors]]}
-      (::oidc/routes cfg)
-      (::rpc.doc/routes cfg)
-      (::rpc/routes cfg)]]]))
+     ["/api" {:middleware [[mw/cors]
+                           [session/middleware-2 session]]}
+      ["/feedback" {:handler feedback
+                    :allowed-methods #{:post}}]
+      (:doc-routes cfg)
+      (:oidc-routes cfg)
+      (:rpc-routes cfg)]]]))

backend/src/app/http/access_token.clj

@@ -1,96 +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.http.access-token
-  (:require
-   [app.common.logging :as l]
-   [app.common.spec :as us]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.main :as-alias main]
-   [app.tokens :as tokens]
-   [app.worker :as-alias wrk]
-   [clojure.spec.alpha :as s]
-   [integrant.core :as ig]
-   [promesa.core :as p]
-   [promesa.exec :as px]
-   [yetti.request :as yrq]))
-
-
-(s/def ::manager
-  (s/keys :req [::db/pool ::wrk/executor ::main/props]))
-
-(defmethod ig/pre-init-spec ::manager [_] ::manager)
-(defmethod ig/init-key ::manager [_ cfg] cfg)
-(defmethod ig/halt-key! ::manager [_ _])
-
-(def header-re #"^Token\s+(.*)")
-
-(defn- get-token
-  [request]
-  (some->> (yrq/get-header request "authorization")
-           (re-matches header-re)
-           (second)))
-
-(defn- decode-token
-  [props token]
-  (when token
-    (tokens/verify props {:token token :iss "access-token"})))
-
-(defn- get-token-perms
-  [pool token-id]
-  (when-not (db/read-only? pool)
-    (when-let [token (db/get* pool :access-token {:id token-id} {:columns [:perms]})]
-      (some-> (:perms token)
-              (db/decode-pgarray #{})))))
-
-(defn- wrap-soft-auth
-  [handler {:keys [::manager]}]
-  (us/assert! ::manager manager)
-
-  (let [{:keys [::wrk/executor ::main/props]} manager]
-    (fn [request respond raise]
-      (let [token (get-token request)]
-        (->> (px/submit! executor (partial decode-token props token))
-             (p/fnly (fn [claims cause]
-                       (when cause
-                         (l/trace :hint "exception on decoding malformed token" :cause cause))
-                       (let [request (cond-> request
-                                       (map? claims)
-                                       (assoc ::id (:tid claims)))]
-                         (handler request respond raise)))))))))
-
-(defn- wrap-authz
-  [handler {:keys [::manager]}]
-  (us/assert! ::manager manager)
-  (let [{:keys [::wrk/executor ::db/pool]} manager]
-    (fn [request respond raise]
-      (if-let [token-id (::id request)]
-        (->> (px/submit! executor (partial get-token-perms pool token-id))
-             (p/fnly (fn [perms cause]
-                       (cond
-                         (some? cause)
-                         (raise cause)
-
-                         (nil? perms)
-                         (handler request respond raise)
-
-                         :else
-                         (let [request (assoc request ::perms perms)]
-                           (handler request respond raise))))))
-        (handler request respond raise)))))
-
-(def soft-auth
-  {:name ::soft-auth
-   :compile (fn [& _]
-              (when (contains? cf/flags :access-tokens)
-                wrap-soft-auth))})
-
-(def authz
-  {:name ::authz
-   :compile (fn [& _]
-              (when (contains? cf/flags :access-tokens)
-                wrap-authz))})

backend/src/app/http/assets.clj

@@ -115,10 +115,7 @@
 (s/def ::cache-max-age ::dt/duration)
 (s/def ::signature-max-age ::dt/duration)
 
-(s/def ::routes vector?)
-
-;; FIXME: namespace qualified params
-(defmethod ig/pre-init-spec ::routes [_]
+(defmethod ig/pre-init-spec ::handlers [_]
   (s/keys :req-un [::storage
                    ::wrk/executor
                    ::mtx/metrics
@@ -126,9 +123,9 @@
                    ::cache-max-age
                    ::signature-max-age]))
 
-(defmethod ig/init-key ::routes
+(defmethod ig/init-key ::handlers
   [_ cfg]
-  ["/assets"
-   ["/by-id/:id" {:handler (partial objects-handler cfg)}]
-   ["/by-file-media-id/:id" {:handler (partial file-objects-handler cfg)}]
-   ["/by-file-media-id/:id/thumbnail" {:handler (partial file-thumbnails-handler cfg)}]])
+  {:objects-handler (partial objects-handler cfg)
+   :file-objects-handler (partial file-objects-handler cfg)
+   :file-thumbnails-handler (partial file-thumbnails-handler cfg)})
+

backend/src/app/http/awsns.clj

@@ -28,20 +28,18 @@
 (declare parse-notification)
 (declare process-report)
 
-(defmethod ig/pre-init-spec ::routes [_]
+(defmethod ig/pre-init-spec ::handler [_]
   (s/keys :req [::http/client
                 ::main/props
                 ::db/pool
                 ::wrk/executor]))
 
-(defmethod ig/init-key ::routes
+(defmethod ig/init-key ::handler
   [_ {:keys [::wrk/executor] :as cfg}]
-  (letfn [(handler [request respond _]
-            (let [data (-> request yrq/body slurp)]
-              (px/run! executor #(handle-request cfg data)))
-            (respond (yrs/response 200)))]
-    ["/sns" {:handler handler
-             :allowed-methods #{:post}}]))
+  (fn [request respond _]
+    (let [data (-> request yrq/body slurp)]
+      (px/run! executor #(handle-request cfg data)))
+    (respond (yrs/response 200))))
 
 (defn handle-request
   [cfg data]
@@ -107,7 +105,8 @@
   [cfg headers]
   (let [tdata (get headers "x-penpot-data")]
     (when-not (str/empty? tdata)
-      (let [result (tokens/verify (::main/props cfg) {:token tdata :iss :profile-identity})]
+      (let [sprops (::main/props cfg)
+            result (tokens/verify sprops {:token tdata :iss :profile-identity})]
         (:profile-id result)))))
 
 (defn- parse-notification

backend/src/app/http/client.clj

@@ -11,8 +11,7 @@
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
-   [java-http-clj.core :as http]
-   [promesa.core :as p])
+   [java-http-clj.core :as http])
   (:import
    java.net.http.HttpClient))
 
@@ -35,10 +34,7 @@
    (us/assert! ::client client)
    (if sync?
      (http/send req {:client client :as response-type})
-     (try
-       (http/send-async req {:client client :as response-type})
-       (catch Throwable cause
-         (p/rejected cause))))))
+     (http/send-async req {:client client :as response-type}))))
 
 (defn req!
   "A convencience toplevel function for gradual migration to a new API

backend/src/app/http/debug.clj

@@ -16,8 +16,8 @@
    [app.http.middleware :as mw]
    [app.http.session :as session]
    [app.rpc.commands.binfile :as binf]
-   [app.rpc.commands.files-create :refer [create-file]]
-   [app.rpc.commands.profile :as profile]
+   [app.rpc.commands.files.create :refer [create-file]]
+   [app.rpc.queries.profile :as profile]
    [app.util.blob :as blob]
    [app.util.template :as tmpl]
    [app.util.time :as dt]
@@ -39,9 +39,9 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn authorized?
-  [pool {:keys [::session/profile-id]}]
+  [pool {:keys [profile-id]}]
   (or (= "devenv" (cf/get :host))
-      (let [profile (ex/ignoring (profile/get-profile pool profile-id))
+      (let [profile (ex/ignoring (profile/retrieve-profile-data pool profile-id))
             admins  (or (cf/get :admins) #{})]
         (contains? admins (:email profile)))))
 
@@ -61,7 +61,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn index-handler
-  [{:keys [::db/pool]} request]
+  [{:keys [pool]} request]
   (when-not (authorized? pool request)
     (ex/raise :type :authentication
               :code :only-admins-allowed))
@@ -81,7 +81,7 @@
   "select revn, changes, data from file_change where file_id=? and revn = ?")
 
 (defn- retrieve-file-data
-  [{:keys [::db/pool]} {:keys [params ::session/profile-id] :as request}]
+  [{:keys [pool]} {:keys [params profile-id] :as request}]
   (when-not (authorized? pool request)
     (ex/raise :type :authentication
               :code :only-admins-allowed))
@@ -107,9 +107,8 @@
         (prepare-download-response data filename)
 
         (contains? params :clone)
-        (let [profile    (profile/get-profile pool profile-id)
-              project-id (:default-project-id profile)
-              data       (blob/decode data)]
+        (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
+              data       (some-> data blob/decode)]
           (create-file pool {:id (uuid/next)
                              :name (str "Cloned file: " filename)
                              :project-id project-id
@@ -118,7 +117,7 @@
           (yrs/response 201 "OK CREATED"))
 
         :else
-        (prepare-response (blob/decode data))))))
+        (prepare-response (some-> data blob/decode))))))
 
 (defn- is-file-exists?
   [pool id]
@@ -126,9 +125,8 @@
     (-> (db/exec-one! pool [sql id]) :exists)))
 
 (defn- upload-file-data
-  [{:keys [::db/pool]} {:keys [::session/profile-id params] :as request}]
-  (let [profile    (profile/get-profile pool profile-id)
-        project-id (:default-project-id profile)
+  [{:keys [pool]} {:keys [profile-id params] :as request}]
+  (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
         data       (some-> params :file :path io/read-as-bytes blob/decode)]
 
     (if (and data project-id)
@@ -164,7 +162,7 @@
               :code :method-not-found)))
 
 (defn file-changes-handler
-  [{:keys [::db/pool]} {:keys [params] :as request}]
+  [{:keys [pool]} {:keys [params] :as request}]
   (when-not (authorized? pool request)
     (ex/raise :type :authentication
               :code :only-admins-allowed))
@@ -204,7 +202,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn error-handler
-  [{:keys [::db/pool]} request]
+  [{:keys [pool]} request]
   (letfn [(parse-id [request]
             (let [id (get-in request [:path-params :id])
                   id (parse-uuid id)]
@@ -253,7 +251,7 @@
     LIMIT 100")
 
 (defn error-list-handler
-  [{:keys [::db/pool]} request]
+  [{:keys [pool]} request]
   (when-not (authorized? pool request)
     (ex/raise :type :authentication
               :code :only-admins-allowed))
@@ -270,7 +268,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn export-handler
-  [{:keys [::db/pool] :as cfg} {:keys [params ::session/profile-id] :as request}]
+  [{:keys [pool] :as cfg} {:keys [params profile-id] :as request}]
 
   (let [file-ids (->> (:file-ids params)
                       (remove empty?)
@@ -289,8 +287,7 @@
                    (assoc ::binf/include-libraries? libs?)
                    (binf/export-to-tmpfile!))]
       (if clone?
-        (let [profile    (profile/get-profile pool profile-id)
-              project-id (:default-project-id profile)]
+        (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)]
           (binf/import!
            (assoc cfg
                   ::binf/input path
@@ -312,16 +309,15 @@
 
 
 (defn import-handler
-  [{:keys [::db/pool] :as cfg} {:keys [params ::session/profile-id] :as request}]
+  [{:keys [pool] :as cfg} {:keys [params profile-id] :as request}]
   (when-not (contains? params :file)
     (ex/raise :type :validation
               :code :missing-upload-file
               :hint "missing upload file"))
 
-  (let [profile    (profile/get-profile pool profile-id)
-        project-id (:default-project-id profile)
+  (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
         overwrite? (contains? params :overwrite)
-        migrate?   (contains? params :migrate)
+        migrate? (contains? params :migrate)
         ignore-index-errors? (contains? params :ignore-index-errors)]
 
     (when-not project-id
@@ -349,14 +345,15 @@
 
 (defn health-handler
   "Mainly a task that performs a health check."
-  [{:keys [::db/pool]} _]
-  (try
-    (db/exec-one! pool ["select count(*) as count from server_prop;"])
-    (yrs/response 200 "OK")
-    (catch Throwable cause
-      (l/warn :hint "unable to execute query on health handler"
-              :cause cause)
-      (yrs/response 503 "KO"))))
+  [{:keys [pool]} _]
+  (db/with-atomic [conn pool]
+    (try
+      (db/exec-one! conn ["select count(*) as count from server_prop;"])
+      (yrs/response 200 "OK")
+      (catch Throwable cause
+        (l/warn :hint "unable to execute query on health handler"
+                :cause cause)
+        (yrs/response 503 "KO")))))
 
 (defn changelog-handler
   [_ _]
@@ -384,17 +381,16 @@
            (raise (ex/error :type :authentication
                             :code :only-admins-allowed))))))})
 
+
 (defmethod ig/pre-init-spec ::routes [_]
-  (s/keys :req [::db/pool
-                ::wrk/executor
-                ::session/manager]))
+  (s/keys :req-un [::db/pool ::wrk/executor ::session/session]))
 
 (defmethod ig/init-key ::routes
-  [_ {:keys [::db/pool ::wrk/executor] :as cfg}]
+  [_ {:keys [session pool executor] :as cfg}]
   [["/readyz" {:middleware [[mw/with-dispatch executor]
                             [mw/with-config cfg]]
                :handler health-handler}]
-   ["/dbg" {:middleware [[session/authz cfg]
+   ["/dbg" {:middleware [[session/middleware-2 session]
                          [with-authorization pool]
                          [mw/with-dispatch executor]
                          [mw/with-config cfg]]}

backend/src/app/http/errors.clj

@@ -11,8 +11,6 @@
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.http :as-alias http]
-   [app.http.access-token :as-alias actoken]
-   [app.http.session :as-alias session]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [yetti.request :as yrq]
@@ -28,9 +26,7 @@
 
 (defn get-context
   [request]
-  (let [claims (-> {}
-                   (into (::session/token-claims request))
-                   (into (::actoken/token-claims request)))]
+  (let [claims (:session-token-claims request)]
     (merge
      *context*
      {:path          (:path request)
@@ -53,10 +49,6 @@
   [err _]
   (yrs/response 401 (ex-data err)))
 
-(defmethod handle-exception :authorization
-  [err _]
-  (yrs/response 403 (ex-data err)))
-
 (defmethod handle-exception :restriction
   [err _]
   (yrs/response 400 (ex-data err)))

backend/src/app/http/feedback.clj

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

backend/src/app/http/middleware.clj

@@ -78,12 +78,13 @@
               (raise cause)))]
 
     (fn [request respond raise]
-      (let [request (ex/try! (process-request request))]
-        (if (ex/exception? request)
-          (if (instance? RuntimeException request)
-            (handle-error raise (or (ex/cause request) request))
-            (handle-error raise request))
-          (handler request respond raise))))))
+      (when-let [request (try
+                           (process-request request)
+                           (catch RuntimeException cause
+                             (handle-error raise (or (.getCause cause) cause)))
+                           (catch Throwable cause
+                             (handle-error raise cause)))]
+        (handler request respond raise)))))
 
 (def parse-request
   {:name ::parse-request

backend/src/app/http/session.clj

@@ -9,17 +9,13 @@
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
-   [app.common.spec :as us]
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
-   [app.http.session.tasks :as-alias tasks]
-   [app.main :as-alias main]
    [app.tokens :as tokens]
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
    [integrant.core :as ig]
    [promesa.core :as p]
    [promesa.exec :as px]
@@ -48,55 +44,55 @@
 
 (defprotocol ISessionManager
   (read [_ key])
+  (decode [_ key])
   (write! [_ key data])
   (update! [_ data])
   (delete! [_ key]))
 
-(s/def ::manager #(satisfies? ISessionManager %))
+(s/def ::session #(satisfies? ISessionManager %))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; STORAGE IMPL
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::session-params
-  (s/keys :req-un [::user-agent
-                   ::profile-id
-                   ::created-at]))
-
 (defn- prepare-session-params
-  [key params]
-  (us/assert! ::us/not-empty-string key)
-  (us/assert! ::session-params params)
-
-  {:user-agent (:user-agent params)
-   :profile-id (:profile-id params)
-   :created-at (:created-at params)
-   :updated-at (:created-at params)
-   :id key})
+  [sprops data]
+  (let [profile-id (:profile-id data)
+        user-agent (:user-agent data)
+        created-at (or (:created-at data) (dt/now))
+        token      (tokens/generate sprops {:iss "authentication"
+                                            :iat created-at
+                                            :uid profile-id})]
+    {:user-agent user-agent
+     :profile-id profile-id
+     :created-at created-at
+     :updated-at created-at
+     :id token}))
 
 (defn- database-manager
-  [{:keys [::db/pool ::wrk/executor ::main/props]}]
-  ^{::wrk/executor executor
-    ::db/pool pool
-    ::main/props props}
+  [{:keys [pool sprops executor]}]
   (reify ISessionManager
     (read [_ token]
       (px/with-dispatch executor
         (db/exec-one! pool (sql/select :http-session {:id token}))))
 
-    (write! [_ key params]
+    (decode [_ token]
       (px/with-dispatch executor
-        (let [params (prepare-session-params key params)]
+        (tokens/verify sprops {:token token :iss "authentication"})))
+
+    (write! [_ _ data]
+      (px/with-dispatch executor
+        (let [params (prepare-session-params sprops data)]
           (db/insert! pool :http-session params)
           params)))
 
-    (update! [_ params]
+    (update! [_ data]
       (let [updated-at (dt/now)]
         (px/with-dispatch executor
           (db/update! pool :http-session
                       {:updated-at updated-at}
-                      {:id (:id params)})
-          (assoc params :updated-at updated-at))))
+                      {:id (:id data)})
+          (assoc data :updated-at updated-at))))
 
     (delete! [_ token]
       (px/with-dispatch executor
@@ -104,37 +100,39 @@
         nil))))
 
 (defn inmemory-manager
-  [{:keys [::db/pool ::wrk/executor ::main/props]}]
+  [{:keys [sprops executor]}]
   (let [cache (atom {})]
-    ^{::main/props props
-      ::wrk/executor executor
-      ::db/pool pool}
     (reify ISessionManager
       (read [_ token]
         (p/do (get @cache token)))
 
-      (write! [_ key params]
+      (decode [_ token]
+        (px/with-dispatch executor
+          (tokens/verify sprops {:token token :iss "authentication"})))
+
+      (write! [_ _ data]
         (p/do
-          (let [params (prepare-session-params key params)]
-            (swap! cache assoc key params)
+          (let [{:keys [token] :as params} (prepare-session-params sprops data)]
+            (swap! cache assoc token params)
             params)))
 
-      (update! [_ params]
+      (update! [_ data]
         (p/do
           (let [updated-at (dt/now)]
-            (swap! cache update (:id params) assoc :updated-at updated-at)
-            (assoc params :updated-at updated-at))))
+            (swap! cache update (:id data) assoc :updated-at updated-at)
+            (assoc data :updated-at updated-at))))
 
       (delete! [_ token]
         (p/do
           (swap! cache dissoc token)
           nil)))))
 
+(s/def ::sprops map?)
 (defmethod ig/pre-init-spec ::manager [_]
-  (s/keys :req [::db/pool ::wrk/executor ::main/props]))
+  (s/keys :req-un [::db/pool ::wrk/executor ::sprops]))
 
 (defmethod ig/init-key ::manager
-  [_ {:keys [::db/pool] :as cfg}]
+  [_ {:keys [pool] :as cfg}]
   (if (db/read-only? pool)
     (inmemory-manager cfg)
     (database-manager cfg)))
@@ -146,34 +144,25 @@
 ;; MANAGER IMPL
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(declare ^:private assign-auth-token-cookie)
-(declare ^:private assign-authenticated-cookie)
-(declare ^:private clear-auth-token-cookie)
-(declare ^:private clear-authenticated-cookie)
-(declare ^:private gen-token)
+(declare assign-auth-token-cookie)
+(declare assign-authenticated-cookie)
+(declare clear-auth-token-cookie)
+(declare clear-authenticated-cookie)
 
 (defn create-fn
-  [{:keys [::manager]} profile-id]
-  (us/assert! ::manager manager)
-  (us/assert! ::us/uuid profile-id)
-
-  (let [props (-> manager meta ::main/props)]
-    (fn [request response]
-      (let [uagent (yrq/get-header request "user-agent")
-            params {:profile-id profile-id
-                    :user-agent uagent
-                    :created-at (dt/now)}
-            token  (gen-token props params)]
-
-        (->> (write! manager token params)
-             (p/fmap (fn [session]
-                       (l/trace :hint "create" :profile-id profile-id)
-                       (-> response
-                           (assign-auth-token-cookie session)
-                           (assign-authenticated-cookie session)))))))))
+  [manager profile-id]
+  (fn [request response]
+    (let [uagent  (yrq/get-header request "user-agent")
+          params  {:profile-id profile-id
+                   :user-agent uagent}]
+      (-> (write! manager nil params)
+          (p/then (fn [session]
+                    (l/trace :hint "create" :profile-id profile-id)
+                    (-> response
+                        (assign-auth-token-cookie session)
+                        (assign-authenticated-cookie session))))))))
 (defn delete-fn
-  [{:keys [::manager]}]
-  (us/assert! ::manager manager)
+  [manager]
   (letfn [(delete [{:keys [profile-id] :as request}]
             (let [cname   (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
                   cookie  (yrq/get-cookie request cname)]
@@ -188,92 +177,67 @@
             (clear-auth-token-cookie)
             (clear-authenticated-cookie))))))
 
-(defn- gen-token
-  [props {:keys [profile-id created-at]}]
-  (tokens/generate props {:iss "authentication"
-                          :iat created-at
-                          :uid profile-id}))
-(defn- decode-token
-  [props token]
-  (when token
-    (tokens/verify props {:token token :iss "authentication"})))
+(def middleware-1
+  (letfn [(wrap-handler [manager handler request respond raise]
+            (try
+              (let [claims  (some->> (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+                                     (yrq/get-cookie request)
+                                     (decode manager))
+                    request (cond-> request
+                              (some? claims)
+                              (assoc :session-token-claims claims))]
+                (handler request respond raise))
+              (catch Throwable _
+                (handler request respond raise))))]
 
-(defn- get-token
-  [request]
-  (let [cname  (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
-        cookie (some-> (yrq/get-cookie request cname) :value)]
-    (when-not (str/empty? cookie)
-      cookie)))
+    {:name :session-1
+     :compile (fn [& _]
+                (fn [handler manager]
+                  (partial wrap-handler manager handler)))}))
 
-(defn- get-session
-  [manager token]
-  (some->> token (read manager)))
+(def middleware-2
+  (letfn [(wrap-handler [manager handler request respond raise]
+            (-> (retrieve-session manager request)
+                (p/finally (fn [session cause]
+                             (cond
+                               (some? cause)
+                               (raise cause)
 
-(defn- renew-session?
-  [{:keys [updated-at] :as session}]
-  (and (dt/instant? updated-at)
-       (let [elapsed (dt/diff updated-at (dt/now))]
-         (neg? (compare default-renewal-max-age elapsed)))))
+                               (nil? session)
+                               (handler request respond raise)
 
-(defn- wrap-reneval
-  [respond manager session]
-  (fn [response]
-    (p/let [session (update! manager session)]
-      (-> response
-          (assign-auth-token-cookie session)
-          (assign-authenticated-cookie session)
-          (respond)))))
+                               :else
+                               (let [request (-> request
+                                                 (assoc :profile-id (:profile-id session))
+                                                 (assoc :session-id (:id session)))
+                                     respond (cond-> respond
+                                               (renew-session? session)
+                                               (wrap-respond manager session))]
+                                 (handler request respond raise)))))))
 
-(defn- wrap-soft-auth
-  [handler {:keys [::manager]}]
-  (us/assert! ::manager manager)
+          (retrieve-session [manager request]
+            (let [cname  (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+                  cookie (yrq/get-cookie request cname)]
+              (some->> (:value cookie) (read manager))))
 
-  (let [{:keys [::wrk/executor ::main/props]} (meta manager)]
-    (fn [request respond raise]
-      (let [token (get-token request)]
-        (->> (px/submit! executor (partial decode-token props token))
-             (p/fnly (fn [claims cause]
-                       (when cause
-                         (l/trace :hint "exception on decoding malformed token" :cause cause))
+          (renew-session? [{:keys [updated-at] :as session}]
+            (and (dt/instant? updated-at)
+                 (let [elapsed (dt/diff updated-at (dt/now))]
+                   (neg? (compare default-renewal-max-age elapsed)))))
 
-                       (let [request (cond-> request
-                                       (map? claims)
-                                       (-> (assoc ::token-claims claims)
-                                           (assoc ::token token)))]
-                         (handler request respond raise)))))))))
+          ;; Wrap respond with session renewal code
+          (wrap-respond [respond manager session]
+            (fn [response]
+              (p/let [session (update! manager session)]
+                (-> response
+                    (assign-auth-token-cookie session)
+                    (assign-authenticated-cookie session)
+                    (respond)))))]
 
-(defn- wrap-authz
-  [handler {:keys [::manager]}]
-  (us/assert! ::manager manager)
-  (fn [request respond raise]
-    (if-let [token (::token request)]
-      (->> (get-session manager token)
-           (p/fnly (fn [session cause]
-                     (cond
-                       (some? cause)
-                       (raise cause)
-
-                       (nil? session)
-                       (handler request respond raise)
-
-                       :else
-                       (let [request (-> request
-                                         (assoc ::profile-id (:profile-id session))
-                                         (assoc ::id (:id session)))
-                             respond (cond-> respond
-                                       (renew-session? session)
-                                       (wrap-reneval manager session))]
-                         (handler request respond raise))))))
-
-      (handler request respond raise))))
-
-(def soft-auth
-  {:name ::soft-auth
-   :compile (constantly wrap-soft-auth)})
-
-(def authz
-  {:name ::authz
-   :compile (constantly wrap-authz)})
+    {:name :session-2
+     :compile (fn [& _]
+                (fn [handler manager]
+                  (partial wrap-handler manager handler)))}))
 
 ;; --- IMPL
 
@@ -335,26 +299,21 @@
 ;; TASK: SESSION GC
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::tasks/max-age ::dt/duration)
+(declare sql:delete-expired)
 
-(defmethod ig/pre-init-spec ::tasks/gc [_]
-  (s/keys :req [::db/pool]
-          :opt [::tasks/max-age]))
+(s/def ::max-age ::dt/duration)
 
-(defmethod ig/prep-key ::tasks/gc
+(defmethod ig/pre-init-spec ::gc-task [_]
+  (s/keys :req-un [::db/pool]
+          :opt-un [::max-age]))
+
+(defmethod ig/prep-key ::gc-task
   [_ cfg]
-  (let [max-age (cf/get :auth-token-cookie-max-age default-cookie-max-age)]
-    (merge {::tasks/max-age max-age} (d/without-nils cfg))))
+  (merge {:max-age default-cookie-max-age}
+         (d/without-nils cfg)))
 
-(def ^:private
-  sql:delete-expired
-  "delete from http_session
-    where updated_at < now() - ?::interval
-       or (updated_at is null and
-           created_at < now() - ?::interval)")
-
-(defmethod ig/init-key ::tasks/gc
-  [_ {:keys [::db/pool ::tasks/max-age] :as cfg}]
+(defmethod ig/init-key ::gc-task
+  [_ {:keys [pool max-age] :as cfg}]
   (l/debug :hint "initializing session gc task" :max-age max-age)
   (fn [_]
     (db/with-atomic [conn pool]
@@ -366,3 +325,9 @@
                  :deleted result)
         result))))
 
+(def ^:private
+  sql:delete-expired
+  "delete from http_session
+    where updated_at < now() - ?::interval
+       or (updated_at is null and
+           created_at < now() - ?::interval)")

backend/src/app/http/websocket.clj

@@ -12,7 +12,6 @@
    [app.common.pprint :as pp]
    [app.common.spec :as us]
    [app.db :as db]
-   [app.http.session :as session]
    [app.metrics :as mtx]
    [app.msgbus :as mbus]
    [app.util.time :as dt]
@@ -35,7 +34,7 @@
 (def state (atom {}))
 
 (defn- on-connect
-  [{:keys [::mtx/metrics]} wsp]
+  [{:keys [metrics]} wsp]
   (let [created-at (dt/now)]
     (swap! state assoc (::ws/id @wsp) wsp)
     (mtx/run! metrics
@@ -49,7 +48,7 @@
                 :val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)))))
 
 (defn- on-rcv-message
-  [{:keys [::mtx/metrics]} _ message]
+  [{:keys [metrics]} _ message]
   (mtx/run! metrics
             :id :websocket-messages-total
             :labels recv-labels
@@ -57,7 +56,7 @@
   message)
 
 (defn- on-snd-message
-  [{:keys [::mtx/metrics]} _ message]
+  [{:keys [metrics]} _ message]
   (mtx/run! metrics
             :id :websocket-messages-total
             :labels send-labels
@@ -96,6 +95,7 @@
      :user-agent       (::ws/user-agent @wsp)
      :ip-addr          (::ws/remote-addr @wsp)
      :last-activity-at (::ws/last-activity-at @wsp)
+     :http-session-id  (::ws/http-session-id @wsp)
      :subscribed-file  (-> wsp deref ::file-subscription :file-id)
      :subscribed-team  (-> wsp deref ::team-subscription :team-id)}))
 
@@ -120,7 +120,7 @@
 (defmethod handle-message :connect
   [cfg wsp _]
 
-  (let [msgbus     (::mbus/msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
@@ -139,7 +139,7 @@
 
 (defmethod handle-message :disconnect
   [cfg wsp _]
-  (let [msgbus     (::mbus/msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
@@ -173,7 +173,7 @@
 
 (defmethod handle-message :subscribe-team
   [cfg wsp {:keys [team-id] :as params}]
-  (let [msgbus     (::mbus/msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         session-id (::session-id @wsp)
         output-ch  (::ws/output-ch @wsp)
@@ -205,7 +205,7 @@
 
 (defmethod handle-message :subscribe-file
   [cfg wsp {:keys [file-id] :as params}]
-  (let [msgbus     (::mbus/msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
@@ -258,7 +258,7 @@
 
 (defmethod handle-message :unsubscribe-file
   [cfg wsp {:keys [file-id] :as params}]
-  (let [msgbus     (::mbus/msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         session-id (::session-id @wsp)
         profile-id (::profile-id @wsp)
@@ -288,7 +288,7 @@
 
 (defmethod handle-message :pointer-update
   [cfg wsp {:keys [file-id] :as message}]
-  (let [msgbus     (::mbus/msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
         subs       (::file-subscription @wsp)
@@ -313,47 +313,39 @@
 ;; HTTP HANDLER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(s/def ::msgbus ::mbus/msgbus)
 (s/def ::session-id ::us/uuid)
+
 (s/def ::handler-params
   (s/keys :req-un [::session-id]))
 
-(defn- http-handler
-  [cfg {:keys [params ::session/profile-id] :as request} respond raise]
-  (let [{:keys [session-id]} (us/conform ::handler-params params)]
-    (cond
-      (not profile-id)
-      (raise (ex/error :type :authentication
-                       :hint "Authentication required."))
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::msgbus ::db/pool ::mtx/metrics]))
 
-      (not (yws/upgrade-request? request))
-      (raise (ex/error :type :validation
-                       :code :websocket-request-expected
-                       :hint "this endpoint only accepts websocket connections"))
-
-      :else
-      (do
-        (l/trace :hint "websocket request" :profile-id profile-id :session-id session-id)
-
-        (->> (ws/handler
-              ::ws/on-rcv-message (partial on-rcv-message cfg)
-              ::ws/on-snd-message (partial on-snd-message cfg)
-              ::ws/on-connect (partial on-connect cfg)
-              ::ws/handler (partial handle-message cfg)
-              ::profile-id profile-id
-              ::session-id session-id)
-             (yws/upgrade request)
-             (respond))))))
-
-(defmethod ig/pre-init-spec ::routes [_]
-  (s/keys :req [::mbus/msgbus
-                ::mtx/metrics
-                ::db/pool
-                ::session/manager]))
-
-(s/def ::routes vector?)
-
-(defmethod ig/init-key ::routes
+(defmethod ig/init-key ::handler
   [_ cfg]
-  ["/ws/notifications" {:middleware [[session/authz cfg]]
-                        :handler (partial http-handler cfg)
-                        :allowed-methods #{:get}}])
+  (fn [{:keys [profile-id params] :as req} respond raise]
+    (let [{:keys [session-id]} (us/conform ::handler-params params)]
+      (cond
+        (not profile-id)
+        (raise (ex/error :type :authentication
+                         :hint "Authentication required."))
+
+        (not (yws/upgrade-request? req))
+        (raise (ex/error :type :validation
+                         :code :websocket-request-expected
+                         :hint "this endpoint only accepts websocket connections"))
+
+        :else
+        (do
+          (l/trace :hint "websocket request" :profile-id profile-id :session-id session-id)
+
+          (->> (ws/handler
+                ::ws/on-rcv-message (partial on-rcv-message cfg)
+                ::ws/on-snd-message (partial on-snd-message cfg)
+                ::ws/on-connect (partial on-connect cfg)
+                ::ws/handler (partial handle-message cfg)
+                ::profile-id profile-id
+                ::session-id session-id)
+               (yws/upgrade req)
+               (respond)))))))

backend/src/app/loggers/audit.clj

@@ -8,7 +8,6 @@
   "Services related to the user activity (audit log)."
   (:require
    [app.common.data :as d]
-   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.spec :as us]
@@ -21,9 +20,7 @@
    [app.loggers.webhooks :as-alias webhooks]
    [app.main :as-alias main]
    [app.metrics :as mtx]
-   [app.rpc :as-alias rpc]
    [app.tokens :as tokens]
-   [app.util.retry :as rtry]
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
@@ -150,48 +147,35 @@
                 :name (:name event)
                 :type (:type event)
                 :profile-id (:profile-id event)
+                :tracked-at (dt/now)
                 :ip-addr (:ip-addr event)
                 :props (:props event)}]
 
     (when (contains? cf/flags :audit-log)
-      ;; NOTE: this operation may cause primary key conflicts on inserts
-      ;; because of the timestamp precission (two concurrent requests), in
-      ;; this case we just retry the operation.
-      (rtry/with-retry {::rtry/when rtry/conflict-exception?
-                        ::rtry/max-retries 6
-                        ::rtry/label "persist-audit-log"}
-        (let [now (dt/now)]
-          (db/insert! pool :audit-log
-                      (-> params
-                          (update :props db/tjson)
-                          (update :ip-addr db/inet)
-                          (assoc :created-at now)
-                          (assoc :tracked-at now)
-                          (assoc :source "backend"))))))
+      (db/insert! pool :audit-log
+                  (-> params
+                      (update :props db/tjson)
+                      (update :ip-addr db/inet)
+                      (assoc :source "backend"))))
 
     (when (and (contains? cf/flags :webhooks)
                (::webhooks/event? event))
       (let [batch-key     (::webhooks/batch-key event)
-            batch-timeout (::webhooks/batch-timeout event)
-            label         (dm/str "rpc:" (:name params))
-            label         (cond
-                            (ifn? batch-key)    (dm/str label ":" (batch-key (::rpc/params event)))
-                            (string? batch-key) (dm/str label ":" batch-key)
-                            :else               label)
-            dedupe?       (boolean (and batch-key batch-timeout))]
-
+            batch-timeout (::webhooks/batch-timeout event)]
         (wrk/submit! ::wrk/conn pool
                      ::wrk/task :process-webhook-event
                      ::wrk/queue :webhooks
                      ::wrk/max-retries 0
                      ::wrk/delay (or batch-timeout 0)
-                     ::wrk/dedupe dedupe?
-                     ::wrk/label label
-
-                     ::webhooks/event
-                     (-> params
-                         (dissoc :ip-addr)
-                         (dissoc :type)))))))
+                     ::wrk/label (cond
+                                   (fn? batch-key)        (batch-key (:props event))
+                                   (keyword? batch-key)   (name batch-key)
+                                   (string? batch-key)    batch-key
+                                   :else                  "default")
+                     ::wrk/dedupe true
+                     ::webhooks/event (-> params
+                                          (dissoc :ip-addr)
+                                          (dissoc :type)))))))
 
 (defn submit!
   "Submit audit event to the collector."

backend/src/app/loggers/database.clj

@@ -11,12 +11,12 @@
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
-   [app.loggers.zmq :as lzmq]
+   [app.util.async :as aa]
+   [app.worker :as wrk]
    [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [integrant.core :as ig]
-   [promesa.exec :as px]))
+   [integrant.core :as ig]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Error Listener
@@ -27,7 +27,7 @@
 (defonce enabled (atom true))
 
 (defn- persist-on-database!
-  [{:keys [::db/pool] :as cfg} {:keys [id] :as event}]
+  [{:keys [pool] :as cfg} {:keys [id] :as event}]
   (when-not (db/read-only? pool)
     (db/insert! pool :server-error-report {:id id :content (db/tjson event)})))
 
@@ -53,49 +53,41 @@
       (assoc :version (:full cf/version))
       (update :id #(or % (uuid/next)))))
 
-(defn- handle-event
-  [cfg event]
-  (try
-    (let [event (parse-event event)
-          uri   (cf/get :public-uri)]
+(defn handle-event
+  [{:keys [executor] :as cfg} event]
+  (aa/with-thread executor
+    (try
+      (let [event (parse-event event)
+            uri   (cf/get :public-uri)]
 
-      (l/debug :hint "registering error on database" :id (:id event)
-               :uri (str uri "/dbg/error/" (:id event)))
+        (l/debug :hint "registering error on database" :id (:id event)
+                 :uri (str uri "/dbg/error/" (:id event)))
 
-      (persist-on-database! cfg event))
-    (catch Throwable cause
-      (l/warn :hint "unexpected exception on database error logger" :cause cause))))
+        (persist-on-database! cfg event))
+      (catch Exception cause
+        (l/warn :hint "unexpected exception on database error logger" :cause cause)))))
 
-(defn- error-event?
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req-un [::wrk/executor ::db/pool ::receiver]))
+
+(defn error-event?
   [event]
   (= "error" (:logger/level event)))
 
-(defmethod ig/pre-init-spec ::reporter [_]
-  (s/keys :req [::db/pool ::lzmq/receiver]))
-
 (defmethod ig/init-key ::reporter
-  [_ {:keys [::lzmq/receiver] :as cfg}]
-  (px/thread
-    {:name "penpot/database-reporter"}
-    (l/info :hint "initializing database error persistence")
-
-    (let [input (a/chan (a/sliding-buffer 5)
-                        (filter error-event?))]
-      (try
-        (lzmq/sub! receiver input)
-        (loop []
-          (when-let [msg (a/<!! input)]
-            (handle-event cfg msg))
-          (recur))
-
-        (catch InterruptedException _
-          (l/debug :hint "reporter interrupted"))
-        (catch Throwable cause
-          (l/error :hint "unexpected error" :cause cause))
-        (finally
-          (a/close! input)
-          (l/info :hint "reporter terminated"))))))
+  [_ {:keys [receiver] :as cfg}]
+  (l/info :msg "initializing database error persistence")
+  (let [output (a/chan (a/sliding-buffer 5) (filter error-event?))]
+    (receiver :sub output)
+    (a/go-loop []
+      (let [msg (a/<! output)]
+        (if (nil? msg)
+          (l/info :msg "stopping error reporting loop")
+          (do
+            (a/<! (handle-event cfg msg))
+            (recur)))))
+    output))
 
 (defmethod ig/halt-key! ::reporter
-  [_ thread]
-  (some-> thread px/interrupt!))
+  [_ output]
+  (a/close! output))

backend/src/app/loggers/mattermost.clj

@@ -38,13 +38,13 @@
 
 (defn handle-event
   [cfg event]
-  (when @enabled
-    (try
-      (let [event (ldb/parse-event event)]
-        (send-mattermost-notification! cfg event))
-      (catch Throwable cause
-        (l/warn :hint "unhandled error"
-                :cause cause)))))
+  (try
+    (let [event (ldb/parse-event event)]
+      (when @enabled
+        (send-mattermost-notification! cfg event)))
+    (catch Throwable cause
+      (l/warn :hint "unhandled error"
+              :cause cause))))
 
 (defmethod ig/pre-init-spec ::reporter [_]
   (s/keys :req [::http/client

backend/src/app/loggers/webhooks.clj

@@ -8,7 +8,6 @@
   "A mattermost integration for error reporting."
   (:require
    [app.common.data :as d]
-   [app.common.data.macros :as dm]
    [app.common.logging :as l]
    [app.common.transit :as t]
    [app.common.uri :as uri]
@@ -22,24 +21,15 @@
    [cuerdas.core :as str]
    [integrant.core :as ig]))
 
-;; --- HELPERS
-
-(defn key-fn
-  [k & keys]
-  (fn [params]
-    (reduce #(dm/str %1 ":" (get params %2))
-            (dm/str (get params k))
-            keys)))
-
 ;; --- PROC
 
 (defn- lookup-webhooks-by-team
   [pool team-id]
-  (db/exec! pool ["select w.* from webhook as w where team_id=? and is_active=true" team-id]))
+  (db/exec! pool ["select * from webhook where team_id=? and is_active=true" team-id]))
 
 (defn- lookup-webhooks-by-project
   [pool project-id]
-  (let [sql [(str "select w.* from webhook as w"
+  (let [sql [(str "select * from webhook as w"
                   "  join project as p on (p.team_id = w.team_id)"
                   " where p.id = ? and w.is_active = true")
              project-id]]
@@ -47,7 +37,7 @@
 
 (defn- lookup-webhooks-by-file
   [pool file-id]
-  (let [sql [(str "select w.* from webhook as w"
+  (let [sql [(str "select * from webhook as w"
                   "  join project as p on (p.team_id = w.team_id)"
                   "  join file as f on (f.project_id = p.id)"
                   " where f.id = ? and w.is_active = true")
@@ -72,6 +62,7 @@
                :name (:name event))
 
       (when-let [items (lookup-webhooks cfg event)]
+        ;; (app.common.pprint/pprint items)
         (l/trace :hint "webhooks found for event" :total (count items))
 
         (db/with-atomic [conn pool]
@@ -111,7 +102,7 @@
                               " where id=?")
                          err
                          (:id whook)]
-                    res (db/exec-one! pool sql {::db/return-keys? true})]
+                    res (db/exec-one! pool sql {:return-keys true})]
                 (when (>= (:error-count res) max-errors)
                   (db/update! pool :webhook {:is-active false} {:id (:id whook)})))
 
@@ -178,9 +169,6 @@
     (instance? java.net.ConnectException cause)
     "connection-error"
 
-    (instance? java.lang.IllegalArgumentException cause)
-    "invalid-uri"
-
     (instance? java.net.http.HttpConnectTimeoutException cause)
     "timeout"
     ))

backend/src/app/main.clj

@@ -6,31 +6,20 @@
 
 (ns app.main
   (:require
-   [app.auth.ldap :as-alias ldap]
    [app.auth.oidc :as-alias oidc]
    [app.auth.oidc.providers :as-alias oidc.providers]
    [app.common.logging :as l]
    [app.config :as cf]
    [app.db :as-alias db]
-   [app.http.access-token :as-alias actoken]
-   [app.http.assets :as-alias http.assets]
-   [app.http.awsns :as http.awsns]
    [app.http.client :as-alias http.client]
-   [app.http.debug :as-alias http.debug]
-   [app.http.session :as-alias session]
-   [app.http.session.tasks :as-alias session.tasks]
-   [app.http.websocket :as http.ws]
+   [app.http.session :as-alias http.session]
    [app.loggers.audit :as-alias audit]
    [app.loggers.audit.tasks :as-alias audit.tasks]
    [app.loggers.webhooks :as-alias webhooks]
    [app.loggers.zmq :as-alias lzmq]
    [app.metrics :as-alias mtx]
    [app.metrics.definition :as-alias mdef]
-   [app.msgbus :as-alias mbus]
    [app.redis :as-alias rds]
-   [app.rpc :as-alias rpc]
-   [app.rpc.doc :as-alias rpc.doc]
-   [app.srepl :as-alias srepl]
    [app.storage :as-alias sto]
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
@@ -190,9 +179,6 @@
    ::mtx/metrics
    {:default default-metrics}
 
-   ::mtx/routes
-   {::mtx/metrics (ig/ref ::mtx/metrics)}
-
    :app.migrations/all
    {:main (ig/ref :app.migrations/migrations)}
 
@@ -200,7 +186,7 @@
    {::rds/uri     (cf/get :redis-uri)
     ::mtx/metrics (ig/ref ::mtx/metrics)}
 
-   ::mbus/msgbus
+   :app.msgbus/msgbus
    {:backend   (cf/get :msgbus-backend :redis)
     :executor  (ig/ref ::wrk/executor)
     :redis     (ig/ref ::rds/redis)}
@@ -220,20 +206,16 @@
    ::http.client/client
    {::wrk/executor (ig/ref ::wrk/executor)}
 
-   ::session/manager
-   {::db/pool      (ig/ref ::db/pool)
-    ::wrk/executor (ig/ref ::wrk/executor)
-    ::props        (ig/ref :app.setup/props)}
+   :app.http.session/manager
+   {:pool     (ig/ref ::db/pool)
+    :sprops   (ig/ref :app.setup/props)
+    :executor (ig/ref ::wrk/executor)}
 
-   ::actoken/manager
-   {::db/pool      (ig/ref ::db/pool)
-    ::wrk/executor (ig/ref ::wrk/executor)
-    ::props        (ig/ref :app.setup/props)}
+   :app.http.session/gc-task
+   {:pool        (ig/ref ::db/pool)
+    :max-age     (cf/get :auth-token-cookie-max-age)}
 
-   ::session.tasks/gc
-   {::db/pool (ig/ref ::db/pool)}
-
-   ::http.awsns/routes
+   :app.http.awsns/handler
    {::props              (ig/ref :app.setup/props)
     ::db/pool            (ig/ref ::db/pool)
     ::http.client/client (ig/ref ::http.client/client)
@@ -249,7 +231,7 @@
     :max-body-size           (cf/get :http-server-max-body-size)
     :max-multipart-body-size (cf/get :http-server-max-multipart-body-size)}
 
-   ::ldap/provider
+   :app.auth.ldap/provider
    {:host           (cf/get :ldap-host)
     :port           (cf/get :ldap-port)
     :ssl            (cf/get :ldap-ssl)
@@ -276,44 +258,46 @@
    {::http.client/client (ig/ref ::http.client/client)}
 
    ::oidc/routes
-   {::http.client/client (ig/ref ::http.client/client)
-    ::db/pool            (ig/ref ::db/pool)
-    ::props              (ig/ref :app.setup/props)
-    ::wrk/executor       (ig/ref ::wrk/executor)
-    ::oidc/providers     {:google (ig/ref ::oidc.providers/google)
-                          :github (ig/ref ::oidc.providers/github)
-                          :gitlab (ig/ref ::oidc.providers/gitlab)
-                          :oidc   (ig/ref ::oidc.providers/generic)}
-    ::audit/collector    (ig/ref ::audit/collector)
-    ::session/manager    (ig/ref ::session/manager)}
+   {::http.client/client   (ig/ref ::http.client/client)
+    ::db/pool              (ig/ref ::db/pool)
+    ::props                (ig/ref :app.setup/props)
+    ::wrk/executor         (ig/ref ::wrk/executor)
+    ::oidc/providers       {:google (ig/ref ::oidc.providers/google)
+                            :github (ig/ref ::oidc.providers/github)
+                            :gitlab (ig/ref ::oidc.providers/gitlab)
+                            :oidc   (ig/ref ::oidc.providers/generic)}
+    ::audit/collector      (ig/ref ::audit/collector)
+    ::http.session/session (ig/ref :app.http.session/manager)}
 
+
+   ;; TODO: revisit the dependencies of this service, looks they are too much unused of them
    :app.http/router
-   {::session/manager    (ig/ref ::session/manager)
-    ::actoken/manager    (ig/ref ::actoken/manager)
-    ::wrk/executor       (ig/ref ::wrk/executor)
-    ::db/pool            (ig/ref ::db/pool)
-    ::rpc/routes         (ig/ref ::rpc/routes)
-    ::rpc.doc/routes     (ig/ref ::rpc.doc/routes)
-    ::props              (ig/ref :app.setup/props)
-    ::mtx/routes         (ig/ref ::mtx/routes)
-    ::oidc/routes        (ig/ref ::oidc/routes)
-    ::http.debug/routes  (ig/ref ::http.debug/routes)
-    ::http.assets/routes (ig/ref ::http.assets/routes)
-    ::http.ws/routes     (ig/ref ::http.ws/routes)
-    ::http.awsns/routes  (ig/ref ::http.awsns/routes)}
+   {:assets        (ig/ref :app.http.assets/handlers)
+    :feedback      (ig/ref :app.http.feedback/handler)
+    :session       (ig/ref :app.http.session/manager)
+    :awsns-handler (ig/ref :app.http.awsns/handler)
+    :debug-routes  (ig/ref :app.http.debug/routes)
+    :oidc-routes   (ig/ref ::oidc/routes)
+    :ws            (ig/ref :app.http.websocket/handler)
+    :metrics       (ig/ref ::mtx/metrics)
+    :public-uri    (cf/get :public-uri)
+    :storage       (ig/ref ::sto/storage)
+    :rpc-routes    (ig/ref :app.rpc/routes)
+    :doc-routes    (ig/ref :app.rpc.doc/routes)
+    :executor      (ig/ref ::wrk/executor)}
 
    :app.http.debug/routes
-   {::db/pool         (ig/ref ::db/pool)
-    ::wrk/executor    (ig/ref ::wrk/executor)
-    ::session/manager (ig/ref ::session/manager)}
+   {:pool     (ig/ref ::db/pool)
+    :executor (ig/ref ::wrk/executor)
+    :storage  (ig/ref ::sto/storage)
+    :session  (ig/ref :app.http.session/manager)}
 
-   :app.http.websocket/routes
-   {::db/pool         (ig/ref ::db/pool)
-    ::mtx/metrics     (ig/ref ::mtx/metrics)
-    ::mbus/msgbus     (ig/ref :app.msgbus/msgbus)
-    ::session/manager (ig/ref ::session/manager)}
+   :app.http.websocket/handler
+   {:pool     (ig/ref ::db/pool)
+    :metrics  (ig/ref ::mtx/metrics)
+    :msgbus   (ig/ref :app.msgbus/msgbus)}
 
-   :app.http.assets/routes
+   :app.http.assets/handlers
    {:metrics           (ig/ref ::mtx/metrics)
     :assets-path       (cf/get :assets-path)
     :storage           (ig/ref ::sto/storage)
@@ -321,32 +305,37 @@
     :cache-max-age     (dt/duration {:hours 24})
     :signature-max-age (dt/duration {:hours 24 :minutes 5})}
 
+   :app.http.feedback/handler
+   {:pool     (ig/ref ::db/pool)
+    :executor (ig/ref ::wrk/executor)}
+
    :app.rpc/climit
-   {::mtx/metrics  (ig/ref ::mtx/metrics)
-    ::wrk/executor (ig/ref ::wrk/executor)}
+   {:metrics  (ig/ref ::mtx/metrics)
+    :executor (ig/ref ::wrk/executor)}
 
    :app.rpc/rlimit
-   {::wrk/executor           (ig/ref ::wrk/executor)
-    ::wrk/scheduled-executor (ig/ref ::wrk/scheduled-executor)}
+   {:executor  (ig/ref ::wrk/executor)
+    :scheduled-executor (ig/ref ::wrk/scheduled-executor)}
 
    :app.rpc/methods
    {::audit/collector    (ig/ref ::audit/collector)
     ::http.client/client (ig/ref ::http.client/client)
     ::db/pool            (ig/ref ::db/pool)
     ::wrk/executor       (ig/ref ::wrk/executor)
-    ::session/manager    (ig/ref ::session/manager)
-    ::ldap/provider      (ig/ref ::ldap/provider)
-    ::sto/storage        (ig/ref ::sto/storage)
-    ::mtx/metrics        (ig/ref ::mtx/metrics)
-    ::mbus/msgbus        (ig/ref ::mbus/msgbus)
-    ::rds/redis          (ig/ref ::rds/redis)
-
-    ::rpc/climit         (ig/ref ::rpc/climit)
-    ::rpc/rlimit         (ig/ref ::rpc/rlimit)
-
-    ::props              (ig/ref :app.setup/props)
 
     :pool                (ig/ref ::db/pool)
+    :session             (ig/ref :app.http.session/manager)
+    :sprops              (ig/ref :app.setup/props)
+    :metrics             (ig/ref ::mtx/metrics)
+    :storage             (ig/ref ::sto/storage)
+    :msgbus              (ig/ref :app.msgbus/msgbus)
+    :public-uri          (cf/get :public-uri)
+    :redis               (ig/ref ::rds/redis)
+    :ldap                (ig/ref :app.auth.ldap/provider)
+    :http-client         (ig/ref ::http.client/client)
+    :climit              (ig/ref :app.rpc/climit)
+    :rlimit              (ig/ref :app.rpc/rlimit)
+    :executor            (ig/ref ::wrk/executor)
     :templates           (ig/ref :app.setup/builtin-templates)
     }
 
@@ -354,12 +343,7 @@
    {:methods (ig/ref :app.rpc/methods)}
 
    :app.rpc/routes
-   {::rpc/methods     (ig/ref :app.rpc/methods)
-    ::db/pool         (ig/ref ::db/pool)
-    ::wrk/executor    (ig/ref ::wrk/executor)
-    ::session/manager (ig/ref ::session/manager)
-    ::actoken/manager (ig/ref ::actoken/manager)
-    ::props           (ig/ref :app.setup/props)}
+   {:methods (ig/ref :app.rpc/methods)}
 
    ::wrk/registry
    {:metrics (ig/ref ::mtx/metrics)
@@ -372,7 +356,7 @@
      :storage-gc-touched (ig/ref ::sto/gc-touched-task)
      :tasks-gc           (ig/ref :app.tasks.tasks-gc/handler)
      :telemetry          (ig/ref :app.tasks.telemetry/handler)
-     :session-gc         (ig/ref ::session.tasks/gc)
+     :session-gc         (ig/ref :app.http.session/gc-task)
      :audit-log-archive  (ig/ref ::audit.tasks/archive)
      :audit-log-gc       (ig/ref ::audit.tasks/gc)
 
@@ -401,8 +385,8 @@
     :max-age cf/deletion-delay}
 
    :app.tasks.objects-gc/handler
-   {::db/pool     (ig/ref ::db/pool)
-    ::sto/storage (ig/ref ::sto/storage)}
+   {:pool    (ig/ref ::db/pool)
+    :storage (ig/ref ::sto/storage)}
 
    :app.tasks.file-gc/handler
    {:pool (ig/ref ::db/pool)}
@@ -415,13 +399,9 @@
     ::http.client/client (ig/ref ::http.client/client)
     ::props              (ig/ref :app.setup/props)}
 
-   [::srepl/urepl ::srepl/server]
-   {:port (cf/get :urepl-port 6062)
-    :host (cf/get :urepl-host "localhost")}
-
-   [::srepl/prepl ::srepl/server]
-   {:port (cf/get :prepl-port 6063)
-    :host (cf/get :prepl-host "localhost")}
+   :app.srepl/server
+   {:port (cf/get :srepl-port)
+    :host (cf/get :srepl-host)}
 
    :app.setup/builtin-templates
    {::http.client/client (ig/ref ::http.client/client)}
@@ -463,8 +443,9 @@
     ::http.client/client (ig/ref ::http.client/client)}
 
    :app.loggers.database/reporter
-   {::lzmq/receiver (ig/ref :app.loggers.zmq/receiver)
-    ::db/pool       (ig/ref ::db/pool)}
+   {:receiver (ig/ref :app.loggers.zmq/receiver)
+    :pool     (ig/ref ::db/pool)
+    :executor (ig/ref ::wrk/executor)}
 
    ::sto/storage
    {:pool     (ig/ref ::db/pool)

backend/src/app/metrics.clj

@@ -87,7 +87,6 @@
      ::definitions definitions
      ::registry registry}))
 
-
 (defn- handler
   [registry _ respond _]
   (let [samples  (.metricFamilySamples ^CollectorRegistry registry)
@@ -96,18 +95,6 @@
     (respond {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
               :body (.toString writer)})))
 
-
-
-(s/def ::routes vector?)
-(defmethod ig/pre-init-spec ::routes [_]
-  (s/keys :req [::metrics]))
-
-(defmethod ig/init-key ::routes
-  [_ {:keys [::metrics]}]
-  (let [registry (::registry metrics)]
-    ["/metrics" {:handler (partial handler registry)
-                 :allowed-methods #{:get}}]))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -145,7 +132,7 @@
 
 (defmethod run-collector! :counter
   [{:keys [::mdef/instance]} {:keys [inc labels] :or {inc 1 labels default-empty-labels}}]
-  (let [instance (.labels ^Counter instance (if (is-array? labels) labels (into-array String labels)))]
+  (let [instance (.labels instance (if (is-array? labels) labels (into-array String labels)))]
     (.inc ^Counter$Child instance (double inc))))
 
 (defmethod run-collector! :gauge

backend/src/app/migrations.clj

@@ -271,44 +271,7 @@
 
    {:name "0087-mod-task-table"
     :fn (mg/resource "app/migrations/sql/0087-mod-task-table.sql")}
-
-   {:name "0088-mod-team-profile-rel-table"
-    :fn (mg/resource "app/migrations/sql/0088-mod-team-profile-rel-table.sql")}
-
-   {:name "0089-mod-project-profile-rel-table"
-    :fn (mg/resource "app/migrations/sql/0089-mod-project-profile-rel-table.sql")}
-
-   {:name "0090-mod-http-session-table"
-    :fn (mg/resource "app/migrations/sql/0090-mod-http-session-table.sql")}
-
-   {:name "0091-mod-team-project-profile-rel-table"
-    :fn (mg/resource "app/migrations/sql/0091-mod-team-project-profile-rel-table.sql")}
-
-   {:name "0092-mod-team-invitation-table"
-    :fn (mg/resource "app/migrations/sql/0092-mod-team-invitation-table.sql")}
-
-   {:name "0093-del-file-share-tokens-table"
-    :fn (mg/resource "app/migrations/sql/0093-del-file-share-tokens-table.sql")}
-
-   {:name "0094-del-profile-attr-table"
-    :fn (mg/resource "app/migrations/sql/0094-del-profile-attr-table.sql")}
-
-   {:name "0095-del-storage-data-table"
-    :fn (mg/resource "app/migrations/sql/0095-del-storage-data-table.sql")}
-
-   {:name "0096-del-storage-pending-table"
-    :fn (mg/resource "app/migrations/sql/0096-del-storage-pending-table.sql")}
-
-   {:name "0098-add-quotes-table"
-    :fn (mg/resource "app/migrations/sql/0098-add-quotes-table.sql")}
-
-   {:name "0099-add-access-token-table"
-    :fn (mg/resource "app/migrations/sql/0099-add-access-token-table.sql")}
-
-   {:name "0100-mod-profile-indexes"
-    :fn (mg/resource "app/migrations/sql/0100-mod-profile-indexes.sql")}
-
-  ])
+   ])
 
 
 (defmethod ig/init-key ::migrations [_ _] migrations)

backend/src/app/migrations/sql/0088-mod-team-profile-rel-table.sql

@@ -1,3 +0,0 @@
-ALTER TABLE team_profile_rel DROP CONSTRAINT team_profile_rel_pkey;
-ALTER TABLE team_profile_rel ADD COLUMN id uuid DEFAULT uuid_generate_v4() PRIMARY KEY;
-ALTER TABLE team_profile_rel ADD CONSTRAINT team_profile_rel_unique UNIQUE (team_id, profile_id);

backend/src/app/migrations/sql/0089-mod-project-profile-rel-table.sql

@@ -1,3 +0,0 @@
-ALTER TABLE project_profile_rel DROP CONSTRAINT project_profile_rel_pkey;
-ALTER TABLE project_profile_rel ADD COLUMN id uuid DEFAULT uuid_generate_v4() PRIMARY KEY;
-ALTER TABLE project_profile_rel ADD CONSTRAINT project_profile_rel_unique UNIQUE (project_id, profile_id);

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

@@ -1,2 +0,0 @@
-ALTER TABLE http_session DROP CONSTRAINT http_session_pkey;
-ALTER TABLE http_session ADD CONSTRAINT http_session_pkey PRIMARY KEY (id);

backend/src/app/migrations/sql/0091-mod-team-project-profile-rel-table.sql

@@ -1,3 +0,0 @@
-ALTER TABLE team_project_profile_rel DROP CONSTRAINT team_project_profile_rel_pkey;
-ALTER TABLE team_project_profile_rel ADD COLUMN id uuid DEFAULT uuid_generate_v4() PRIMARY KEY;
-ALTER TABLE team_project_profile_rel ADD CONSTRAINT team_project_profile_rel_unique UNIQUE (team_id, project_id, profile_id);

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

@@ -1,3 +0,0 @@
-ALTER TABLE team_invitation DROP CONSTRAINT team_invitation_pkey;
-ALTER TABLE team_invitation ADD COLUMN id uuid DEFAULT uuid_generate_v4() PRIMARY KEY;
-ALTER TABLE team_invitation ADD CONSTRAINT team_invitation_unique UNIQUE (team_id, email_to);

backend/src/app/migrations/sql/0093-del-file-share-tokens-table.sql

@@ -1 +0,0 @@
-DROP TABLE file_share_token;

backend/src/app/migrations/sql/0094-del-profile-attr-table.sql

@@ -1 +0,0 @@
-DROP TABLE profile_attr;

backend/src/app/migrations/sql/0095-del-storage-data-table.sql

@@ -1 +0,0 @@
-DROP TABLE storage_data;

backend/src/app/migrations/sql/0096-del-storage-pending-table.sql

@@ -1 +0,0 @@
-DROP TABLE storage_pending;

backend/src/app/migrations/sql/0098-add-quotes-table.sql

@@ -1,82 +0,0 @@
-CREATE TABLE usage_quote (
-  id uuid NOT NULL DEFAULT uuid_generate_v4() PRIMARY KEY,
-  target text NOT NULL,
-  quote bigint NOT NULL,
-
-  profile_id uuid NULL REFERENCES profile(id) ON DELETE CASCADE DEFERRABLE,
-  project_id uuid NULL REFERENCES project(id) ON DELETE CASCADE DEFERRABLE,
-  team_id uuid NULL REFERENCES team(id) ON DELETE CASCADE DEFERRABLE,
-  file_id uuid NULL REFERENCES file(id) ON DELETE CASCADE DEFERRABLE
-);
-
-ALTER TABLE usage_quote
-  ALTER COLUMN target SET STORAGE external;
-
-CREATE INDEX usage_quote__profile_id__idx ON usage_quote(profile_id, target);
-CREATE INDEX usage_quote__project_id__idx ON usage_quote(project_id, target);
-CREATE INDEX usage_quote__team_id__idx ON usage_quote(team_id, target);
-
--- DROP TABLE IF EXISTS usage_quote_test;
--- CREATE TABLE usage_quote_test (
---   id bigserial NOT NULL PRIMARY KEY,
---   target text NOT NULL,
---   quote bigint NOT NULL,
-
---   profile_id bigint NULL,
---   team_id bigint NULL,
---   project_id bigint NULL,
---   file_id bigint NULL
--- );
-
--- ALTER TABLE usage_quote_test
---   ALTER COLUMN target SET STORAGE external;
-
--- CREATE INDEX usage_quote_test__profile_id__idx ON usage_quote_test(profile_id, target);
--- CREATE INDEX usage_quote_test__project_id__idx ON usage_quote_test(project_id, target);
--- CREATE INDEX usage_quote_test__team_id__idx ON usage_quote_test(team_id, target);
--- -- CREATE INDEX usage_quote_test__target__idx ON usage_quote_test(target);
-
--- DELETE FROM usage_quote_test;
-
--- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
--- SELECT 'files-per-project', 50*RANDOM(), 2000*RANDOM(), null, null
---   FROM generate_series(1, 5000);
-
--- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
--- SELECT 'files-per-project', 200*RANDOM(), 300*RANDOM(), 300*RANDOM(), null
---   FROM generate_series(1, 1000);
-
--- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
--- SELECT 'files-per-project', 100*RANDOM(), 300*RANDOM(), null, 300*RANDOM()
---   FROM generate_series(1, 1000);
-
--- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
--- SELECT 'files-per-project', 100*RANDOM(), 300*RANDOM(), 300*RANDOM(), 300*RANDOM()
---   FROM generate_series(1, 1000);
-
--- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
--- SELECT 'files-per-project', 30*RANDOM(), null, 2000*RANDOM(), null
---   FROM generate_series(1, 5000);
-
--- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
--- SELECT 'files-per-project', 10*RANDOM(), null, null, 2000*RANDOM()
---   FROM generate_series(1, 5000);
-
--- VACUUM ANALYZE usage_quote_test;
-
--- select * from usage_quote_test
---  where target = 'files-per-project'
---    and profile_id = 1
---    and team_id is null
---    and project_id is null;
-
--- select * from usage_quote_test
---  where target = 'files-per-project'
---    and ((team_id = 1 and (profile_id = 1 or profile_id is null)) or
---         (profile_id = 1 and team_id is null and project_id is null));
-
--- select * from usage_quote_test
---  where target = 'files-per-project'
---    and ((project_id = 1 and (profile_id = 1 or profile_id is null)) or
---         (team_id = 1 and (profile_id = 1 or profile_id is null)) or
---         (profile_id = 1 and team_id is null and project_id is null));

backend/src/app/migrations/sql/0099-add-access-token-table.sql

@@ -1,19 +0,0 @@
-DROP TABLE IF EXISTS access_token;
-CREATE TABLE access_token (
-  id uuid NOT NULL DEFAULT uuid_generate_v4() PRIMARY KEY,
-  profile_id uuid NOT NULL REFERENCES profile(id) ON DELETE CASCADE DEFERRABLE,
-
-  created_at timestamptz NOT NULL DEFAULT now(),
-  updated_at timestamptz NOT NULL DEFAULT now(),
-
-  name text NOT NULL,
-  token text NOT NULL,
-  perms text[] NULL
-);
-
-ALTER TABLE access_token
-  ALTER COLUMN name SET STORAGE external,
-  ALTER COLUMN token SET STORAGE external,
-  ALTER COLUMN perms SET STORAGE external;
-
-CREATE INDEX access_token__profile_id__idx ON access_token(profile_id);

backend/src/app/migrations/sql/0100-mod-profile-indexes.sql

@@ -1,31 +0,0 @@
-ALTER TABLE profile
-  ADD COLUMN default_project_id uuid NULL REFERENCES project(id) ON DELETE SET NULL DEFERRABLE,
-  ADD COLUMN default_team_id uuid NULL REFERENCES team(id) ON DELETE SET NULL DEFERRABLE;
-
-CREATE INDEX profile__default_project__idx ON profile(default_project_id);
-CREATE INDEX profile__default_team__idx ON profile(default_team_id);
-
-with profiles as (
-  select p.id,
-         tpr.team_id as default_team_id,
-         ppr.project_id as default_project_id
-    from profile as p
-    join team_profile_rel as tpr
-      on (tpr.profile_id = p.id and
-          tpr.is_owner is true)
-    join project_profile_rel as ppr
-      on (ppr.profile_id = p.id and
-          ppr.is_owner is true)
-    join project as pj
-      on (pj.id = ppr.project_id)
-    join team as tm
-      on (tm.id = tpr.team_id)
-   where pj.is_default is true
-     and tm.is_default is true
-     and pj.team_id = tm.id
-)
-update profile
-   set default_team_id = p.default_team_id,
-       default_project_id = p.default_project_id
-  from profiles as p
- where profile.id = p.id;

backend/src/app/redis.clj

@@ -193,7 +193,6 @@
 
 (defn get-or-connect
   [{:keys [::cache] :as state} key options]
-  (us/assert! ::redis state)
   (-> state
       (assoc ::connection
              (or (get @cache key)
@@ -206,6 +205,7 @@
 
 (defn add-listener!
   [{:keys [::connection] :as conn} listener]
+  (us/assert! ::connection-holder conn)
   (us/assert! ::pubsub-connection connection)
   (us/assert! ::pubsub-listener listener)
   (.addListener ^StatefulRedisPubSubConnection @connection
@@ -213,9 +213,10 @@
   conn)
 
 (defn publish!
-  [{:keys [::connection]} topic message]
+  [{:keys [::connection] :as conn} topic message]
   (us/assert! ::us/string topic)
   (us/assert! ::us/bytes message)
+  (us/assert! ::connection-holder conn)
   (us/assert! ::default-connection connection)
 
   (let [pcomm (.async ^StatefulRedisConnection @connection)]
@@ -223,7 +224,8 @@
 
 (defn subscribe!
   "Blocking operation, intended to be used on a thread/agent thread."
-  [{:keys [::connection]} & topics]
+  [{:keys [::connection] :as conn} & topics]
+  (us/assert! ::connection-holder conn)
   (us/assert! ::pubsub-connection connection)
   (try
     (let [topics (into-array String (map str topics))
@@ -234,7 +236,8 @@
 
 (defn unsubscribe!
   "Blocking operation, intended to be used on a thread/agent thread."
-  [{:keys [::connection]} & topics]
+  [{:keys [::connection] :as conn} & topics]
+  (us/assert! ::connection-holder conn)
   (us/assert! ::pubsub-connection connection)
   (try
     (let [topics (into-array String (map str topics))
@@ -244,8 +247,8 @@
       (throw (InterruptedException. (ex-message cause))))))
 
 (defn rpush!
-  [{:keys [::connection]} key payload]
-  (us/assert! ::default-connection connection)
+  [{:keys [::connection] :as conn} key payload]
+  (us/assert! ::connection-holder conn)
   (us/assert! (or (and (vector? payload)
                        (every? bytes? payload))
                   (bytes? payload)))
@@ -267,8 +270,8 @@
       (throw (InterruptedException. (ex-message cause))))))
 
 (defn blpop!
-  [{:keys [::connection]} timeout & keys]
-  (us/assert! ::default-connection connection)
+  [{:keys [::connection] :as conn} timeout & keys]
+  (us/assert! ::connection-holder conn)
   (try
     (let [keys    (into-array Object (map str keys))
           cmd     (.sync ^StatefulRedisConnection @connection)
@@ -283,7 +286,8 @@
       (throw (InterruptedException. (ex-message cause))))))
 
 (defn open?
-  [{:keys [::connection]}]
+  [{:keys [::connection] :as conn}]
+  (us/assert! ::connection-holder conn)
   (us/assert! ::pubsub-connection connection)
   (.isOpen ^StatefulConnection @connection))
 
@@ -331,7 +335,7 @@
 (defn eval!
   [{:keys [::mtx/metrics ::connection] :as state} script]
   (us/assert! ::redis state)
-  (us/assert! ::default-connection connection)
+  (us/assert! ::connection-holder state)
   (us/assert! ::rscript/script script)
 
   (let [cmd   (.async ^StatefulRedisConnection @connection)

backend/src/app/rpc.clj

@@ -6,21 +6,17 @@
 
 (ns app.rpc
   (:require
-   [app.auth.ldap :as-alias ldap]
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
-   [app.config :as cf]
    [app.db :as db]
    [app.http :as-alias http]
-   [app.http.access-token :as-alias actoken]
    [app.http.client :as-alias http.client]
-   [app.http.session :as-alias session]
+   [app.http.session :as-alias http.session]
    [app.loggers.audit :as audit]
    [app.loggers.webhooks :as-alias webhooks]
-   [app.main :as-alias main]
    [app.metrics :as mtx]
    [app.msgbus :as-alias mbus]
    [app.rpc.climit :as climit]
@@ -30,7 +26,7 @@
    [app.rpc.rlimit :as rlimit]
    [app.storage :as-alias sto]
    [app.util.services :as sv]
-   [app.util.time :as dt]
+   [app.util.time :as ts]
    [app.worker :as-alias wrk]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
@@ -39,8 +35,6 @@
    [yetti.request :as yrq]
    [yetti.response :as yrs]))
 
-(s/def ::profile-id ::us/uuid)
-
 (defn- default-handler
   [_]
   (p/rejected (ex/error :type :not-found)))
@@ -74,125 +68,77 @@
 (defn- rpc-query-handler
   "Ring handler that dispatches query requests and convert between
   internal async flow into ring async flow."
-  [methods {:keys [params path-params] :as request} respond raise]
-  (let [type       (keyword (:type path-params))
-        profile-id (or (::session/profile-id request)
-                       (::actoken/profile-id request))
+  [methods {:keys [profile-id session-id params] :as request} respond raise]
+  (let [type   (keyword (:type params))
+        data   (into {::http/request request} params)
+        data   (if profile-id
+                 (assoc data :profile-id profile-id ::session-id session-id)
+                 (dissoc data :profile-id))
+        method (get methods type default-handler)]
 
-        data       (-> params
-                       (assoc ::request-at (dt/now))
-                       (assoc ::http/request request))
-        data       (if profile-id
-                     (-> data
-                         (assoc :profile-id profile-id)
-                         (assoc ::profile-id profile-id))
-                     (dissoc data :profile-id ::profile-id))
-        method     (get methods type default-handler)]
-
-    (->> (method data)
-         (p/mcat (partial handle-response request))
-         (p/fnly (fn [response cause]
-                   (if cause
-                     (raise (ex/wrap-with-context cause {:profile-id profile-id}))
-                     (respond response)))))))
+    (-> (method data)
+        (p/then (partial handle-response request))
+        (p/then respond)
+        (p/catch (fn [cause]
+                   (let [context {:profile-id profile-id}]
+                     (raise (ex/wrap-with-context cause context))))))))
 
 (defn- rpc-mutation-handler
   "Ring handler that dispatches mutation requests and convert between
   internal async flow into ring async flow."
-  [methods {:keys [params path-params] :as request} respond raise]
-  (let [type       (keyword (:type path-params))
-        profile-id (or (::session/profile-id request)
-                       (::actoken/profile-id request))
-        data       (-> params
-                       (assoc ::request-at (dt/now))
-                       (assoc ::http/request request))
-        data       (if profile-id
-                     (-> data
-                         (assoc :profile-id profile-id)
-                         (assoc ::profile-id profile-id))
-                     (dissoc data :profile-id))
-        method     (get methods type default-handler)]
+  [methods {:keys [profile-id session-id params] :as request} respond raise]
+  (let [type   (keyword (:type params))
+        data   (into {::http/request request} params)
+        data   (if profile-id
+                 (assoc data :profile-id profile-id ::session-id session-id)
+                 (dissoc data :profile-id))
 
-    (->> (method data)
-         (p/mcat (partial handle-response request))
-         (p/fnly (fn [response cause]
-                   (if cause
-                     (raise (ex/wrap-with-context cause {:profile-id profile-id}))
-                     (respond response)))))))
+        method (get methods type default-handler)]
+    (-> (method data)
+        (p/then (partial handle-response request))
+        (p/then respond)
+        (p/catch (fn [cause]
+                   (let [context {:profile-id profile-id}]
+                     (raise (ex/wrap-with-context cause context))))))))
 
 (defn- rpc-command-handler
   "Ring handler that dispatches cmd requests and convert between
   internal async flow into ring async flow."
-  [methods {:keys [params path-params] :as request} respond raise]
-  (let [type       (keyword (:type path-params))
-        etag       (yrq/get-header request "if-none-match")
-        profile-id (or (::session/profile-id request)
-                       (::actoken/profile-id request))
-
-        data       (-> params
-                       (assoc ::request-at (dt/now))
-                       (assoc ::session/id (::session/id request))
-                       (assoc ::http/request request)
-                       (assoc ::cond/key etag)
-                       (cond-> (uuid? profile-id)
-                         (assoc ::profile-id profile-id)))
-
-        method    (get methods type default-handler)]
+  [methods {:keys [profile-id session-id params] :as request} respond raise]
+  (let [cmd    (keyword (:command params))
+        etag   (yrq/get-header request "if-none-match")
+        data   (into {::http/request request ::cond/key etag} params)
+        data   (if profile-id
+                 (assoc data :profile-id profile-id ::session-id session-id)
+                 (dissoc data :profile-id))
 
+        method (get methods cmd default-handler)]
     (binding [cond/*enabled* true]
-      (->> (method data)
-           (p/mcat (partial handle-response request))
-           (p/fnly (fn [response cause]
-                     (if cause
-                       (raise (ex/wrap-with-context cause {:profile-id profile-id}))
-                       (respond response))))))))
+      (-> (method data)
+          (p/then (partial handle-response request))
+          (p/then respond)
+          (p/catch (fn [cause]
+                     (let [context {:profile-id profile-id}]
+                       (raise (ex/wrap-with-context cause context)))))))))
 
 (defn- wrap-metrics
   "Wrap service method with metrics measurement."
   [{:keys [metrics ::metrics-id]} f mdata]
   (let [labels (into-array String [(::sv/name mdata)])]
     (fn [cfg params]
-      (let [tp (dt/tpoint)]
-        (->> (f cfg params)
-             (p/fnly (fn [_ _]
-                       (mtx/run! metrics
-                                 :id metrics-id
-                                 :val (inst-ms (tp))
-                                 :labels labels))))))))
-
-
-(defn- wrap-authentication
-  [_ f {:keys [::auth] :as mdata}]
-  (fn [cfg params]
-    (let [profile-id (::profile-id params)]
-      (if (and auth (not (uuid? profile-id)))
-        (p/rejected
-         (ex/error :type :authentication
-                   :code :authentication-required
-                   :hint "authentication required for this endpoint"))
-        (f cfg params)))))
-
-(defn- wrap-access-token
-  "Wraps service method with access token validation."
-  [_ f {:keys [::sv/name] :as mdata}]
-  (if (contains? cf/flags :access-tokens)
-    (fn [cfg params]
-      (let [request (::http/request params)]
-        (if (contains? request ::actoken/id)
-          (let [perms (::actoken/perms request #{})]
-            (if (contains? perms name)
-              (f cfg params)
-              (p/rejected
-               (ex/error :type :authorization
-                         :code :operation-not-allowed
-                         :allowed perms))))
-          (f cfg params))))
-    f))
+      (let [tp (ts/tpoint)]
+        (p/finally
+          (f cfg params)
+          (fn [_ _]
+            (mtx/run! metrics
+                      :id metrics-id
+                      :val (inst-ms (tp))
+                      :labels labels)))))))
 
 (defn- wrap-dispatch
   "Wraps service method into async flow, with the ability to dispatching
   it to a preconfigured executor service."
-  [{:keys [::wrk/executor] :as cfg} f mdata]
+  [{:keys [executor] :as cfg} f mdata]
   (with-meta
     (fn [cfg params]
       (->> (px/submit! executor (px/wrap-bindings #(f cfg params)))
@@ -206,21 +152,17 @@
     (letfn [(handle-audit [params result]
               (let [resultm    (meta result)
                     request    (::http/request params)
-
                     profile-id (or (::audit/profile-id resultm)
                                    (:profile-id result)
-                                   (if (= (::type cfg) "command")
-                                     (::profile-id params)
-                                     (:profile-id params))
+                                   (:profile-id params)
                                    uuid/zero)
 
-                    props      (-> (or (::audit/replace-props resultm)
-                                       (-> params
-                                           (merge (::audit/props resultm))
-                                           (dissoc :profile-id)
-                                           (dissoc :type)))
-                                   (d/without-qualified)
-                                   (d/without-nils))
+                    props      (or (::audit/replace-props resultm)
+                                   (-> params
+                                       (d/without-qualified)
+                                       (merge (::audit/props resultm))
+                                       (dissoc :profile-id)
+                                       (dissoc :type)))
 
                     event      {:type (or (::audit/type resultm)
                                           (::type cfg))
@@ -229,12 +171,6 @@
                                 :profile-id profile-id
                                 :ip-addr (some-> request audit/parse-client-ip)
                                 :props props
-
-                                ;; NOTE: for batch-key lookup we need the params as-is
-                                ;; because the rpc api does not need to know the
-                                ;; audit/webhook specific object layout.
-                                ::params (dissoc params ::http/request)
-
                                 ::webhooks/batch-key
                                 (or (::webhooks/batch-key mdata)
                                     (::webhooks/batch-key resultm))
@@ -260,34 +196,34 @@
         f))
     f))
 
-(defn- wrap-spec-conform
-  [_ f mdata]
-  (let [spec (or (::sv/spec mdata) (s/spec any?))]
-    (fn [cfg params]
-      (let [params (ex/try! (us/conform spec params))]
-        (if (ex/exception? params)
-          (p/rejected params)
-          (f cfg params))))))
-
-(defn- wrap-all
-  [cfg f mdata]
-  (as-> f $
-    (wrap-dispatch cfg $ mdata)
-    (wrap-metrics cfg $ mdata)
-    (cond/wrap cfg $ mdata)
-    (retry/wrap-retry cfg $ mdata)
-    (climit/wrap cfg $ mdata)
-    (rlimit/wrap cfg $ mdata)
-    (wrap-audit cfg $ mdata)
-    (wrap-spec-conform cfg $ mdata)
-    (wrap-authentication cfg $ mdata)
-    (wrap-access-token cfg $ mdata)))
-
 (defn- wrap
   [cfg f mdata]
-  (l/debug :hint "register method" :name (::sv/name mdata))
-  (let [f (wrap-all cfg f mdata)]
-    (with-meta #(f cfg %) mdata)))
+  (let [f     (as-> f $
+                (wrap-dispatch cfg $ mdata)
+                (cond/wrap cfg $ mdata)
+                (retry/wrap-retry cfg $ mdata)
+                (wrap-metrics cfg $ mdata)
+                (climit/wrap cfg $ mdata)
+                (rlimit/wrap cfg $ mdata)
+                (wrap-audit cfg $ mdata))
+
+        spec  (or (::sv/spec mdata) (s/spec any?))
+        auth? (:auth mdata true)]
+
+    (l/debug :hint "register method" :name (::sv/name mdata))
+    (with-meta
+      (fn [{:keys [::request] :as params}]
+        ;; Raise authentication error when rpc method requires auth but
+        ;; no profile-id is found in the request.
+
+        (p/do!
+         (if (and auth? (not (uuid? (:profile-id params))))
+           (ex/raise :type :authentication
+                     :code :authentication-required
+                     :hint "authentication required for this endpoint")
+           (let [params (us/conform spec (dissoc params ::request))]
+             (f cfg (assoc params ::request request))))))
+      mdata)))
 
 (defn- process-method
   [cfg vfn]
@@ -298,70 +234,76 @@
 (defn- resolve-query-methods
   [cfg]
   (let [cfg (assoc cfg ::type "query" ::metrics-id :rpc-query-timing)]
-    (->> (sv/scan-ns
-          'app.rpc.queries.projects
-          'app.rpc.queries.profile
-          'app.rpc.queries.viewer
-          'app.rpc.queries.fonts)
+    (->> (sv/scan-ns 'app.rpc.queries.projects
+                     'app.rpc.queries.files
+                     'app.rpc.queries.teams
+                     'app.rpc.queries.comments
+                     'app.rpc.queries.profile
+                     'app.rpc.queries.viewer
+                     'app.rpc.queries.fonts)
          (map (partial process-method cfg))
          (into {}))))
 
 (defn- resolve-mutation-methods
   [cfg]
   (let [cfg (assoc cfg ::type "mutation" ::metrics-id :rpc-mutation-timing)]
-    (->> (sv/scan-ns
-          'app.rpc.mutations.media
-          'app.rpc.mutations.profile
-          'app.rpc.mutations.projects
-          'app.rpc.mutations.fonts
-          'app.rpc.mutations.share-link)
+    (->> (sv/scan-ns 'app.rpc.mutations.media
+                     'app.rpc.mutations.profile
+                     'app.rpc.mutations.files
+                     'app.rpc.mutations.comments
+                     'app.rpc.mutations.projects
+                     'app.rpc.mutations.teams
+                     'app.rpc.mutations.management
+                     'app.rpc.mutations.fonts
+                     'app.rpc.mutations.share-link
+                     'app.rpc.mutations.verify-token)
          (map (partial process-method cfg))
          (into {}))))
 
 (defn- resolve-command-methods
   [cfg]
   (let [cfg (assoc cfg ::type "command" ::metrics-id :rpc-command-timing)]
-    (->> (sv/scan-ns
-          'app.rpc.commands.access-token
-          'app.rpc.commands.audit
-          'app.rpc.commands.auth
-          'app.rpc.commands.feedback
-          'app.rpc.commands.fonts
-          'app.rpc.commands.binfile
-          'app.rpc.commands.comments
-          'app.rpc.commands.demo
-          'app.rpc.commands.files
-          'app.rpc.commands.files-create
-          'app.rpc.commands.files-share
-          'app.rpc.commands.files-temp
-          'app.rpc.commands.files-update
-          'app.rpc.commands.ldap
-          'app.rpc.commands.management
-          'app.rpc.commands.media
-          'app.rpc.commands.profile
-          'app.rpc.commands.projects
-          'app.rpc.commands.search
-          'app.rpc.commands.teams
-          'app.rpc.commands.verify-token
-          'app.rpc.commands.viewer
-          'app.rpc.commands.webhooks)
+    (->> (sv/scan-ns 'app.rpc.commands.binfile
+                     'app.rpc.commands.comments
+                     'app.rpc.commands.management
+                     'app.rpc.commands.verify-token
+                     'app.rpc.commands.search
+                     'app.rpc.commands.auth
+                     'app.rpc.commands.ldap
+                     'app.rpc.commands.demo
+                     'app.rpc.commands.webhooks
+                     'app.rpc.commands.audit
+                     'app.rpc.commands.files
+                     'app.rpc.commands.files.update
+                     'app.rpc.commands.files.create
+                     'app.rpc.commands.files.temp)
          (map (partial process-method cfg))
          (into {}))))
 
+(s/def ::ldap (s/nilable map?))
+(s/def ::msgbus ::mbus/msgbus)
+(s/def ::climit (s/nilable ::climit/climit))
+(s/def ::rlimit (s/nilable ::rlimit/rlimit))
+
+(s/def ::public-uri ::us/not-empty-string)
+(s/def ::sprops map?)
+
 (defmethod ig/pre-init-spec ::methods [_]
   (s/keys :req [::audit/collector
-                ::session/manager
                 ::http.client/client
                 ::db/pool
-                ::mbus/msgbus
-                ::ldap/provider
-                ::sto/storage
-                ::mtx/metrics
-                ::main/props
                 ::wrk/executor]
-          :opt [::climit
-                ::rlimit]
-          :req-un [::db/pool]))
+          :req-un [::sto/storage
+                   ::http.session/session
+                   ::sprops
+                   ::public-uri
+                   ::msgbus
+                   ::rlimit
+                   ::climit
+                   ::wrk/executor
+                   ::mtx/metrics
+                   ::db/pool
+                   ::ldap]))
 
 (defmethod ig/init-key ::methods
   [_ cfg]
@@ -383,21 +325,13 @@
                    ::queries
                    ::commands]))
 
-(s/def ::routes vector?)
-
 (defmethod ig/pre-init-spec ::routes [_]
-  (s/keys :req [::methods
-                ::db/pool
-                ::main/props
-                ::wrk/executor
-                ::session/manager
-                ::actoken/manager]))
+  (s/keys :req-un [::methods]))
 
 (defmethod ig/init-key ::routes
-  [_ {:keys [::methods] :as cfg}]
-  [["/rpc" {:middleware [[session/authz cfg]
-                         [actoken/authz cfg]]}
-    ["/command/:type" {:handler (partial rpc-command-handler (:commands methods))}]
+  [_ {:keys [methods] :as cfg}]
+  [["/rpc"
+    ["/command/:command" {:handler (partial rpc-command-handler (:commands methods))}]
     ["/query/:type" {:handler (partial rpc-query-handler (:queries methods))}]
     ["/mutation/:type" {:handler (partial rpc-mutation-handler (:mutations methods))
                         :allowed-methods #{:post}}]]])

backend/src/app/rpc/climit.clj

@@ -46,7 +46,7 @@
                    (p/rejected
                     (ex/error :type :internal
                               :code :concurrency-limit-reached
-                              :queue (-> limiter meta ::bkey name)
+                              :queue (-> limiter meta :bkey name)
                               :cause cause))
 
                    (some? cause)
@@ -56,7 +56,7 @@
                    (p/resolved result))))))
 
 (defn- create-limiter
-  [{:keys [::wrk/executor ::mtx/metrics ::bkey ::skey concurrency queue-size]}]
+  [{:keys [executor metrics concurrency queue-size bkey skey]}]
   (let [labels   (into-array String [(name bkey)])
         on-queue (fn [instance]
                    (l/trace :hint "enqueued"
@@ -100,10 +100,10 @@
                   :on-run on-run}]
 
     (-> (pxb/create options)
-        (vary-meta assoc ::bkey bkey ::skey skey))))
+        (vary-meta assoc :bkey bkey :skey skey))))
 
 (defn- create-cache
-  [{:keys [::wrk/executor] :as params} config]
+  [{:keys [executor] :as params} config]
   (let [listener (reify RemovalListener
                    (onRemoval [_ key _val cause]
                      (l/trace :hint "cache: remove" :key key :reason (str cause))))
@@ -113,8 +113,8 @@
                      (let [[bkey skey] key]
                        (when-let [config (get config bkey)]
                          (-> (merge params config)
-                             (assoc ::bkey bkey)
-                             (assoc ::skey skey)
+                             (assoc :bkey bkey)
+                             (assoc :skey skey)
                              (create-limiter))))))]
 
   (.. (Caffeine/newBuilder)
@@ -134,16 +134,14 @@
 
 (defmethod ig/prep-key ::rpc/climit
   [_ cfg]
-  (merge {::path (cf/get :rpc-climit-config)}
+  (merge {:path (cf/get :rpc-climit-config)}
          (d/without-nils cfg)))
 
-(s/def ::path ::fs/path)
-
 (defmethod ig/pre-init-spec ::rpc/climit [_]
-  (s/keys :req [::wrk/executor ::mtx/metrics ::path]))
+  (s/keys :req-un [::wrk/executor ::mtx/metrics ::fs/path]))
 
 (defmethod ig/init-key ::rpc/climit
-  [_ {:keys [::path] :as params}]
+  [_ {:keys [path] :as params}]
   (when (contains? cf/flags :rpc-climit)
     (if-let [config (some->> path slurp edn/read-string)]
       (do
@@ -165,8 +163,7 @@
       (l/warn :hint "unable to load configuration" :config (str path)))))
 
 
-(s/def ::rpc/climit
-  (s/nilable #(satisfies? IConcurrencyManager %)))
+(s/def ::climit #(satisfies? IConcurrencyManager %))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; PUBLIC API
@@ -179,7 +176,7 @@
      (p/wrap (do ~@body))))
 
 (defn wrap
-  [{:keys [::rpc/climit]} f {:keys [::queue ::key-fn] :as mdata}]
+  [{:keys [climit]} f {:keys [::queue ::key-fn] :as mdata}]
   (if (and (some? climit)
            (some? queue))
     (if-let [config (get @climit queue)]
@@ -195,6 +192,7 @@
             (let [key [queue (key-fn params)]
                   lim (get climit key)]
               (invoke! lim (partial f cfg params))))
+
           (let [lim (get climit queue)]
             (fn [cfg params]
               (invoke! lim (partial f cfg params))))))

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

@@ -1,87 +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.access-token
-  (:require
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.db :as db]
-   [app.main :as-alias main]
-   [app.rpc :as-alias rpc]
-   [app.rpc.doc :as-alias doc]
-   [app.rpc.quotes :as quotes]
-   [app.tokens :as tokens]
-   [app.util.services :as sv]
-   [app.util.time :as dt]
-   [clojure.spec.alpha :as s]))
-
-(defn- decode-row
-  [{:keys [perms] :as row}]
-  (cond-> row
-    (db/pgarray? perms "text")
-    (assoc :perms (db/decode-pgarray perms #{}))))
-
-(defn- create-access-token
-  [{:keys [::conn ::main/props]} profile-id name perms]
-  (let [created-at (dt/now)
-        token-id   (uuid/next)
-        token      (tokens/generate props {:iss "access-token"
-                                           :tid token-id
-                                           :iat created-at})]
-    (db/insert! conn :access-token
-                {:id token-id
-                 :name name
-                 :token token
-                 :profile-id profile-id
-                 :created-at created-at
-                 :updated-at created-at
-                 :perms (db/create-array conn "text" perms)})))
-
-(defn repl-create-access-token
-  [{:keys [::db/pool] :as system} profile-id name perms]
-  (db/with-atomic [conn pool]
-    (let [props (:app.setup/props system)]
-      (create-access-token {::conn conn ::main/props props}
-                           profile-id
-                           name
-                           perms))))
-
-(s/def ::name ::us/not-empty-string)
-(s/def ::perms ::us/set-of-strings)
-
-(s/def ::create-access-token
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::name ::perms]))
-
-(sv/defmethod ::create-access-token
-  {::doc/added "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id name perms]}]
-  (db/with-atomic [conn pool]
-    (let [cfg (assoc cfg ::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 perms)
-          (decode-row)))))
-
-(s/def ::delete-access-token
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::us/id]))
-
-(sv/defmethod ::delete-access-token
-  {::doc/added "1.18"}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id id]}]
-  (db/delete! pool :access-token {:id id :profile-id profile-id})
-  nil)
-
-(s/def ::get-access-tokens
-  (s/keys :req [::rpc/profile-id]))
-
-(sv/defmethod ::get-access-tokens
-  {::doc/added "1.18"}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id]}]
-  (->> (db/query pool :access-token {:profile-id profile-id})
-       (mapv decode-row)))

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

@@ -15,7 +15,6 @@
    [app.db :as db]
    [app.http :as-alias http]
    [app.loggers.audit :as audit]
-   [app.rpc :as-alias rpc]
    [app.rpc.climit :as-alias climit]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
@@ -42,7 +41,7 @@
    :profile-id :ip-addr :props :context])
 
 (defn- handle-events
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id events ::http/request]}]
+  [{:keys [::db/pool]} {:keys [profile-id events ::http/request] :as params}]
   (let [ip-addr (audit/parse-client-ip request)
         xform   (comp
                  (map #(assoc % :profile-id profile-id))
@@ -54,6 +53,7 @@
     (when (seq events)
       (db/insert-multi! pool :audit-log event-columns events))))
 
+(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?))
@@ -67,12 +67,11 @@
 (s/def ::events (s/every ::event))
 
 (s/def ::push-audit-events
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::events]))
+  (s/keys :req-un [::events ::profile-id]))
 
 (sv/defmethod ::push-audit-events
   {::climit/queue :push-audit-events
-   ::climit/key-fn ::rpc/profile-id
+   ::climit/key-fn :profile-id
    ::audit/skip true
    ::doc/added "1.17"}
   [{:keys [::db/pool ::wrk/executor] :as cfg} params]

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

@@ -6,7 +6,6 @@
 
 (ns app.rpc.commands.auth
   (:require
-   [app.auth :as auth]
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
@@ -16,16 +15,15 @@
    [app.emails :as eml]
    [app.http.session :as session]
    [app.loggers.audit :as audit]
-   [app.main :as-alias main]
-   [app.rpc :as-alias rpc]
    [app.rpc.climit :as climit]
-   [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.mutations.teams :as teams]
+   [app.rpc.queries.profile :as profile]
    [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
+   [buddy.hashers :as hashers]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
@@ -33,6 +31,7 @@
 (s/def ::fullname ::us/not-empty-string)
 (s/def ::lang ::us/string)
 (s/def ::path ::us/string)
+(s/def ::profile-id ::us/uuid)
 (s/def ::password ::us/not-empty-string)
 (s/def ::old-password ::us/not-empty-string)
 (s/def ::theme ::us/string)
@@ -41,6 +40,22 @@
 
 ;; ---- HELPERS
 
+(defn derive-password
+  [password]
+  (hashers/derive password
+                  {:alg :argon2id
+                   :memory 16384
+                   :iterations 20
+                   :parallelism 2}))
+
+(defn verify-password
+  [attempt password]
+  (try
+    (hashers/verify attempt password)
+    (catch Exception _e
+      {:update false
+       :valid false})))
+
 (defn email-domain-in-whitelist?
   "Returns true if email's domain is in the given whitelist or if
   given whitelist is an empty string."
@@ -52,13 +67,26 @@
                             (str/split #"@" 2))]
       (contains? domains candidate))))
 
+(def ^:private sql:profile-existence
+  "select exists (select * from profile
+                   where email = ?
+                     and deleted_at is null) as val")
+
+(defn check-profile-existence!
+  [conn {:keys [email] :as params}]
+  (let [email  (str/lower email)
+        result (db/exec-one! conn [sql:profile-existence email])]
+    (when (:val result)
+      (ex/raise :type :validation
+                :code :email-already-exists))
+    params))
+
 ;; ---- COMMAND: login with password
 
 (defn login-with-password
-  [{:keys [::db/pool] :as cfg} {:keys [email password] :as params}]
+  [{:keys [pool session sprops] :as cfg} {:keys [email password] :as params}]
 
-  (when-not (or (contains? cf/flags :login)
-                (contains? cf/flags :login-with-password))
+  (when-not (contains? cf/flags :login)
     (ex/raise :type :restriction
               :code :login-disabled
               :hint "login is disabled in this instance"))
@@ -68,7 +96,7 @@
               (ex/raise :type :validation
                         :code :account-without-password
                         :hint "the current account does not have password"))
-            (:valid (auth/verify-password password (:password profile))))
+            (:valid (verify-password password (:password profile))))
 
           (validate-profile [profile]
             (when-not profile
@@ -91,23 +119,24 @@
             profile)]
 
     (db/with-atomic [conn pool]
-      (let [profile    (->> (profile/get-profile-by-email conn email)
+      (let [profile    (->> (profile/retrieve-profile-data-by-email conn email)
                             (validate-profile)
-                            (profile/decode-row)
-                            (profile/strip-private-attrs))
+                            (profile/strip-private-attrs)
+                            (profile/populate-additional-data conn)
+                            (profile/decode-profile-row))
 
             invitation (when-let [token (:invitation-token params)]
-                         (tokens/verify (::main/props cfg) {:token token :iss :team-invitation}))
+                         (tokens/verify sprops {:token token :iss :team-invitation}))
 
             ;; If invitation member-id does not matches the profile-id, we just proceed to ignore the
             ;; invitation because invitations matches exactly; and user can't login with other email and
             ;; accept invitation with other email
             response   (if (and (some? invitation) (= (:id profile) (:member-id invitation)))
                          {:invitation-token (:invitation-token params)}
-                         (assoc profile :is-admin (let [admins (cf/get :admins)]
-                                                    (contains? admins (:email profile)))))]
+                         profile)]
+
         (-> response
-            (rph/with-transform (session/create-fn cfg (:id profile)))
+            (rph/with-transform (session/create-fn session (:id profile)))
             (rph/with-meta {::audit/props (audit/profile->props profile)
                             ::audit/profile-id (:id profile)}))))))
 
@@ -117,7 +146,7 @@
 
 (sv/defmethod ::login-with-password
   "Performs authentication using penpot password."
-  {::rpc/auth false
+  {:auth false
    ::climit/queue :auth
    ::doc/added "1.15"}
   [cfg params]
@@ -126,25 +155,25 @@
 ;; ---- COMMAND: Logout
 
 (s/def ::logout
-  (s/keys :opt [::rpc/profile-id]))
+  (s/keys :opt-un [::profile-id]))
 
 (sv/defmethod ::logout
   "Clears the authentication cookie and logout the current session."
-  {::rpc/auth false
+  {:auth false
    ::doc/added "1.15"}
-  [cfg _]
-  (rph/with-transform {} (session/delete-fn cfg)))
+  [{:keys [session] :as cfg} _]
+  (rph/with-transform {} (session/delete-fn session)))
 
 ;; ---- COMMAND: Recover Profile
 
 (defn recover-profile
-  [{:keys [::db/pool] :as cfg} {:keys [token password]}]
+  [{:keys [pool sprops] :as cfg} {:keys [token password]}]
   (letfn [(validate-token [token]
-            (let [tdata (tokens/verify (::main/props cfg) {:token token :iss :password-recovery})]
+            (let [tdata (tokens/verify sprops {:token token :iss :password-recovery})]
               (:profile-id tdata)))
 
           (update-password [conn profile-id]
-            (let [pwd (auth/derive-password password)]
+            (let [pwd (derive-password password)]
               (db/update! conn :profile {:password pwd} {:id profile-id})))]
 
     (db/with-atomic [conn pool]
@@ -157,7 +186,7 @@
   (s/keys :req-un [::token ::password]))
 
 (sv/defmethod ::recover-profile
-  {::rpc/auth false
+  {:auth false
    ::climit/queue :auth
    ::doc/added "1.15"}
   [cfg params]
@@ -166,13 +195,13 @@
 ;; ---- COMMAND: Prepare Register
 
 (defn validate-register-attempt!
-  [{:keys [::db/pool] :as cfg} params]
+  [{:keys [pool sprops]} params]
 
   (when-not (contains? cf/flags :registration)
     (if-not (contains? params :invitation-token)
       (ex/raise :type :restriction
                 :code :registration-disabled)
-      (let [invitation (tokens/verify (::main/props cfg) {:token (:invitation-token params) :iss :team-invitation})]
+      (let [invitation (tokens/verify sprops {:token (:invitation-token params) :iss :team-invitation})]
         (when-not (= (:email params) (:member-email invitation))
           (ex/raise :type :restriction
                     :code :email-does-not-match-invitation
@@ -206,11 +235,11 @@
     (pos? (compare elapsed register-retry-threshold))))
 
 (defn prepare-register
-  [{:keys [::db/pool] :as cfg} params]
+  [{:keys [pool sprops] :as cfg} params]
 
   (validate-register-attempt! cfg params)
 
-  (let [profile (when-let [profile (profile/get-profile-by-email pool (:email params))]
+  (let [profile (when-let [profile (profile/retrieve-profile-data-by-email pool (:email params))]
                   (cond
                     (:is-blocked profile)
                     (ex/raise :type :restriction
@@ -235,7 +264,7 @@
 
         params (d/without-nils params)
 
-        token  (tokens/generate (::main/props cfg) params)]
+        token  (tokens/generate sprops params)]
     (with-meta {:token token}
       {::audit/profile-id uuid/zero})))
 
@@ -244,18 +273,17 @@
           :opt-un [::invitation-token]))
 
 (sv/defmethod ::prepare-register-profile
-  {::rpc/auth false
+  {:auth false
    ::doc/added "1.15"}
   [cfg params]
   (prepare-register cfg params))
 
 ;; ---- COMMAND: Register Profile
 
-(defn create-profile!
+(defn create-profile
   "Create the profile entry on the database with limited set of input
   attrs (all the other attrs are filled with default values)."
-  [conn {:keys [email] :as params}]
-  (us/assert! ::us/email email)
+  [conn params]
   (let [id        (or (:id params) (uuid/next))
         props     (-> (audit/extract-utm-params params)
                       (merge (:props params))
@@ -265,7 +293,7 @@
                       (db/tjson))
 
         password  (if-let [password (:password params)]
-                    (auth/derive-password password)
+                    (derive-password password)
                     "!")
 
         locale    (:locale params)
@@ -276,7 +304,7 @@
         is-demo   (:is-demo params false)
         is-muted  (:is-muted params false)
         is-active (:is-active params false)
-        email     (str/lower email)
+        email     (str/lower (:email params))
 
         params    {:id id
                    :fullname (:fullname params)
@@ -291,38 +319,35 @@
                    :is-demo is-demo}]
     (try
       (-> (db/insert! conn :profile params)
-          (profile/decode-row))
+          (profile/decode-profile-row))
       (catch org.postgresql.util.PSQLException e
         (let [state (.getSQLState e)]
           (if (not= state "23505")
             (throw e)
             (ex/raise :type :validation
                       :code :email-already-exists
-                      :hint "email already exists"
                       :cause e)))))))
 
-(defn create-profile-rels!
-  [conn {:keys [id] :as profile}]
-  (let [team (teams/create-team conn {:profile-id id
+(defn create-profile-relations
+  [conn profile]
+  (let [team (teams/create-team conn {:profile-id (:id profile)
                                       :name "Default"
                                       :is-default true})]
-    (-> (db/update! conn :profile
-                    {:default-team-id (:id team)
-                     :default-project-id  (:default-project-id team)}
-                    {:id id})
-        (profile/decode-row))))
-
+    (-> profile
+        (profile/strip-private-attrs)
+        (assoc :default-team-id (:id team))
+        (assoc :default-project-id (:default-project-id team)))))
 
 (defn send-email-verification!
-  [conn props profile]
-  (let [vtoken (tokens/generate props
+  [conn sprops profile]
+  (let [vtoken (tokens/generate sprops
                                 {:iss :verify-email
                                  :exp (dt/in-future "72h")
                                  :profile-id (:id profile)
                                  :email (:email profile)})
         ;; NOTE: this token is mainly used for possible complains
         ;; identification on the sns webhook
-        ptoken (tokens/generate props
+        ptoken (tokens/generate sprops
                                 {:iss :profile-identity
                                  :profile-id (:id profile)
                                  :exp (dt/in-future {:days 30})})]
@@ -335,20 +360,24 @@
                 :extra-data ptoken})))
 
 (defn register-profile
-  [{:keys [conn] :as cfg} {:keys [token] :as params}]
-  (let [claims     (tokens/verify (::main/props cfg) {:token token :iss :prepared-register})
+  [{:keys [conn sprops session] :as cfg} {:keys [token] :as params}]
+  (let [claims     (tokens/verify sprops {:token token :iss :prepared-register})
         params     (merge params claims)
 
         is-active  (or (:is-active params)
-                       (not (contains? cf/flags :email-verification)))
+                       (not (contains? cf/flags :email-verification))
+
+                       ;; DEPRECATED: v1.15
+                       (contains? cf/flags :insecure-register))
 
         profile    (if-let [profile-id (:profile-id claims)]
-                     (profile/get-profile conn profile-id)
-                     (->> (create-profile! conn (assoc params :is-active is-active))
-                          (create-profile-rels! conn)))
-
+                     (profile/retrieve-profile conn profile-id)
+                     (->> (assoc params :is-active is-active)
+                          (create-profile conn)
+                          (create-profile-relations conn)
+                          (profile/decode-profile-row)))
         invitation (when-let [token (:invitation-token params)]
-                     (tokens/verify (::main/props cfg) {:token token :iss :team-invitation}))]
+                     (tokens/verify sprops {:token token :iss :team-invitation}))]
 
     ;; If profile is filled in claims, means it tries to register
     ;; again, so we proceed to update the modified-at attr
@@ -370,10 +399,10 @@
       ;; email.
       (and (some? invitation) (= (:email profile) (:member-email invitation)))
       (let [claims (assoc invitation :member-id  (:id profile))
-            token  (tokens/generate (::main/props cfg) claims)
+            token  (tokens/generate sprops claims)
             resp   {:invitation-token token}]
         (-> resp
-            (rph/with-transform (session/create-fn cfg (:id profile)))
+            (rph/with-transform (session/create-fn session (:id profile)))
             (rph/with-meta {::audit/replace-props (audit/profile->props profile)
                             ::audit/profile-id (:id profile)})))
 
@@ -382,7 +411,7 @@
       ;; we need to mark this session as logged.
       (not= "penpot" (:auth-backend profile))
       (-> (profile/strip-private-attrs profile)
-          (rph/with-transform (session/create-fn cfg (:id profile)))
+          (rph/with-transform (session/create-fn session (:id profile)))
           (rph/with-meta {::audit/replace-props (audit/profile->props profile)
                           ::audit/profile-id (:id profile)}))
 
@@ -390,14 +419,14 @@
       ;; to sign in the user directly, without email verification.
       (true? is-active)
       (-> (profile/strip-private-attrs profile)
-          (rph/with-transform (session/create-fn cfg (:id profile)))
+          (rph/with-transform (session/create-fn session (:id profile)))
           (rph/with-meta {::audit/replace-props (audit/profile->props profile)
                           ::audit/profile-id (:id profile)}))
 
       ;; In all other cases, send a verification email.
       :else
       (do
-        (send-email-verification! conn (::main/props cfg) profile)
+        (send-email-verification! conn sprops profile)
         (rph/with-meta profile
           {::audit/replace-props (audit/profile->props profile)
            ::audit/profile-id (:id profile)})))))
@@ -406,10 +435,10 @@
   (s/keys :req-un [::token ::fullname]))
 
 (sv/defmethod ::register-profile
-  {::rpc/auth false
+  {:auth false
    ::climit/queue :auth
    ::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} params]
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
     (-> (assoc cfg :conn conn)
         (register-profile params))))
@@ -417,22 +446,22 @@
 ;; ---- COMMAND: Request Profile Recovery
 
 (defn request-profile-recovery
-  [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
+  [{:keys [pool sprops] :as cfg} {:keys [email] :as params}]
   (letfn [(create-recovery-token [{:keys [id] :as profile}]
-            (let [token (tokens/generate (::main/props cfg)
+            (let [token (tokens/generate sprops
                                          {:iss :password-recovery
                                           :exp (dt/in-future "15m")
                                           :profile-id id})]
               (assoc profile :token token)))
 
           (send-email-notification [conn profile]
-            (let [ptoken (tokens/generate (::main/props cfg)
+            (let [ptoken (tokens/generate sprops
                                           {:iss :profile-identity
                                            :profile-id (:id profile)
                                            :exp (dt/in-future {:days 30})})]
               (eml/send! {::eml/conn conn
                           ::eml/factory eml/password-recovery
-                          :public-uri (cf/get :public-uri)
+                          :public-uri (:public-uri cfg)
                           :to (:email profile)
                           :token (:token profile)
                           :name (:fullname profile)
@@ -440,7 +469,7 @@
               nil))]
 
     (db/with-atomic [conn pool]
-      (when-let [profile (profile/get-profile-by-email conn email)]
+      (when-let [profile (profile/retrieve-profile-data-by-email conn email)]
         (when-not (eml/allow-send-emails? conn profile)
           (ex/raise :type :validation
                     :code :profile-is-muted
@@ -464,7 +493,7 @@
   (s/keys :req-un [::email]))
 
 (sv/defmethod ::request-profile-recovery
-  {::rpc/auth false
+  {:auth false
    ::doc/added "1.15"}
   [cfg params]
   (request-profile-recovery cfg params))

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

@@ -9,27 +9,21 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
-   [app.common.files.features :as ffeat]
    [app.common.logging :as l]
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
-   [app.loggers.audit :as-alias audit]
-   [app.loggers.webhooks :as-alias webhooks]
    [app.media :as media]
-   [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
-   [app.rpc.commands.projects :as projects]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
+   [app.rpc.queries.projects :as projects]
    [app.storage :as sto]
    [app.storage.tmp :as tmp]
    [app.tasks.file-gc]
    [app.util.blob :as blob]
    [app.util.fressian :as fres]
-   [app.util.objects-map :as omap]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -296,7 +290,7 @@
 
 (defn- retrieve-file
   [pool file-id]
-  (with-open [^AutoCloseable conn (db/open pool)]
+  (with-open [conn (db/open pool)]
     (binding [pmap/*load-fn* (partial files/load-pointer conn file-id)]
       (some-> (db/get* conn :file {:id file-id})
               (files/decode-row)
@@ -438,8 +432,9 @@
 (s/def ::embed-assets? (s/nilable ::us/boolean))
 
 (s/def ::write-export-options
-  (s/keys :req [::db/pool ::sto/storage ::output ::file-ids]
-          :opt [::include-libraries? ::embed-assets?]))
+  (s/keys :req-un [::db/pool ::sto/storage]
+          :req    [::output ::file-ids]
+          :opt    [::include-libraries? ::embed-assets?]))
 
 (defn write-export!
   "Do the exportation of a specified file in custom penpot binary
@@ -476,7 +471,7 @@
               [:v1/metadata :v1/files :v1/rels :v1/sobjects])))))
 
 (defmethod write-section :v1/metadata
-  [{:keys [::db/pool ::output ::file-ids ::include-libraries?]}]
+  [{:keys [pool ::output ::file-ids ::include-libraries?]}]
   (let [libs  (when include-libraries?
                 (retrieve-libraries pool file-ids))
         files (into file-ids libs)]
@@ -484,7 +479,7 @@
     (vswap! *state* assoc :files files)))
 
 (defmethod write-section :v1/files
-  [{:keys [::db/pool ::output ::embed-assets?]}]
+  [{:keys [pool ::output ::embed-assets?]}]
 
   ;; Initialize SIDS with empty vector
   (vswap! *state* assoc :sids [])
@@ -508,7 +503,7 @@
       (vswap! *state* update :sids into storage-object-id-xf media))))
 
 (defmethod write-section :v1/rels
-  [{:keys [::db/pool ::output ::include-libraries?]}]
+  [{:keys [pool  ::output ::include-libraries?]}]
   (let [rels  (when include-libraries?
                 (retrieve-library-relations pool (-> *state* deref :files)))]
     (l/debug :hint "found rels" :total (count rels) ::l/async false)
@@ -556,8 +551,9 @@
 (s/def ::ignore-index-errors? (s/nilable ::us/boolean))
 
 (s/def ::read-import-options
-  (s/keys :req [::db/pool ::sto/storage ::project-id ::input]
-          :opt [::overwrite? ::migrate? ::ignore-index-errors?]))
+  (s/keys :req-un [::db/pool ::sto/storage]
+          :req    [::project-id ::input]
+          :opt    [::overwrite? ::migrate? ::ignore-index-errors?]))
 
 (defn read-import!
   "Do the importation of the specified resource in penpot custom binary
@@ -580,7 +576,7 @@
     (read-import (assoc options ::version version ::timestamp timestamp))))
 
 (defmethod read-import :v1
-  [{:keys [::db/pool ::input] :as options}]
+  [{:keys [pool ::input] :as options}]
   (with-open [input (zstd-input-stream input)]
     (with-open [input (io/data-input-stream input)]
       (db/with-atomic [conn pool]
@@ -609,23 +605,12 @@
     (vswap! *state* update :index update-index files)
     (vswap! *state* assoc :version version :files files)))
 
-(defn- postprocess-file
-  [data]
-  (let [omap-wrap ffeat/*wrap-with-objects-map-fn*
-        pmap-wrap ffeat/*wrap-with-pointer-map-fn*]
-    (-> data
-        (update :pages-index update-vals #(update % :objects omap-wrap))
-        (update :pages-index update-vals pmap-wrap)
-        (update :components update-vals #(update % :objects omap-wrap))
-        (update :components pmap-wrap))))
-
 (defmethod read-section :v1/files
   [{:keys [conn ::input ::migrate? ::project-id ::timestamp ::overwrite?]}]
   (doseq [expected-file-id (-> *state* deref :files)]
-    (let [file     (read-obj! input)
-          media'   (read-obj! input)
-          file-id  (:id file)
-          features files/default-features]
+    (let [file    (read-obj! input)
+          media'  (read-obj! input)
+          file-id (:id file)]
 
       (when (not= file-id expected-file-id)
         (ex/raise :type :validation
@@ -640,42 +625,33 @@
       (l/debug :hint "update media references" ::l/async false)
       (vswap! *state* update :media into (map #(update % :id lookup-index)) media')
 
-      (l/debug :hint "processing file" :file-id file-id ::features features ::l/async false)
+      (l/debug :hint "processing file" :file-id file-id ::l/async false)
 
-      (binding [ffeat/*current* features
-                ffeat/*wrap-with-objects-map-fn* (if (features "storage/objects-map") omap/wrap identity)
-                ffeat/*wrap-with-pointer-map-fn* (if (features "storage/pointer-map") pmap/wrap identity)
-                pmap/*tracked* (atom {})]
+      (let [file-id' (lookup-index file-id)
+            data     (-> (:data file)
+                         (assoc :id file-id')
+                         (cond-> migrate? (pmg/migrate-data))
+                         (update :pages-index relink-shapes)
+                         (update :components relink-shapes)
+                         (update :media relink-media))
 
-        (let [file-id' (lookup-index file-id)
-              data     (-> (:data file)
-                           (assoc :id file-id')
-                           (cond-> migrate? (pmg/migrate-data))
-                           (update :pages-index relink-shapes)
-                           (update :components relink-shapes)
-                           (update :media relink-media)
-                           (postprocess-file))
+            params  {:id file-id'
+                     :project-id project-id
+                     :name (:name file)
+                     :revn (:revn file)
+                     :is-shared (:is-shared file)
+                     :data (blob/encode data)
+                     :created-at timestamp
+                     :modified-at timestamp}]
 
-              params  {:id file-id'
-                       :project-id project-id
-                       :features (db/create-array conn "text" features)
-                       :name (:name file)
-                       :revn (:revn file)
-                       :is-shared (:is-shared file)
-                       :data (blob/encode data)
-                       :created-at timestamp
-                       :modified-at timestamp}]
+        (l/debug :hint "create file" :id file-id' ::l/async false)
 
-          (l/debug :hint "create file" :id file-id' ::l/async false)
+        (if overwrite?
+          (create-or-update-file conn params)
+          (db/insert! conn :file params))
 
-          (if overwrite?
-            (create-or-update-file conn params)
-            (db/insert! conn :file params))
-
-          (files/persist-pointers! conn file-id')
-
-          (when overwrite?
-            (db/delete! conn :file-thumbnail {:file-id file-id'})))))))
+        (when overwrite?
+          (db/delete! conn :file-thumbnail {:file-id file-id'}))))))
 
 (defmethod read-section :v1/rels
   [{:keys [conn ::input ::timestamp]}]
@@ -693,7 +669,7 @@
         (db/insert! conn :file-library-rel rel)))))
 
 (defmethod read-section :v1/sobjects
-  [{:keys [::sto/storage conn ::input ::overwrite?]}]
+  [{:keys [storage conn ::input ::overwrite?]}]
   (let [storage (media/configure-assets-storage storage)
         ids     (read-obj! input)]
 
@@ -864,10 +840,10 @@
 (defn import!
   [{:keys [::input] :as cfg}]
   (let [id (uuid/next)
-        tp (dt/tpoint)
+        ts (dt/now)
         cs (volatile! nil)]
-    (l/info :hint "import: started" :import-id id)
     (try
+      (l/info :hint "start importation" :import-id id)
       (binding [*position* (atom 0)]
         (with-open [^AutoCloseable input (io/input-stream input)]
           (read-import! (assoc cfg ::input input))))
@@ -877,28 +853,25 @@
         (throw cause))
 
       (finally
-        (l/info :hint "import: terminated"
-                :import-id id
-                :elapsed (dt/format-duration (tp))
+        (l/info :hint "importation finished" :import-id id
+                :elapsed (str (inst-ms (dt/diff ts (dt/now))) "ms")
                 :error? (some? @cs)
-                :cause @cs
-                )))))
+                :cause @cs)))))
 
 ;; --- Command: export-binfile
 
 (s/def ::file-id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
 (s/def ::include-libraries? ::us/boolean)
 (s/def ::embed-assets? ::us/boolean)
 
 (s/def ::export-binfile
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::include-libraries? ::embed-assets?]))
+  (s/keys :req-un [::profile-id ::file-id ::include-libraries? ::embed-assets?]))
 
 (sv/defmethod ::export-binfile
   "Export a penpot file in a binary format."
-  {::doc/added "1.15"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id include-libraries? embed-assets?] :as params}]
+  {::doc/added "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id include-libraries? embed-assets?] :as params}]
   (files/check-read-permissions! pool profile-id file-id)
   (let [body (reify yrs/StreamableResponseBody
                (-write-body-to-stream [_ _ output-stream]
@@ -913,19 +886,15 @@
 
 (s/def ::file ::media/upload)
 (s/def ::import-binfile
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::project-id ::file]))
+  (s/keys :req-un [::profile-id ::project-id ::file]))
 
 (sv/defmethod ::import-binfile
   "Import a penpot file in a binary format."
-  {::doc/added "1.15"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id file] :as params}]
+  {::doc/added "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id file] :as params}]
   (db/with-atomic [conn pool]
     (projects/check-read-permissions! conn profile-id project-id)
-    (let [ids (import! (assoc cfg
-                              ::input (:path file)
-                              ::project-id project-id
-                              ::ignore-index-errors? true))]
-      (rph/with-meta ids
-        {::audit/props {:file nil :file-ids ids}}))))
+    (import! (assoc cfg
+                    ::input (:path file)
+                    ::project-id project-id
+                    ::ignore-index-errors? true))))

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

@@ -6,26 +6,23 @@
 
 (ns app.rpc.commands.comments
   (:require
-   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.geom.point :as gpt]
    [app.common.spec :as us]
-   [app.common.uuid :as uuid]
    [app.db :as db]
-   [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
-   [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
-   [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.quotes :as quotes]
-   [app.util.pointer-map :as pmap]
-   [app.util.retry :as rtry]
+   [app.rpc.queries.teams :as teams]
+   [app.rpc.retry :as retry]
+   [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]))
 
-;; --- GENERAL PURPOSE INTERNAL HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; QUERY COMMANDS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn decode-row
   [{:keys [participants position] :as row}]
@@ -33,77 +30,24 @@
     (db/pgpoint? position) (assoc :position (db/decode-pgpoint position))
     (db/pgobject? participants) (assoc :participants (db/decode-transit-pgobject participants))))
 
-(def sql:get-file
-  "select f.id, f.modified_at, f.revn, f.features,
-          f.project_id, p.team_id, f.data
-     from file as f
-     join project as p on (p.id = f.project_id)
-    where f.id = ?
-      and f.deleted_at is null")
-
-(defn- get-file
-  "A specialized version of get-file for comments module."
-  [conn file-id page-id]
-  (binding [pmap/*load-fn* (partial files/load-pointer conn file-id)]
-    (if-let [{:keys [data] :as file} (some-> (db/exec-one! conn [sql:get-file file-id]) (files/decode-row))]
-      (-> file
-          (assoc :page-name (dm/get-in data [:pages-index page-id :name]))
-          (assoc :page-id page-id))
-      (ex/raise :type :not-found
-                :code :object-not-found
-                :hint "file not found"))))
-
-(defn- get-comment-thread
-  [conn thread-id & {:as opts}]
-  (-> (db/get-by-id conn :comment-thread thread-id opts)
-      (decode-row)))
-
-(defn- get-comment
-  [conn comment-id & {:keys [for-update?]}]
-  (db/get-by-id conn :comment comment-id {:for-update for-update?}))
-
-(defn- get-next-seqn
-  [conn 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
-  "insert into comment_thread_status (thread_id, profile_id, modified_at)
-   values (?, ?, ?)
-       on conflict (thread_id, profile_id)
-       do update set modified_at = ?
-   returning modified_at;")
-
-(defn upsert-comment-thread-status!
-  ([conn profile-id thread-id]
-   (upsert-comment-thread-status! conn profile-id thread-id (dt/now)))
-  ([conn profile-id thread-id mod-at]
-   (db/exec-one! conn [sql:upsert-comment-thread-status thread-id profile-id mod-at mod-at])))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUERY COMMANDS
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 ;; --- COMMAND: Get Comment Threads
 
-(declare ^:private get-comment-threads)
+(declare retrieve-comment-threads)
 
 (s/def ::team-id ::us/uuid)
 (s/def ::file-id ::us/uuid)
 (s/def ::share-id (s/nilable ::us/uuid))
 
 (s/def ::get-comment-threads
-  (s/and (s/keys :req [::rpc/profile-id]
+  (s/and (s/keys :req-un [::profile-id]
                  :opt-un [::file-id ::share-id ::team-id])
          #(or (:file-id %) (:team-id %))))
 
 (sv/defmethod ::get-comment-threads
   {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id share-id] :as params}]
+  [{:keys [pool] :as cfg} params]
   (with-open [conn (db/open pool)]
-    (files/check-comment-permissions! conn profile-id file-id share-id)
-    (get-comment-threads conn profile-id file-id)))
+    (retrieve-comment-threads conn params)))
 
 (def sql:comment-threads
   "select distinct on (ct.id)
@@ -127,26 +71,25 @@
     where ct.file_id = ?
    window w as (partition by c.thread_id order by c.created_at asc)")
 
-(defn- get-comment-threads
-  [conn profile-id file-id]
+(defn retrieve-comment-threads
+  [conn {:keys [profile-id file-id share-id]}]
+  (files/check-comment-permissions! conn profile-id file-id share-id)
   (->> (db/exec! conn [sql:comment-threads profile-id file-id])
        (into [] (map decode-row))))
 
 ;; --- COMMAND: Get Unread Comment Threads
 
-(declare ^:private get-unread-comment-threads)
+(declare retrieve-unread-comment-threads)
 
 (s/def ::team-id ::us/uuid)
 (s/def ::get-unread-comment-threads
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]))
+  (s/keys :req-un [::profile-id ::team-id]))
 
 (sv/defmethod ::get-unread-comment-threads
-  {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
   (with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
-    (get-unread-comment-threads conn profile-id team-id)))
+    (retrieve-unread-comment-threads conn params)))
 
 (def sql:comment-threads-by-team
   "select distinct on (ct.id)
@@ -175,22 +118,22 @@
   (str "with threads as (" sql:comment-threads-by-team ")"
        "select * from threads where count_unread_comments > 0"))
 
-(defn- get-unread-comment-threads
-  [conn profile-id team-id]
+(defn retrieve-unread-comment-threads
+  [conn {:keys [profile-id team-id]}]
   (->> (db/exec! conn [sql:unread-comment-threads-by-team profile-id team-id])
        (into [] (map decode-row))))
 
 
 ;; --- COMMAND: Get Single Comment Thread
 
+(s/def ::id ::us/uuid)
+(s/def ::share-id (s/nilable ::us/uuid))
 (s/def ::get-comment-thread
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::us/id]
+  (s/keys :req-un [::profile-id ::file-id ::id]
           :opt-un [::share-id]))
 
 (sv/defmethod ::get-comment-thread
-  {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id id share-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id id share-id] :as params}]
   (with-open [conn (db/open pool)]
     (files/check-comment-permissions! conn profile-id file-id share-id)
     (let [sql (str "with threads as (" sql:comment-threads ")"
@@ -198,30 +141,37 @@
       (-> (db/exec-one! conn [sql profile-id file-id id])
           (decode-row)))))
 
+(defn get-comment-thread
+  [conn {:keys [profile-id file-id id] :as params}]
+  (let [sql (str "with threads as (" sql:comment-threads ")"
+                 "select * from threads where id = ?")]
+    (-> (db/exec-one! conn [sql profile-id file-id id])
+        (decode-row))))
+
 ;; --- COMMAND: Retrieve Comments
 
-(declare ^:private get-comments)
+(declare get-comments)
 
+(s/def ::file-id ::us/uuid)
+(s/def ::share-id (s/nilable ::us/uuid))
 (s/def ::thread-id ::us/uuid)
 (s/def ::get-comments
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::thread-id]
+  (s/keys :req-un [::profile-id ::thread-id]
           :opt-un [::share-id]))
 
 (sv/defmethod ::get-comments
-  {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id thread-id share-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id thread-id share-id] :as params}]
   (with-open [conn (db/open pool)]
-    (let [{:keys [file-id] :as thread} (get-comment-thread conn thread-id)]
-      (files/check-comment-permissions! conn profile-id file-id share-id)
-      (get-comments conn thread-id))))
+    (let [thread (db/get-by-id conn :comment-thread thread-id)]
+      (files/check-comment-permissions! conn profile-id (:file-id thread) share-id))
+    (get-comments conn thread-id)))
 
 (def sql:comments
   "select c.* from comment as c
     where c.thread_id = ?
     order by c.created_at asc")
 
-(defn- get-comments
+(defn get-comments
   [conn thread-id]
   (->> (db/query conn :comment
                  {:thread-id thread-id}
@@ -230,6 +180,25 @@
 
 ;; --- COMMAND: Get file comments users
 
+(declare get-file-comments-users)
+
+(s/def ::file-id ::us/uuid)
+(s/def ::share-id (s/nilable ::us/uuid))
+
+(s/def ::get-profiles-for-file-comments
+  (s/keys :req-un [::profile-id ::file-id]
+          :opt-un [::share-id]))
+
+(sv/defmethod ::get-profiles-for-file-comments
+  "Retrieves a list of profiles with limited set of properties of all
+  participants on comment threads of the file."
+  {::doc/added "1.15"
+   ::doc/changes ["1.15" "Imported from queries and renamed."]}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id]}]
+  (with-open [conn (db/open pool)]
+    (files/check-comment-permissions! conn profile-id file-id share-id)
+    (get-file-comments-users conn file-id profile-id)))
+
 ;; All the profiles that had comment the file, plus the current
 ;; profile.
 
@@ -252,113 +221,87 @@
   [conn file-id profile-id]
   (db/exec! conn [sql:file-comment-users file-id profile-id]))
 
-(s/def ::get-profiles-for-file-comments
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id]
-          :opt-un [::share-id]))
-
-(sv/defmethod ::get-profiles-for-file-comments
-  "Retrieves a list of profiles with limited set of properties of all
-  participants on comment threads of the file."
-  {::doc/added "1.15"
-   ::doc/changes ["1.15" "Imported from queries and renamed."]}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id share-id]}]
-  (with-open [conn (db/open pool)]
-    (files/check-comment-permissions! conn profile-id file-id share-id)
-    (get-file-comments-users conn file-id profile-id)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; MUTATION COMMANDS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(declare ^:private create-comment-thread)
-
 ;; --- COMMAND: Create Comment Thread
 
+(declare upsert-comment-thread-status!)
+(declare create-comment-thread)
+(declare retrieve-page-name)
+
 (s/def ::page-id ::us/uuid)
+(s/def ::file-id ::us/uuid)
+(s/def ::share-id (s/nilable ::us/uuid))
+(s/def ::profile-id ::us/uuid)
 (s/def ::position ::gpt/point)
 (s/def ::content ::us/string)
 (s/def ::frame-id ::us/uuid)
 
 (s/def ::create-comment-thread
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::position ::content ::page-id ::frame-id]
+  (s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id ::frame-id]
           :opt-un [::share-id]))
 
 (sv/defmethod ::create-comment-thread
-  {::doc/added "1.15"
+  {::retry/max-retries 3
+   ::retry/matches retry/conflict-db-insert?
+   ::doc/added "1.15"
    ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg}
-   {:keys [::rpc/profile-id ::rpc/request-at file-id page-id share-id position content frame-id]}]
-
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)]
-      (files/check-comment-permissions! conn profile-id file-id share-id)
+    (files/check-comment-permissions! conn profile-id file-id share-id)
+    (create-comment-thread conn params)))
 
-      (run! (partial quotes/check-quote! conn)
-            (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}))
+(defn- retrieve-next-seqn
+  [conn 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)))
 
-      (rtry/with-retry {::rtry/when rtry/conflict-exception?
-                        ::rtry/max-retries 3
-                        ::rtry/label "create-comment-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
+  [conn {:keys [profile-id file-id page-id position content frame-id] :as params}]
+  (let [seqn    (retrieve-next-seqn conn file-id)
+        now     (dt/now)
+        pname   (retrieve-page-name conn params)
+        thread  (db/insert! conn :comment-thread
+                           {:file-id file-id
+                            :owner-id profile-id
+                            :participants (db/tjson #{profile-id})
+                            :page-name pname
+                            :page-id page-id
+                            :created-at now
+                            :modified-at now
+                            :seqn seqn
+                            :position (db/pgpoint position)
+                            :frame-id frame-id})]
 
 
-(defn- create-comment-thread
-  [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
-                              {:id thread-id
-                               :file-id file-id
-                               :owner-id profile-id
-                               :participants (db/tjson #{profile-id})
-                               :page-name page-name
-                               :page-id page-id
-                               :created-at created-at
-                               :modified-at created-at
-                               :seqn seqn
-                               :position (db/pgpoint position)
-                               :frame-id frame-id})
-        comment   (db/insert! conn :comment
-                              {:id (uuid/next)
-                               :thread-id thread-id
-                               :owner-id profile-id
-                               :created-at created-at
-                               :modified-at created-at
-                               :content content})]
+    ;; Create a comment entry
+    (db/insert! conn :comment
+                {:thread-id (:id thread)
+                 :owner-id profile-id
+                 :created-at now
+                 :modified-at now
+                 :content content})
 
     ;; Make the current thread as read.
-    (upsert-comment-thread-status! conn profile-id thread-id created-at)
+    (upsert-comment-thread-status! conn profile-id (:id thread))
 
     ;; Optimistic update of current seq number on file.
     (db/update! conn :file
                 {:comment-thread-seqn seqn}
                 {:id file-id})
 
-    (-> thread
-        (select-keys [:id :file-id :page-id])
-        (assoc :comment-id (:id comment)))))
+    (select-keys thread [:id :file-id :page-id])))
+
+(defn- retrieve-page-name
+  [conn {:keys [file-id page-id]}]
+  (let [{:keys [data]} (db/get-by-id conn :file file-id)
+        data           (blob/decode data)]
+    (get-in data [:pages-index page-id :name])))
+
 
 ;; --- COMMAND: Update Comment Thread Status
 
@@ -366,33 +309,49 @@
 (s/def ::share-id (s/nilable ::us/uuid))
 
 (s/def ::update-comment-thread-status
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]
+  (s/keys :req-un [::profile-id ::id]
           :opt-un [::share-id]))
 
 (sv/defmethod ::update-comment-thread-status
   {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id id share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
-      (files/check-comment-permissions! conn profile-id file-id share-id)
-      (upsert-comment-thread-status! conn profile-id id))))
+    (let [cthr (db/get-by-id conn :comment-thread id {:for-update true})]
+      (when-not cthr
+        (ex/raise :type :not-found))
+
+      (files/check-comment-permissions! conn profile-id (:file-id cthr) share-id)
+      (upsert-comment-thread-status! conn profile-id (:id cthr)))))
+
+(def sql:upsert-comment-thread-status
+  "insert into comment_thread_status (thread_id, profile_id)
+   values (?, ?)
+       on conflict (thread_id, profile_id)
+       do update set modified_at = clock_timestamp()
+   returning modified_at;")
+
+(defn upsert-comment-thread-status!
+  [conn profile-id thread-id]
+  (db/exec-one! conn [sql:upsert-comment-thread-status thread-id profile-id]))
 
 
 ;; --- COMMAND: Update Comment Thread
 
 (s/def ::is-resolved ::us/boolean)
 (s/def ::update-comment-thread
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id ::is-resolved]
+  (s/keys :req-un [::profile-id ::id ::is-resolved]
           :opt-un [::share-id]))
 
 (sv/defmethod ::update-comment-thread
   {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id is-resolved share-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id id is-resolved share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
-      (files/check-comment-permissions! conn profile-id file-id share-id)
+    (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
+      (when-not thread
+        (ex/raise :type :not-found))
+
+      (files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
+
       (db/update! conn :comment-thread
                   {:is-resolved is-resolved}
                   {:id id})
@@ -401,149 +360,158 @@
 
 ;; --- COMMAND: Add Comment
 
-(declare get-comment-thread)
 (declare create-comment)
 
 (s/def ::create-comment
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::thread-id ::content]
+  (s/keys :req-un [::profile-id ::thread-id ::content]
           :opt-un [::share-id]))
 
 (sv/defmethod ::create-comment
   {::doc/added "1.15"
    ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content] :as params}]
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id ::db/for-update? true)
-          {:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)]
+    (create-comment conn params)))
 
-      (files/check-comment-permissions! conn profile-id (:id file) share-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 (:id file)})
+(defn create-comment
+  [conn {:keys [profile-id thread-id content share-id] :as params}]
+  (let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true})
+                   (decode-row))
+        pname  (retrieve-page-name conn thread)]
 
-      ;; Update the page-name cached attribute on comment thread table.
-      (when (not= page-name (:page-name thread))
-        (db/update! conn :comment-thread
-                    {:page-name page-name}
-                    {:id thread-id}))
+    ;; Standard Checks
+    (when-not thread (ex/raise :type :not-found))
 
-      (let [comment (db/insert! conn :comment
-                                {:id (uuid/next)
-                                 :created-at request-at
-                                 :modified-at request-at
-                                 :thread-id thread-id
-                                 :owner-id profile-id
-                                 :content content})
-            props    {:file-id file-id
-                      :share-id nil}]
+    ;; Permission Checks
+    (files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
 
-        ;; Update thread modified-at attribute and assoc the current
-        ;; profile to the participant set.
-        (db/update! conn :comment-thread
-                    {:modified-at request-at
-                     :participants (-> (:participants thread #{})
-                                       (conj profile-id)
-                                       (db/tjson))}
-                    {:id thread-id})
+    ;; Update the page-name cachedattribute on comment thread table.
+    (when (not= pname (:page-name thread))
+      (db/update! conn :comment-thread
+                  {:page-name pname}
+                  {:id thread-id}))
 
-        ;; Update the current profile status in relation to the
-        ;; current thread.
-        (upsert-comment-thread-status! conn profile-id thread-id request-at)
+    ;; NOTE: is important that all timestamptz related fields are
+    ;; created or updated on the database level for avoid clock
+    ;; inconsistencies (some user sees something read that is not
+    ;; read, etc...)
+    (let [ppants  (:participants thread #{})
+          comment (db/insert! conn :comment
+                              {:thread-id thread-id
+                               :owner-id profile-id
+                               :content content})]
 
-        (vary-meta comment assoc ::audit/props props)))))
+      ;; NOTE: this is done in SQL instead of using db/update!
+      ;; helper because currently the helper does not allow pass raw
+      ;; function call parameters to the underlying prepared
+      ;; statement; in a future when we fix/improve it, this can be
+      ;; changed to use the helper.
+
+      ;; Update thread modified-at attribute and assoc the current
+      ;; profile to the participant set.
+      (let [ppants (conj ppants profile-id)
+            sql    "update comment_thread
+                         set modified_at = clock_timestamp(),
+                             participants = ?
+                       where id = ?"]
+        (db/exec-one! conn [sql (db/tjson ppants) thread-id]))
+
+      ;; Update the current profile status in relation to the
+      ;; current thread.
+      (upsert-comment-thread-status! conn profile-id thread-id)
+
+      ;; Return the created comment object.
+      comment)))
 
 ;; --- COMMAND: Update Comment
 
+(declare update-comment)
+
 (s/def ::update-comment
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id ::content]
+  (s/keys :req-un [::profile-id ::id ::content]
           :opt-un [::share-id]))
 
 (sv/defmethod ::update-comment
   {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id share-id content] :as params}]
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (let [{:keys [thread-id] :as comment} (get-comment conn id ::db/for-update? true)
-          {:keys [file-id page-id owner-id] :as thread} (get-comment-thread conn thread-id ::db/for-update? true)]
+    (update-comment conn params)))
 
-      (files/check-comment-permissions! conn profile-id file-id share-id)
+(defn update-comment
+  [conn {:keys [profile-id id content share-id] :as params}]
+  (let [comment (db/get-by-id conn :comment id {:for-update true})
+        _       (when-not comment (ex/raise :type :not-found))
+        thread  (db/get-by-id conn :comment-thread (:thread-id comment) {:for-update true})
+        _       (when-not thread (ex/raise :type :not-found))
+        pname   (retrieve-page-name conn thread)]
 
-      ;; Don't allow edit comments to not owners
-      (when-not (= owner-id profile-id)
-        (ex/raise :type :validation
-                  :code :not-allowed))
+    (files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
 
-      (let [{:keys [page-name] :as file} (get-file conn file-id page-id)]
-        (db/update! conn :comment
-                    {:content content
-                     :modified-at request-at}
-                    {:id id})
+    ;; Don't allow edit comments to not owners
+    (when-not (= (:owner-id thread) profile-id)
+      (ex/raise :type :validation
+                :code :not-allowed))
+
+    (db/update! conn :comment
+                {:content content
+                 :modified-at (dt/now)}
+                {:id (:id comment)})
+
+    (db/update! conn :comment-thread
+                {:modified-at (dt/now)
+                 :page-name pname}
+                {:id (:id thread)})
+    nil))
 
-        (db/update! conn :comment-thread
-                    {:modified-at request-at
-                     :page-name page-name}
-                    {:id thread-id})
-        nil))))
 
 ;; --- COMMAND: Delete Comment Thread
 
 (s/def ::delete-comment-thread
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]
-          :opt-un [::share-id]))
+  (s/keys :req-un [::profile-id ::id]))
 
 (sv/defmethod ::delete-comment-thread
   {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [owner-id file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
-      (files/check-comment-permissions! conn profile-id file-id share-id)
-      (when-not (= owner-id profile-id)
+    (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
+      (when-not (= (:owner-id thread) profile-id)
         (ex/raise :type :validation
                   :code :not-allowed))
-
       (db/delete! conn :comment-thread {:id id})
       nil)))
 
+
 ;; --- COMMAND: Delete comment
 
 (s/def ::delete-comment
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]
-          :opt-un [::share-id]))
+  (s/keys :req-un [::profile-id ::id]))
 
 (sv/defmethod ::delete-comment
-  {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
+  {::doc/added "1.15"
+   ::webhooks/event? true}
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [owner-id thread-id] :as comment} (get-comment conn id ::db/for-update? true)
-          {:keys [file-id] :as thread} (get-comment-thread conn thread-id)]
-      (files/check-comment-permissions! conn profile-id file-id share-id)
-      (when-not (= owner-id profile-id)
+    (let [comment (db/get-by-id conn :comment id {:for-update true})]
+      (when-not (= (:owner-id comment) profile-id)
         (ex/raise :type :validation
                   :code :not-allowed))
-      (db/delete! conn :comment {:id id}))))
 
+      (db/delete! conn :comment {:id id}))))
 
 ;; --- COMMAND: Update comment thread position
 
 (s/def ::update-comment-thread-position
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id ::position ::frame-id]
+  (s/keys :req-un [::profile-id ::id ::position ::frame-id]
           :opt-un [::share-id]))
 
 (sv/defmethod ::update-comment-thread-position
   {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id position frame-id share-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id id position frame-id share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
-      (files/check-comment-permissions! conn profile-id file-id share-id)
+    (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
+      (files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
       (db/update! conn :comment-thread
-                  {:modified-at (::rpc/request-at params)
+                  {:modified-at (dt/now)
                    :position (db/pgpoint position)
                    :frame-id frame-id}
                   {:id (:id thread)})
@@ -552,18 +520,17 @@
 ;; --- COMMAND: Update comment frame
 
 (s/def ::update-comment-thread-frame
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id ::frame-id]
+  (s/keys :req-un [::profile-id ::id ::frame-id]
           :opt-un [::share-id]))
 
 (sv/defmethod ::update-comment-thread-frame
   {::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id frame-id share-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id id frame-id share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
-      (files/check-comment-permissions! conn profile-id file-id share-id)
+    (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
+      (files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
       (db/update! conn :comment-thread
-                  {:modified-at (::rpc/request-at params)
+                  {:modified-at (dt/now)
                    :frame-id frame-id}
-                  {:id id})
+                  {:id (:id thread)})
       nil)))

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

@@ -8,11 +8,11 @@
   "A demo specific mutations."
   (:require
    [app.common.exceptions :as ex]
+   [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.loggers.audit :as audit]
-   [app.rpc :as-alias rpc]
-   [app.rpc.commands.auth :as auth]
+   [app.rpc.commands.auth :as cmd.auth]
    [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -26,34 +26,35 @@
   "A command that is responsible of creating a demo purpose
   profile. It only works if the `demo-users` flag is enabled in the
   configuration."
-  {::rpc/auth false
+  {:auth false
    ::doc/added "1.15"
    ::doc/changes ["1.15" "This method is migrated from mutations to commands."]}
-  [{:keys [::db/pool] :as cfg} _]
-
-  (when-not (contains? cf/flags :demo-users)
-    (ex/raise :type :validation
-              :code :demo-users-not-allowed
-              :hint "Demo users are disabled by config."))
-
-  (let [sem      (System/currentTimeMillis)
+  [{:keys [pool] :as cfg} _]
+  (let [id       (uuid/next)
+        sem      (System/currentTimeMillis)
         email    (str "demo-" sem ".demo@example.com")
         fullname (str "Demo User " sem)
-
         password (-> (bn/random-bytes 16)
                      (bc/bytes->b64u)
                      (bc/bytes->str))
-
-        params   {:email email
+        params   {:id id
+                  :email email
                   :fullname fullname
                   :is-active true
                   :deleted-at (dt/in-future cf/deletion-delay)
                   :password password
-                  :props {}}]
+                  :props {}
+                  }]
+
+    (when-not (contains? cf/flags :demo-users)
+      (ex/raise :type :validation
+                :code :demo-users-not-allowed
+                :hint "Demo users are disabled by config."))
 
     (db/with-atomic [conn pool]
-      (let [profile (->> (auth/create-profile! conn params)
-                         (auth/create-profile-rels! conn))]
-        (with-meta {:email email
-                    :password password}
-          {::audit/profile-id (:id profile)})))))
+      (->> (cmd.auth/create-profile conn params)
+           (cmd.auth/create-profile-relations conn))
+
+      (with-meta {:email email
+                  :password password}
+        {::audit/profile-id id}))))

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

@@ -1,56 +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.feedback
-  "A general purpose feedback module."
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.emails :as eml]
-   [app.rpc :as-alias rpc]
-   [app.rpc.commands.profile :as profile]
-   [app.rpc.doc :as-alias doc]
-   [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
-
-(declare ^:private send-feedback!)
-
-(s/def ::content ::us/string)
-(s/def ::from    ::us/email)
-(s/def ::subject ::us/string)
-
-(s/def ::send-user-feedback
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::subject
-                   ::content]))
-
-(sv/defmethod ::send-user-feedback
-  {::doc/added "1.18"}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id] :as params}]
-  (when-not (contains? cf/flags :user-feedback)
-    (ex/raise :type :restriction
-              :code :feedback-disabled
-              :hint "feedback not enabled"))
-
-  (let [profile (profile/get-profile pool profile-id)]
-    (send-feedback! pool profile params)
-    nil))
-
-(defn- send-feedback!
-  [pool profile params]
-  (let [dest (cf/get :feedback-destination)]
-    (eml/send! {::eml/conn pool
-                ::eml/factory eml/feedback
-                :from     dest
-                :to       dest
-                :profile  profile
-                :reply-to (:email profile)
-                :email    (:email profile)
-                :subject  (:subject params)
-                :content  (:content params)})
-    nil))

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

@@ -15,19 +15,17 @@
    [app.common.spec :as us]
    [app.common.types.file :as ctf]
    [app.common.types.shape-tree :as ctt]
-   [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
-   [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
-   [app.rpc :as-alias rpc]
    [app.rpc.commands.files.thumbnails :as-alias thumbs]
-   [app.rpc.commands.projects :as projects]
-   [app.rpc.commands.teams :as teams]
    [app.rpc.cond :as-alias cond]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
    [app.rpc.permissions :as perms]
+   [app.rpc.queries.projects :as projects]
+   [app.rpc.queries.share-link :refer [retrieve-share-link]]
+   [app.rpc.queries.teams :as teams]
    [app.util.blob :as blob]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
@@ -43,13 +41,7 @@
     "storage/pointer-map"
     "components/v2"})
 
-(def default-features
-  (cond-> #{}
-    (contains? cf/flags :fdata-storage-pointer-map)
-    (conj "storage/pointer-map")
-
-    (contains? cf/flags :fdata-storage-objects-map)
-    (conj "storage/objects-map")))
+(def default-features #{})
 
 ;; --- SPECS
 
@@ -59,6 +51,7 @@
 (s/def ::id ::us/uuid)
 (s/def ::is-shared ::us/boolean)
 (s/def ::name ::us/string)
+(s/def ::profile-id ::us/uuid)
 (s/def ::project-id ::us/uuid)
 (s/def ::search-term ::us/string)
 (s/def ::team-id ::us/uuid)
@@ -127,9 +120,7 @@
 
   ([conn profile-id file-id share-id]
    (let [perms  (get-permissions conn profile-id file-id)
-         ldata  (some-> (db/get* conn :share-link {:id share-id :file-id file-id})
-                        (dissoc :flags)
-                        (update :pages db/decode-pgarray #{}))]
+         ldata  (retrieve-share-link conn file-id share-id)]
 
      ;; NOTE: in a future when share-link becomes more powerful and
      ;; will allow us specify which parts of the app is available, we
@@ -159,14 +150,11 @@
 (def check-read-permissions!
   (perms/make-check-fn has-read-permissions?))
 
-;; A user has comment permissions if she has read permissions, or
-;; explicit comment permissions through the share-id
-
+;; A user has comment permissions if she has read permissions, or comment permissions
 (defn check-comment-permissions!
   [conn profile-id file-id share-id]
-  (let [perms       (get-permissions conn profile-id file-id share-id)
-        can-read    (has-read-permissions? perms)
-        can-comment (has-comment-permissions? perms)]
+  (let [can-read (has-read-permissions? conn profile-id file-id)
+        can-comment  (has-comment-permissions? conn profile-id file-id share-id)]
     (when-not (or can-read can-comment)
       (ex/raise :type :not-found
                 :code :object-not-found
@@ -197,7 +185,7 @@
   (let [row (db/get conn :file-data-fragment
                     {:id id :file-id file-id}
                     {:columns [:content]
-                     ::db/check-deleted? false})]
+                     :check-deleted? false})]
     (blob/decode (:content row))))
 
 (defn persist-pointers!
@@ -252,6 +240,7 @@
   [conn id client-features]
   ;; here we check if client requested features are supported
   (check-features-compatibility! client-features)
+
   (binding [pmap/*load-fn* (partial load-pointer conn id)]
     (-> (db/get-by-id conn :file id)
         (decode-row)
@@ -259,7 +248,7 @@
         (handle-file-features client-features))))
 
 (defn get-minimal-file
-  [{:keys [::db/pool] :as cfg} id]
+  [{:keys [pool] :as cfg} id]
   (db/get pool :file {:id id} {:columns [:id :modified-at :revn]}))
 
 (defn get-file-etag
@@ -267,8 +256,7 @@
   (str (dt/format-instant modified-at :iso) "-" revn))
 
 (s/def ::get-file
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]
+  (s/keys :req-un [::profile-id ::id]
           :opt-un [::features]))
 
 (sv/defmethod ::get-file
@@ -276,7 +264,7 @@
   {::doc/added "1.17"
    ::cond/get-object #(get-minimal-file %1 (:id %2))
    ::cond/key-fn get-file-etag}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id features]}]
+  [{:keys [pool] :as cfg} {:keys [profile-id id features] :as params}]
   (with-open [conn (db/open pool)]
     (let [perms (get-permissions conn profile-id id)]
       (check-read-permissions! perms)
@@ -297,14 +285,13 @@
 
 (s/def ::get-file-fragment
   (s/keys :req-un [::file-id ::fragment-id]
-          :opt [::rpc/profile-id]
-          :opt-un [::share-id]))
+          :opt-un [::share-id ::profile-id]))
 
 (sv/defmethod ::get-file-fragment
   "Retrieve a file by its ID. Only authenticated users."
   {::doc/added "1.17"
-   ::rpc/:auth false}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id] }]
+   :auth false}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id fragment-id share-id] :as params}]
   (with-open [conn (db/open pool)]
     (let [perms (get-permissions conn profile-id file-id share-id)]
       (check-read-permissions! perms)
@@ -332,7 +319,7 @@
           (d/index-by :object-id :data)))))
 
 (s/def ::get-file-object-thumbnails
-  (s/keys :req [::rpc/profile-id] :req-un [::file-id]))
+  (s/keys :req-un [::profile-id ::file-id]))
 
 (sv/defmethod ::get-file-object-thumbnails
   "Retrieve a file object thumbnails."
@@ -340,7 +327,7 @@
    ::cond/get-object #(get-minimal-file %1 (:file-id %2))
    ::cond/reuse-key? true
    ::cond/key-fn get-file-etag}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (get-object-thumbnails conn file-id)))
@@ -362,7 +349,7 @@
     order by f.modified_at desc")
 
 (s/def ::get-project-files
-  (s/keys :req [::rpc/profile-id] :req-un [::project-id]))
+  (s/keys :req-un [::profile-id ::project-id]))
 
 (defn get-project-files
   [conn project-id]
@@ -371,7 +358,7 @@
 (sv/defmethod ::get-project-files
   "Get all files for the specified project."
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id]}]
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
   (with-open [conn (db/open pool)]
     (projects/check-read-permissions! conn profile-id project-id)
     (get-project-files conn project-id)))
@@ -382,18 +369,18 @@
 (declare get-has-file-libraries)
 
 (s/def ::file-id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
 
 (s/def ::has-file-libraries
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id]))
+  (s/keys :req-un [::profile-id ::file-id]))
 
 (sv/defmethod ::has-file-libraries
   "Checks if the file has libraries. Returns a boolean"
   {::doc/added "1.15.1"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id]}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! pool profile-id file-id)
-    (get-has-file-libraries conn file-id)))
+    (get-has-file-libraries conn params)))
 
 (def ^:private sql:has-file-libraries
   "SELECT COUNT(*) > 0 AS has_libraries
@@ -404,7 +391,7 @@
            fl.deleted_at > now())")
 
 (defn- get-has-file-libraries
-  [conn file-id]
+  [conn {:keys [file-id]}]
   (let [row (db/exec-one! conn [sql:has-file-libraries file-id])]
     (:has-libraries row)))
 
@@ -438,8 +425,7 @@
 (s/def ::object-id ::us/uuid)
 (s/def ::get-page
   (s/and
-   (s/keys :req [::rpc/profile-id]
-           :req-un [::file-id]
+   (s/keys :req-un [::profile-id ::file-id]
            :opt-un [::page-id ::object-id ::features])
    (fn [obj]
      (if (contains? obj :object-id)
@@ -457,7 +443,7 @@
 
   Mainly used for rendering purposes."
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (get-page conn params)))
@@ -483,36 +469,37 @@
     order by f.modified_at desc")
 
 (defn get-team-shared-files
-  [conn team-id]
-  (letfn [(assets-sample [assets limit]
-            (let [sorted-assets (->> (vals assets)
-                                     (sort-by #(str/lower (:name %))))]
-              {:count (count sorted-assets)
-               :sample (into [] (take limit sorted-assets))}))
+  [conn {:keys [team-id] :as params}]
+  (let [assets-sample
+        (fn [assets limit]
+          (let [sorted-assets (->> (vals assets)
+                                   (sort-by #(str/lower (:name %))))]
 
-          (library-summary [{:keys [id data] :as file}]
-            (binding [pmap/*load-fn* (partial load-pointer conn id)]
-              {:components (assets-sample (:components data) 4)
-               :colors (assets-sample (:colors data) 3)
-               :typographies (assets-sample (:typographies data) 3)}))]
+            {:count (count sorted-assets)
+             :sample (into [] (take limit sorted-assets))}))
 
-    (->> (db/exec! conn [sql:team-shared-files team-id])
-         (into #{} (comp
-                    (map decode-row)
-                    (map #(assoc % :library-summary (library-summary %)))
-                    (map #(dissoc % :data)))))))
+        library-summary
+        (fn [data]
+          {:components (assets-sample (:components data) 4)
+           :colors (assets-sample (:colors data) 3)
+           :typographies (assets-sample (:typographies data) 3)})
+
+        xform (comp
+               (map decode-row)
+               (map #(assoc % :library-summary (library-summary (:data %))))
+               (map #(dissoc % :data)))]
+
+    (into #{} xform (db/exec! conn [sql:team-shared-files team-id]))))
 
 (s/def ::get-team-shared-files
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]))
+  (s/keys :req-un [::profile-id ::team-id]))
 
 (sv/defmethod ::get-team-shared-files
   "Get all file (libraries) for the specified team."
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
+  [{:keys [pool] :as cfg} params]
   (with-open [conn (db/open pool)]
-    (teams/check-read-permissions! conn profile-id team-id)
-    (get-team-shared-files conn team-id)))
+    (get-team-shared-files conn params)))
 
 
 ;; --- COMMAND QUERY: get-file-libraries
@@ -546,24 +533,21 @@
   [conn file-id client-features]
   (check-features-compatibility! client-features)
   (->> (db/exec! conn [sql:file-libraries file-id])
-       (map decode-row)
-       (map #(assoc % :is-indirect false))
-       (map (fn [{:keys [id] :as row}]
-              (binding [pmap/*load-fn* (partial load-pointer conn id)]
-                (-> row
-                    (update :data dissoc :pages-index)
-                    (handle-file-features client-features)))))
-       (vec)))
+       (mapv (fn [{:keys [id] :as row}]
+               (binding [pmap/*load-fn* (partial load-pointer conn id)]
+                 (-> (decode-row row)
+                     (assoc :is-indirect false)
+                     (update :data dissoc :pages-index)
+                     (handle-file-features client-features)))))))
 
 (s/def ::get-file-libraries
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id]
+  (s/keys :req-un [::profile-id ::file-id]
           :opt-un [::features]))
 
 (sv/defmethod ::get-file-libraries
   "Get libraries used by the specified file."
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id features]}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id features] :as params}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (get-file-libraries conn file-id features)))
@@ -584,16 +568,17 @@
   (db/exec! conn [sql:library-using-files file-id]))
 
 (s/def ::get-library-file-references
-  (s/keys :req [::rpc/profile-id] :req-un [::file-id]))
+  (s/keys :req-un [::profile-id ::file-id]))
 
 (sv/defmethod ::get-library-file-references
   "Returns all the file references that use specified file (library) id."
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (get-library-file-references conn file-id)))
 
+
 ;; --- COMMAND QUERY: get-team-recent-files
 
 (def sql:team-recent-files
@@ -621,12 +606,11 @@
   (db/exec! conn [sql:team-recent-files team-id]))
 
 (s/def ::get-team-recent-files
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]))
+  (s/keys :req-un [::profile-id ::team-id]))
 
 (sv/defmethod ::get-team-recent-files
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
   (with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
     (get-team-recent-files conn team-id)))
@@ -654,13 +638,12 @@
 (s/def ::revn ::us/integer)
 
 (s/def ::get-file-thumbnail
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id]
+  (s/keys :req-un [::profile-id ::file-id]
           :opt-un [::revn]))
 
 (sv/defmethod ::get-file-thumbnail
   {::doc/added "1.17"}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id file-id revn]}]
+  [{:keys [pool]} {:keys [profile-id file-id revn]}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (-> (get-file-thumbnail conn file-id revn)
@@ -722,52 +705,46 @@
 
                 objects)))]
 
-    (binding [pmap/*load-fn* (partial load-pointer conn id)]
-      (let [frame     (get-thumbnail-frame data)
-            frame-id  (:id frame)
-            page-id   (or (:page-id frame)
-                          (-> data :pages first))
+    (let [frame     (get-thumbnail-frame data)
+          frame-id  (:id frame)
+          page-id   (or (:page-id frame)
+                        (-> data :pages first))
 
-            page      (dm/get-in data [:pages-index page-id])
-            page      (cond-> page (pmap/pointer-map? page) deref)
-            frame-ids (if (some? frame) (list frame-id) (map :id (ctt/get-frames (:objects page))))
+          page      (dm/get-in data [:pages-index page-id])
+          frame-ids (if (some? frame) (list frame-id) (map :id (ctt/get-frames (:objects page))))
 
-            obj-ids   (map #(str page-id %) frame-ids)
-            thumbs    (get-object-thumbnails conn id obj-ids)]
+          obj-ids   (map #(str page-id %) frame-ids)
+          thumbs    (get-object-thumbnails conn id obj-ids)]
 
-        (cond-> page
-          ;; If we have frame, we need to specify it on the page level
-          ;; and remove the all other unrelated objects.
-          (some? frame-id)
-          (-> (assoc :thumbnail-frame-id frame-id)
-              (update :objects filter-objects frame-id))
+      (cond-> page
+        ;; If we have frame, we need to specify it on the page level
+        ;; and remove the all other unrelated objects.
+        (some? frame-id)
+        (-> (assoc :thumbnail-frame-id frame-id)
+            (update :objects filter-objects frame-id))
 
-          ;; Assoc the available thumbnails and prune not visible shapes
-          ;; for avoid transfer unnecessary data.
-          :always
-          (update :objects assoc-thumbnails page-id thumbs))))))
+        ;; Assoc the available thumbnails and prune not visible shapes
+        ;; for avoid transfer unnecessary data.
+        :always
+        (update :objects assoc-thumbnails page-id thumbs)))))
 
 (s/def ::get-file-data-for-thumbnail
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id]
+  (s/keys :req-un [::profile-id ::file-id]
           :opt-un [::features]))
 
 (sv/defmethod ::get-file-data-for-thumbnail
   "Retrieves the data for generate the thumbnail of the file. Used
   mainly for render thumbnails on dashboard."
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id features] :as props}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id features] :as props}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
-    ;; NOTE: we force here the "storage/pointer-map" feature, because
-    ;; it used internally only and is independent if user supports it
-    ;; or not.
-    (let [feat (into #{"storage/pointer-map"} features)
-          file (get-file conn file-id feat)]
+    (let [file (get-file conn file-id features)]
       {:file-id file-id
        :revn (:revn file)
        :page (get-file-data-for-thumbnail conn file)})))
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; MUTATION COMMANDS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -775,28 +752,24 @@
 ;; --- MUTATION COMMAND: rename-file
 
 (defn rename-file
-  [conn {:keys [id name]}]
-  (db/update! conn :file
-              {:name name
-               :modified-at (dt/now)}
-              {:id id}))
+  [conn {:keys [id name] :as params}]
+  (-> (db/update! conn :file
+                  {:name name
+                   :modified-at (dt/now)}
+                  {:id id})
+      (select-keys [:id :name :created-at :modified-at])))
 
 (s/def ::rename-file
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::name ::id]))
+  (s/keys :req-un [::profile-id ::name ::id]))
 
 (sv/defmethod ::rename-file
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id id)
-    (let [file (rename-file conn params)]
-      (rph/with-meta
-        (select-keys file [:id :name :created-at :modified-at])
-        {::audit/props {:project-id (:project-id file)
-                        :created-at (:created-at file)
-                        :modified-at (:modified-at file)}}))))
+    (rename-file conn params)))
+
 
 ;; --- MUTATION COMMAND: set-file-shared
 
@@ -806,9 +779,10 @@
 
 (defn set-file-shared
   [conn {:keys [id is-shared] :as params}]
-  (db/update! conn :file
-              {:is-shared is-shared}
-              {:id id}))
+  (-> (db/update! conn :file
+                  {:is-shared is-shared}
+                  {:id id})
+      (select-keys [:id :name :is-shared])))
 
 (defn absorb-library
   "Find all files using a shared library, and absorb all library assets
@@ -819,7 +793,7 @@
       (let [ldata (-> library decode-row pmg/migrate-file :data)]
         (->> (db/query conn :file-library-rel {:library-file-id id})
              (map :file-id)
-             (keep #(db/get-by-id conn :file % ::db/check-deleted? false))
+             (keep #(db/get-by-id conn :file % {:check-deleted? false}))
              (map decode-row)
              (map pmg/migrate-file)
              (run! (fn [{:keys [id data revn] :as file}]
@@ -831,25 +805,19 @@
                                    {:id id})))))))))
 
 (s/def ::set-file-shared
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id ::is-shared]))
+  (s/keys :req-un [::profile-id ::id ::is-shared]))
 
 (sv/defmethod ::set-file-shared
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id is-shared] :as params}]
+  [{:keys [pool] :as cfg} {:keys [id profile-id is-shared] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id id)
     (when-not is-shared
       (absorb-library conn params)
       (unlink-files conn params))
+    (set-file-shared conn params)))
 
-    (let [file (set-file-shared conn params)]
-      (rph/with-meta
-        (select-keys file [:id :name :is-shared])
-        {::audit/props {:name (:name file)
-                        :project-id (:project-id file)
-                        :is-shared (:is-shared file)}}))))
 
 ;; --- MUTATION COMMAND: delete-file
 
@@ -857,26 +825,20 @@
   [conn {:keys [id] :as params}]
   (db/update! conn :file
               {:deleted-at (dt/now)}
-              {:id id}))
+              {:id id})
+  nil)
 
 (s/def ::delete-file
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]))
+  (s/keys :req-un [::id ::profile-id]))
 
 (sv/defmethod ::delete-file
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id id)
     (absorb-library conn params)
-    (let [file (mark-file-deleted conn params)]
-
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:project-id (:project-id file)
-                        :name (:name file)
-                        :created-at (:created-at file)
-                        :modified-at (:modified-at file)}}))))
+    (mark-file-deleted conn params)))
 
 ;; --- MUTATION COMMAND: link-file-to-library
 
@@ -890,13 +852,12 @@
   (db/exec-one! conn [sql:link-file-to-library file-id library-id]))
 
 (s/def ::link-file-to-library
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::library-id]))
+  (s/keys :req-un [::profile-id ::file-id ::library-id]))
 
 (sv/defmethod ::link-file-to-library
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id library-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
   (when (= file-id library-id)
     (ex/raise :type :validation
               :code :invalid-library
@@ -909,19 +870,18 @@
 ;; --- MUTATION COMMAND: unlink-file-from-library
 
 (defn unlink-file-from-library
-  [conn {:keys [file-id library-id]}]
+  [conn {:keys [file-id library-id] :as params}]
   (db/delete! conn :file-library-rel
               {:file-id file-id
                :library-file-id library-id}))
 
 (s/def ::unlink-file-from-library
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::library-id]))
+  (s/keys :req-un [::profile-id ::file-id ::library-id]))
 
 (sv/defmethod ::unlink-file-from-library
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (unlink-file-from-library conn params)))
@@ -937,15 +897,14 @@
                :library-file-id library-id}))
 
 (s/def ::update-file-library-sync-status
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::library-id]))
+  (s/keys :req-un [::profile-id ::file-id ::library-id]))
 
 ;; TODO: improve naming
 
 (sv/defmethod ::update-file-library-sync-status
   "Update the synchronization statos of a file->library link"
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (update-sync conn params)))
@@ -960,18 +919,16 @@
               {:id file-id}))
 
 (s/def ::ignore-file-library-sync-status
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::date]))
+  (s/keys :req-un [::profile-id ::file-id ::date]))
 
 ;; TODO: improve naming
 (sv/defmethod ::ignore-file-library-sync-status
   "Ignore updates in linked files"
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
-    (->  (ignore-sync conn params)
-         (update :features db/decode-pgarray #{}))))
+    (ignore-sync conn params)))
 
 
 ;; --- MUTATION COMMAND: upsert-file-object-thumbnail
@@ -991,13 +948,11 @@
 (s/def ::data (s/nilable ::us/string))
 (s/def ::thumbs/object-id ::us/string)
 (s/def ::upsert-file-object-thumbnail
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::thumbs/object-id]
-          :opt-un [::data]))
+  (s/keys :req-un [::profile-id ::file-id ::thumbs/object-id ::data]))
 
 (sv/defmethod ::upsert-file-object-thumbnail
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (upsert-file-object-thumbnail! conn params)
@@ -1020,14 +975,13 @@
 (s/def ::revn ::us/integer)
 (s/def ::props map?)
 (s/def ::upsert-file-thumbnail
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::revn ::data ::props]))
+  (s/keys :req-un [::profile-id ::file-id ::revn ::data ::props]))
 
 (sv/defmethod ::upsert-file-thumbnail
   "Creates or updates the file thumbnail. Mainly used for paint the
   grid thumbnails."
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (upsert-file-thumbnail conn params)

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

@@ -4,7 +4,7 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.rpc.commands.files-create
+(ns app.rpc.commands.files.create
   (:require
    [app.common.data :as d]
    [app.common.files.features :as ffeat]
@@ -13,12 +13,10 @@
    [app.db :as db]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
-   [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
-   [app.rpc.commands.projects :as projects]
    [app.rpc.doc :as-alias doc]
    [app.rpc.permissions :as perms]
-   [app.rpc.quotes :as quotes]
+   [app.rpc.queries.projects :as proj]
    [app.util.blob :as blob]
    [app.util.objects-map :as omap]
    [app.util.pointer-map :as pmap]
@@ -70,8 +68,8 @@
     (files/decode-row file)))
 
 (s/def ::create-file
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::files/name
+  (s/keys :req-un [::files/profile-id
+                   ::files/name
                    ::files/project-id]
           :opt-un [::files/id
                    ::files/is-shared
@@ -80,17 +78,10 @@
 (sv/defmethod ::create-file
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
   (db/with-atomic [conn pool]
-    (projects/check-edition-permissions! conn profile-id project-id)
-    (let [team-id (files/get-team-id conn project-id)
-          params  (assoc params :profile-id profile-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}))
-
+    (proj/check-edition-permissions! conn profile-id project-id)
+    (let [team-id (files/get-team-id conn project-id)]
       (-> (create-file conn params)
           (vary-meta assoc ::audit/props {:team-id team-id})))))
+

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

@@ -4,19 +4,18 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.rpc.commands.files-temp
+(ns app.rpc.commands.files.temp
   (:require
    [app.common.exceptions :as ex]
    [app.common.pages :as cp]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.db :as db]
-   [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
-   [app.rpc.commands.files-create :refer [create-file]]
-   [app.rpc.commands.files-update :as-alias files.update]
-   [app.rpc.commands.projects :as projects]
+   [app.rpc.commands.files.create :as files.create]
+   [app.rpc.commands.files.update :as files.update]
    [app.rpc.doc :as-alias doc]
+   [app.rpc.queries.projects :as proj]
    [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -27,8 +26,8 @@
 (s/def ::create-page ::us/boolean)
 
 (s/def ::create-temp-file
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::files/name
+  (s/keys :req-un [::files/profile-id
+                   ::files/name
                    ::files/project-id]
           :opt-un [::files/id
                    ::files/is-shared
@@ -37,10 +36,10 @@
 
 (sv/defmethod ::create-temp-file
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
   (db/with-atomic [conn pool]
-    (projects/check-edition-permissions! conn profile-id project-id)
-    (create-file conn (assoc params :profile-id profile-id :deleted-at (dt/in-future {:days 1})))))
+    (proj/check-edition-permissions! conn profile-id project-id)
+    (files.create/create-file conn (assoc params :deleted-at (dt/in-future {:days 1})))))
 
 ;; --- MUTATION COMMAND: update-temp-file
 
@@ -57,17 +56,16 @@
                :changes (blob/encode changes)}))
 
 (s/def ::update-temp-file
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::files.update/changes
+  (s/keys :req-un [::files.update/changes
                    ::files.update/revn
                    ::files.update/session-id
                    ::files/id]))
 
 (sv/defmethod ::update-temp-file
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (update-temp-file conn (assoc params :profile-id profile-id))
+    (update-temp-file conn params)
     nil))
 
 ;; --- MUTATION COMMAND: persist-temp-file
@@ -97,12 +95,12 @@
     nil))
 
 (s/def ::persist-temp-file
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::files/id]))
+  (s/keys :req-un [::files/id
+                   ::files/profile-id]))
 
 (sv/defmethod ::persist-temp-file
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
     (persist-temp-file conn params)))

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

@@ -4,7 +4,7 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.rpc.commands.files-update
+(ns app.rpc.commands.files.update
   (:require
    [app.common.exceptions :as ex]
    [app.common.files.features :as ffeat]
@@ -17,10 +17,9 @@
    [app.config :as cf]
    [app.db :as db]
    [app.loggers.audit :as audit]
-   [app.loggers.webhooks :as webhooks]
+   [app.loggers.webhooks :as-alias webhooks]
    [app.metrics :as mtx]
    [app.msgbus :as mbus]
-   [app.rpc :as-alias rpc]
    [app.rpc.climit :as-alias climit]
    [app.rpc.commands.files :as files]
    [app.rpc.doc :as-alias doc]
@@ -53,8 +52,7 @@
 (s/def ::revn ::us/integer)
 (s/def ::update-file
   (s/and
-   (s/keys :req [::rpc/profile-id]
-           :req-un [::files/id ::session-id ::revn]
+   (s/keys :req-un [::files/id ::files/profile-id ::session-id ::revn]
            :opt-un [::changes ::changes-with-metadata ::features])
    (fn [o]
      (or (contains? o :changes)
@@ -125,27 +123,30 @@
 ;; set is different than the persisted one, update it on the
 ;; database.
 
+(defn webhook-batch-keyfn
+  [props]
+  (str "rpc:update-file:" (:id props)))
+
 (sv/defmethod ::update-file
   {::climit/queue :update-file
    ::climit/key-fn :id
    ::webhooks/event? true
-   ::webhooks/batch-timeout (dt/duration "2m")
-   ::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
+   ::webhooks/batch-timeout (dt/duration "2s")
+   ::webhooks/batch-key webhook-batch-keyfn
    ::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
     (db/xact-lock! conn id)
 
     (let [cfg    (assoc cfg :conn conn)
-          params (assoc params :profile-id profile-id)
           tpoint (dt/tpoint)]
       (-> (update-file cfg params)
           (rph/with-defer #(let [elapsed (tpoint)]
                              (l/trace :hint "update-file" :time (dt/format-duration elapsed))))))))
 
 (defn update-file
-  [{:keys [conn ::mtx/metrics] :as cfg} {:keys [profile-id id changes changes-with-metadata] :as params}]
+  [{:keys [conn metrics] :as cfg} {:keys [id profile-id changes changes-with-metadata] :as params}]
   (let [file     (get-file conn id)
         features (->> (concat (:features file)
                               (:features params))
@@ -168,18 +169,7 @@
                         (->> changes-with-metadata (mapcat :changes) vec)
                         (vec changes))
 
-            params    (-> params
-                          (assoc :file file)
-                          (assoc :changes changes)
-                          (assoc ::created-at (dt/now)))]
-
-        (when (> (:revn params)
-                 (:revn file))
-          (ex/raise :type :validation
-                    :code :revn-conflict
-                    :hint "The incoming revision number is greater that stored version."
-                    :context {:incoming-revn (:revn params)
-                              :stored-revn (:revn file)}))
+            params    (assoc params :file file :changes changes)]
 
         (mtx/run! metrics {:id :update-file-changes :inc (count changes)})
 
@@ -191,15 +181,24 @@
 
         (-> (update-fn cfg params)
             (vary-meta assoc ::audit/replace-props
-                       {:id         (:id file)
-                        :name       (:name file)
-                        :features   (:features file)
+                       {:id (:id file)
+                        :name (:name file)
+                        :features (:features file)
                         :project-id (:project-id file)
                         :team-id    (:team-id file)}))))))
 
 (defn- update-file*
-  [{:keys [conn] :as cfg} {:keys [profile-id file changes session-id ::created-at] :as params}]
-  (let [file (-> file
+  [{:keys [conn] :as cfg} {:keys [file changes session-id profile-id] :as params}]
+  (when (> (:revn params)
+           (:revn file))
+    (ex/raise :type :validation
+              :code :revn-conflict
+              :hint "The incoming revision number is greater that stored version."
+              :context {:incoming-revn (:revn params)
+                        :stored-revn (:revn file)}))
+
+  (let [ts   (dt/now)
+        file (-> file
                  (update :revn inc)
                  (update :data (fn [data]
                                  (cond-> data
@@ -219,7 +218,7 @@
                 {:id (uuid/next)
                  :session-id session-id
                  :profile-id profile-id
-                 :created-at created-at
+                 :created-at ts
                  :file-id (:id file)
                  :revn (:revn file)
                  :features (db/create-array conn "text" (:features file))
@@ -231,12 +230,12 @@
                 {:revn (:revn file)
                  :data (:data file)
                  :data-backend nil
-                 :modified-at created-at
+                 :modified-at ts
                  :has-media-trimmed false}
                 {:id (:id file)})
 
     (db/update! conn :project
-                {:modified-at created-at}
+                {:modified-at ts}
                 {:id (:project-id file)})
 
     (let [params (assoc params :file file)]
@@ -267,15 +266,18 @@
     order by s.created_at asc")
 
 (defn- get-lagged-changes
-  [conn {:keys [id revn] :as params}]
-  (->> (db/exec! conn [sql:lagged-changes id revn])
-       (map files/decode-row)
-       (vec)))
+  [conn params]
+  (->> (db/exec! conn [sql:lagged-changes (:id params) (:revn params)])
+       (into [] (comp (map files/decode-row)
+                      (map (fn [row]
+                             (cond-> row
+                               (= (:revn row) (:revn (:file params)))
+                               (assoc :changes []))))))))
 
 (defn- send-notifications!
   [{:keys [conn] :as cfg} {:keys [file changes session-id] :as params}]
   (let [lchanges (filter library-change? changes)
-        msgbus   (::mbus/msgbus cfg)]
+        msgbus   (:msgbus cfg)]
 
     ;; Asynchronously publish message to the msgbus
     (mbus/pub! msgbus

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

@@ -1,71 +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.files-share
-  "Share link related rpc mutation methods."
-  (:require
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.db :as db]
-   [app.rpc :as-alias rpc]
-   [app.rpc.commands.files :as files]
-   [app.rpc.doc :as-alias doc]
-   [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
-
-;; --- Helpers & Specs
-
-(s/def ::file-id ::us/uuid)
-(s/def ::who-comment ::us/string)
-(s/def ::who-inspect ::us/string)
-(s/def ::pages (s/every ::us/uuid :kind set?))
-
-;; --- MUTATION: Create Share Link
-
-(declare create-share-link)
-
-(s/def ::create-share-link
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::who-comment ::who-inspect ::pages]))
-
-(sv/defmethod ::create-share-link
-  "Creates a share-link object.
-
-  Share links are resources that allows external users access to specific
-  pages of a file with specific permissions (who-comment and who-inspect)."
-  {::doc/added "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (files/check-edition-permissions! conn profile-id file-id)
-    (create-share-link conn (assoc params :profile-id profile-id))))
-
-(defn create-share-link
-  [conn {:keys [profile-id file-id pages who-comment who-inspect]}]
-  (let [pages (db/create-array conn "uuid" pages)
-        slink (db/insert! conn :share-link
-                          {:id (uuid/next)
-                           :file-id file-id
-                           :who-comment who-comment
-                           :who-inspect who-inspect
-                           :pages pages
-                           :owner-id profile-id})]
-
-    (update slink :pages db/decode-pgarray #{})))
-
-;; --- MUTATION: Delete Share Link
-
-(s/def ::delete-share-link
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::us/id]))
-
-(sv/defmethod ::delete-share-link
-  {::doc/added "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [slink (db/get-by-id conn :share-link id)]
-      (files/check-edition-permissions! conn profile-id (:file-id slink))
-      (db/delete! conn :share-link {:id id})
-      nil)))

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

@@ -1,237 +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.fonts
-  (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.db :as db]
-   [app.loggers.audit :as-alias audit]
-   [app.loggers.webhooks :as-alias webhooks]
-   [app.media :as media]
-   [app.rpc :as-alias rpc]
-   [app.rpc.climit :as-alias climit]
-   [app.rpc.commands.files :as files]
-   [app.rpc.commands.projects :as projects]
-   [app.rpc.commands.teams :as teams]
-   [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
-   [app.rpc.quotes :as quotes]
-   [app.storage :as sto]
-   [app.util.services :as sv]
-   [app.util.time :as dt]
-   [app.worker :as-alias wrk]
-   [clojure.spec.alpha :as s]
-   [promesa.core :as p]
-   [promesa.exec :as px]))
-
-(def valid-weight #{100 200 300 400 500 600 700 800 900 950})
-(def valid-style #{"normal" "italic"})
-
-(s/def ::data (s/map-of ::us/string any?))
-(s/def ::file-id ::us/uuid)
-(s/def ::font-id ::us/uuid)
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/not-empty-string)
-(s/def ::project-id ::us/uuid)
-(s/def ::style valid-style)
-(s/def ::team-id ::us/uuid)
-(s/def ::team-id ::us/uuid)
-(s/def ::weight valid-weight)
-
-;; --- QUERY: Get font variants
-
-(s/def ::get-font-variants
-  (s/and
-   (s/keys :req [::rpc/profile-id]
-           :opt-un [::team-id
-                    ::file-id
-                    ::project-id])
-   (fn [o]
-     (or (contains? o :team-id)
-         (contains? o :file-id)
-         (contains? o :project-id)))))
-
-(sv/defmethod ::get-font-variants
-  {::doc/added "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id project-id] :as params}]
-  (with-open [conn (db/open pool)]
-    (cond
-      (uuid? team-id)
-      (do
-        (teams/check-read-permissions! conn profile-id team-id)
-        (db/query conn :team-font-variant
-                  {:team-id team-id
-                   :deleted-at nil}))
-
-      (uuid? project-id)
-      (let [project (db/get-by-id conn :project project-id {:columns [:id :team-id]})]
-        (projects/check-read-permissions! conn profile-id project-id)
-        (db/query conn :team-font-variant
-                  {:team-id (:team-id project)
-                   :deleted-at nil}))
-
-      (uuid? file-id)
-      (let [file    (db/get-by-id conn :file file-id {:columns [:id :project-id]})
-            project (db/get-by-id conn :project (:project-id file) {:columns [:id :team-id]})]
-        (files/check-read-permissions! conn profile-id file-id)
-        (db/query conn :team-font-variant
-                  {:team-id (:team-id project)
-                   :deleted-at nil})))))
-
-
-(declare create-font-variant)
-
-(s/def ::create-font-variant
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id
-                   ::data
-                   ::font-id
-                   ::font-family
-                   ::font-weight
-                   ::font-style]))
-
-(sv/defmethod ::create-font-variant
-  {::doc/added "1.18"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
-  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
-    (teams/check-edition-permissions! pool profile-id team-id)
-    (quotes/check-quote! pool {::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
-  [{:keys [::sto/storage ::db/pool ::wrk/executor ::rpc/climit]} {:keys [data] :as params}]
-  (letfn [(generate-fonts [data]
-            (climit/with-dispatch (:process-font climit)
-              (media/run {:cmd :generate-fonts :input data})))
-
-          ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data.
-          (calculate-hash [data]
-            (px/with-dispatch executor
-              (sto/calculate-hash data)))
-
-          (validate-data [data]
-            (when (and (not (contains? data "font/otf"))
-                       (not (contains? data "font/ttf"))
-                       (not (contains? data "font/woff"))
-                       (not (contains? data "font/woff2")))
-              (ex/raise :type :validation
-                        :code :invalid-font-upload))
-            data)
-
-          (persist-font-object [data mtype]
-            (when-let [resource (get data mtype)]
-              (p/let [hash    (calculate-hash resource)
-                      content (-> (sto/content resource)
-                                  (sto/wrap-with-hash hash))]
-                (sto/put-object! storage {::sto/content content
-                                          ::sto/touched-at (dt/now)
-                                          ::sto/deduplicate? true
-                                          :content-type mtype
-                                          :bucket "team-font-variant"}))))
-
-          (persist-fonts [data]
-            (p/let [otf   (persist-font-object data "font/otf")
-                    ttf   (persist-font-object data "font/ttf")
-                    woff1 (persist-font-object data "font/woff")
-                    woff2 (persist-font-object data "font/woff2")]
-
-              (d/without-nils
-               {:otf otf
-                :ttf ttf
-                :woff1 woff1
-                :woff2 woff2})))
-
-          (insert-into-db [{:keys [woff1 woff2 otf ttf]}]
-            (db/insert! pool :team-font-variant
-                        {:id (uuid/next)
-                         :team-id (:team-id params)
-                         :font-id (:font-id params)
-                         :font-family (:font-family params)
-                         :font-weight (:font-weight params)
-                         :font-style (:font-style params)
-                         :woff1-file-id (:id woff1)
-                         :woff2-file-id (:id woff2)
-                         :otf-file-id (:id otf)
-                         :ttf-file-id (:id ttf)}))
-          ]
-
-    (->> (generate-fonts data)
-         (p/fmap validate-data)
-         (p/mcat executor persist-fonts)
-         (p/fmap executor insert-into-db)
-         (p/fmap (fn [result]
-                   (let [params (update params :data (comp vec keys))]
-                     (rph/with-meta result {::audit/replace-props params})))))))
-
-;; --- UPDATE FONT FAMILY
-
-(s/def ::update-font
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::id ::name]))
-
-(sv/defmethod ::update-font
-  {::doc/added "1.18"
-   ::webhooks/event? true}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id team-id id name]}]
-  (db/with-atomic [conn pool]
-    (teams/check-edition-permissions! conn profile-id team-id)
-    (rph/with-meta
-      (db/update! conn :team-font-variant
-                  {:font-family name}
-                  {:font-id id
-                   :team-id team-id})
-      {::audit/replace-props {:id id
-                              :name name
-                              :team-id team-id
-                              :profile-id profile-id}})))
-
-;; --- DELETE FONT
-
-(s/def ::delete-font
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::id]))
-
-(sv/defmethod ::delete-font
-  {::doc/added "1.18"
-   ::webhooks/event? true}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id id team-id]}]
-  (db/with-atomic [conn pool]
-    (teams/check-edition-permissions! conn profile-id team-id)
-    (let [font (db/update! conn :team-font-variant
-                           {:deleted-at (dt/now)}
-                           {:font-id id :team-id team-id})]
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:id id
-                        :team-id team-id
-                        :name (:font-family font)
-                        :profile-id profile-id}}))))
-
-;; --- DELETE FONT VARIANT
-
-(s/def ::delete-font-variant
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::id]))
-
-(sv/defmethod ::delete-font-variant
-  {::doc/added "1.18"
-   ::webhooks/event? true}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id id team-id]}]
-  (db/with-atomic [conn pool]
-    (teams/check-edition-permissions! conn profile-id team-id)
-    (let [variant (db/update! conn :team-font-variant
-                              {:deleted-at (dt/now)}
-                              {:id id :team-id team-id})]
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:font-family (:font-family variant)
-                        :font-id (:font-id variant)}}))))
-

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

@@ -12,13 +12,10 @@
    [app.db :as db]
    [app.http.session :as session]
    [app.loggers.audit :as-alias audit]
-   [app.main :as-alias main]
-   [app.rpc :as-alias rpc]
-   [app.rpc.commands.auth :as auth]
-   [app.rpc.commands.profile :as profile]
+   [app.rpc.commands.auth :as cmd.auth]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
-   [app.tokens :as tokens]
+   [app.rpc.queries.profile :as profile]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
@@ -37,15 +34,15 @@
 (sv/defmethod ::login-with-ldap
   "Performs the authentication using LDAP backend. Only works if LDAP
   is properly configured and enabled with `login-with-ldap` flag."
-  {::rpc/auth false
+  {:auth false
    ::doc/added "1.15"}
-  [{:keys [::main/props ::ldap/provider] :as cfg} params]
-  (when-not provider
+  [{:keys [session tokens ldap] :as cfg} params]
+  (when-not ldap
     (ex/raise :type :restriction
               :code :ldap-not-initialized
               :hide "ldap auth provider is not initialized"))
 
-  (let [info (ldap/authenticate provider params)]
+  (let [info (ldap/authenticate ldap params)]
     (when-not info
       (ex/raise :type :validation
                 :code :wrong-credentials))
@@ -61,29 +58,31 @@
         ;; user comes from team-invitation process; in this case,
         ;; regenerate token and send back to the user a new invitation
         ;; token (and mark current session as logged).
-        (let [claims (tokens/verify props {:token token :iss :team-invitation})
+        (let [claims (tokens :verify {:token token :iss :team-invitation})
               claims (assoc claims
                             :member-id  (:id profile)
                             :member-email (:email profile))
-              token  (tokens/generate props claims)]
+              token  (tokens :generate claims)]
+
           (-> {:invitation-token token}
-              (rph/with-transform (session/create-fn cfg (:id profile)))
+              (rph/with-transform (session/create-fn session (:id profile)))
               (rph/with-meta {::audit/props (:props profile)
                               ::audit/profile-id (:id profile)})))
 
         (-> profile
-            (rph/with-transform (session/create-fn cfg (:id profile)))
+            (rph/with-transform (session/create-fn session (:id profile)))
             (rph/with-meta {::audit/props (:props profile)
                             ::audit/profile-id (:id profile)}))))))
 
 (defn- login-or-register
-  [{:keys [::db/pool] :as cfg} info]
+  [{:keys [pool] :as cfg} info]
   (db/with-atomic [conn pool]
     (or (some->> (:email info)
-                 (profile/get-profile-by-email conn)
-                 (profile/decode-row))
+                 (profile/retrieve-profile-data-by-email conn)
+                 (profile/populate-additional-data conn)
+                 (profile/decode-profile-row))
         (->> (assoc info :is-active true :is-demo false)
-             (auth/create-profile! conn)
-             (auth/create-profile-rels! conn)
+             (cmd.auth/create-profile conn)
+             (cmd.auth/create-profile-relations conn)
              (profile/strip-private-attrs)))))
 

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

@@ -13,13 +13,12 @@
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.db :as db]
-   [app.loggers.webhooks :as-alias webhooks]
-   [app.rpc :as-alias rpc]
    [app.rpc.commands.binfile :as binfile]
    [app.rpc.commands.files :as files]
-   [app.rpc.commands.projects :as proj]
-   [app.rpc.commands.teams :as teams :refer [create-project-role create-project]]
    [app.rpc.doc :as-alias doc]
+   [app.rpc.mutations.projects :refer [create-project-role create-project]]
+   [app.rpc.queries.projects :as proj]
+   [app.rpc.queries.teams :as teams]
    [app.util.blob :as blob]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
@@ -32,23 +31,22 @@
 (declare duplicate-file)
 
 (s/def ::id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
 (s/def ::project-id ::us/uuid)
 (s/def ::file-id ::us/uuid)
 (s/def ::team-id ::us/uuid)
 (s/def ::name ::us/string)
 
 (s/def ::duplicate-file
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id]
+  (s/keys :req-un [::profile-id ::file-id]
           :opt-un [::name]))
 
 (sv/defmethod ::duplicate-file
   "Duplicate a single file in the same team."
-  {::doc/added "1.16"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (duplicate-file conn (assoc params :profile-id profile-id))))
+    (duplicate-file conn params)))
 
 (defn- remap-id
   [item index key]
@@ -136,7 +134,7 @@
       and so.deleted_at is null")
 
 (defn duplicate-file*
-  [conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag]}]
+  [conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag] :as opts}]
   (let [flibs    (or flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)]))
         fmeds    (or fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)]))
 
@@ -213,17 +211,15 @@
 (declare duplicate-project)
 
 (s/def ::duplicate-project
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::project-id]
+  (s/keys :req-un [::profile-id ::project-id]
           :opt-un [::name]))
 
 (sv/defmethod ::duplicate-project
   "Duplicate an entire project with all the files"
-  {::doc/added "1.16"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} params]
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (duplicate-project conn (assoc params :profile-id (::rpc/profile-id params)))))
+    (duplicate-project conn params)))
 
 (defn duplicate-project
   [conn {:keys [profile-id project-id name] :as params}]
@@ -251,7 +247,9 @@
     ;; create the duplicated project and assign the current profile as
     ;; a project owner
     (create-project conn project)
-    (create-project-role conn profile-id (:id project) :owner)
+    (create-project-role conn {:project-id (:id project)
+                               :profile-id profile-id
+                               :role :owner})
 
     ;; duplicate all files
     (let [index  (reduce #(assoc %1 (:id %2) (uuid/next)) {} files)
@@ -322,16 +320,15 @@
 
 (s/def ::ids (s/every ::us/uuid :kind set?))
 (s/def ::move-files
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::ids ::project-id]))
+  (s/keys :req-un [::profile-id ::ids ::project-id]))
 
 (sv/defmethod ::move-files
   "Move a set of files from one project to other."
-  {::doc/added "1.16"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (move-files conn (assoc params :profile-id profile-id))))
+    (move-files conn params)))
+
 
 ;; --- COMMAND: Move project
 
@@ -362,16 +359,14 @@
 
 
 (s/def ::move-project
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::project-id]))
+  (s/keys :req-un [::profile-id ::team-id ::project-id]))
 
 (sv/defmethod ::move-project
   "Move projects between teams."
-  {::doc/added "1.16"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (move-project conn (assoc params :profile-id profile-id))))
+    (move-project conn params)))
 
 ;; --- COMMAND: Clone Template
 
@@ -379,17 +374,15 @@
 
 (s/def ::template-id ::us/not-empty-string)
 (s/def ::clone-template
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::project-id ::template-id]))
+  (s/keys :req-un [::profile-id ::project-id ::template-id]))
 
 (sv/defmethod ::clone-template
   "Clone into the specified project the template by its id."
-  {::doc/added "1.16"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
     (-> (assoc cfg :conn conn)
-        (clone-template (assoc params :profile-id profile-id)))))
+        (clone-template params))))
 
 (defn- clone-template
   [{:keys [conn templates] :as cfg} {:keys [profile-id template-id project-id]}]

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

@@ -1,275 +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.media
-  (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.media :as cm]
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.http.client :as http]
-   [app.media :as media]
-   [app.rpc :as-alias rpc]
-   [app.rpc.climit :as climit]
-   [app.rpc.commands.files :as files]
-   [app.rpc.doc :as-alias doc]
-   [app.storage :as sto]
-   [app.storage.tmp :as tmp]
-   [app.util.services :as sv]
-   [app.util.time :as dt]
-   [app.worker :as-alias wrk]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
-   [datoteka.io :as io]
-   [promesa.core :as p]
-   [promesa.exec :as px]))
-
-(def default-max-file-size
-  (* 1024 1024 10)) ; 10 MiB
-
-(def thumbnail-options
-  {:width 100
-   :height 100
-   :quality 85
-   :format :jpeg})
-
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/string)
-(s/def ::file-id ::us/uuid)
-(s/def ::team-id ::us/uuid)
-
-(defn validate-content-size!
-  [content]
-  (when (> (:size content) (cf/get :media-max-file-size default-max-file-size))
-    (ex/raise :type :restriction
-              :code :media-max-file-size-reached
-              :hint (str/ffmt "the uploaded file size % is greater than the maximum %"
-                              (:size content)
-                              default-max-file-size))))
-
-;; --- Create File Media object (upload)
-
-(declare create-file-media-object)
-
-(s/def ::content ::media/upload)
-(s/def ::is-local ::us/boolean)
-
-(s/def ::upload-file-media-object
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::is-local ::name ::content]
-          :opt-un [::id]))
-
-(sv/defmethod ::upload-file-media-object
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
-  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
-    (files/check-edition-permissions! pool profile-id file-id)
-    (media/validate-media-type! content)
-    (validate-content-size! content)
-
-    (create-file-media-object cfg params)))
-
-(defn- big-enough-for-thumbnail?
-  "Checks if the provided image info is big enough for
-  create a separate thumbnail storage object."
-  [info]
-  (or (> (:width info) (:width thumbnail-options))
-      (> (:height info) (:height thumbnail-options))))
-
-(defn- svg-image?
-  [info]
-  (= (:mtype info) "image/svg+xml"))
-
-;; NOTE: we use the `on conflict do update` instead of `do nothing`
-;; because postgresql does not returns anything if no update is
-;; performed, the `do update` does the trick.
-
-(def sql:create-file-media-object
-  "insert into file_media_object (id, file_id, is_local, name, media_id, thumbnail_id, width, height, mtype)
-   values (?, ?, ?, ?, ?, ?, ?, ?, ?)
-       on conflict (id) do update set created_at=file_media_object.created_at
-       returning *")
-
-;; NOTE: the following function executes without a transaction, this
-;; means that if something fails in the middle of this function, it
-;; will probably leave leaked/unreferenced objects in the database and
-;; probably in the storage layer. For handle possible object leakage,
-;; we create all media objects marked as touched, this ensures that if
-;; something fails, all leaked (already created storage objects) will
-;; be eventually marked as deleted by the touched-gc task.
-;;
-;; The touched-gc task, performs periodic analysis of all touched
-;; storage objects and check references of it. This is the reason why
-;; `reference` metadata exists: it indicates the name of the table
-;; witch holds the reference to storage object (it some kind of
-;; inverse, soft referential integrity).
-
-(defn create-file-media-object
-  [{:keys [::sto/storage ::db/pool climit ::wrk/executor]}
-   {:keys [id file-id is-local name content]}]
-  (letfn [;; Function responsible to retrieve the file information, as
-          ;; it is synchronous operation it should be wrapped into
-          ;; with-dispatch macro.
-          (get-info [content]
-            (climit/with-dispatch (:process-image climit)
-              (media/run {:cmd :info :input content})))
-
-          ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data.
-          (calculate-hash [data]
-            (px/with-dispatch executor
-              (sto/calculate-hash data)))
-
-          ;; Function responsible of generating thumnail. As it is synchronous
-          ;; opetation, it should be wrapped into with-dispatch macro
-          (generate-thumbnail [info]
-            (climit/with-dispatch (:process-image climit)
-              (media/run (assoc thumbnail-options
-                                :cmd :generic-thumbnail
-                                :input info))))
-
-          (create-thumbnail [info]
-            (when (and (not (svg-image? info))
-                       (big-enough-for-thumbnail? info))
-              (p/let [thumb   (generate-thumbnail info)
-                      hash    (calculate-hash (:data thumb))
-                      content (-> (sto/content (:data thumb) (:size thumb))
-                                  (sto/wrap-with-hash hash))]
-                (sto/put-object! storage
-                                 {::sto/content content
-                                  ::sto/deduplicate? true
-                                  ::sto/touched-at (dt/now)
-                                  :content-type (:mtype thumb)
-                                  :bucket "file-media-object"}))))
-
-          (create-image [info]
-            (p/let [data    (:path info)
-                    hash    (calculate-hash data)
-                    content (-> (sto/content data)
-                                (sto/wrap-with-hash hash))]
-              (sto/put-object! storage
-                               {::sto/content content
-                                ::sto/deduplicate? true
-                                ::sto/touched-at (dt/now)
-                                :content-type (:mtype info)
-                                :bucket "file-media-object"})))
-
-          (insert-into-database [info image thumb]
-            (px/with-dispatch executor
-              (db/exec-one! pool [sql:create-file-media-object
-                                  (or id (uuid/next))
-                                  file-id is-local name
-                                  (:id image)
-                                  (:id thumb)
-                                  (:width info)
-                                  (:height info)
-                                  (:mtype info)])))]
-
-    (p/let [info  (get-info content)
-            thumb (create-thumbnail info)
-            image (create-image info)]
-      (insert-into-database info image thumb))))
-
-;; --- Create File Media Object (from URL)
-
-(declare ^:private create-file-media-object-from-url)
-
-(s/def ::create-file-media-object-from-url
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::is-local ::url]
-          :opt-un [::id ::name]))
-
-(sv/defmethod ::create-file-media-object-from-url
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
-  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
-    (files/check-edition-permissions! pool profile-id file-id)
-    (create-file-media-object-from-url cfg params)))
-
-(defn- create-file-media-object-from-url
-  [cfg {:keys [url name] :as params}]
-  (letfn [(parse-and-validate-size [headers]
-            (let [size     (some-> (get headers "content-length") d/parse-integer)
-                  mtype    (get headers "content-type")
-                  format   (cm/mtype->format mtype)
-                  max-size (cf/get :media-max-file-size default-max-file-size)]
-
-              (when-not size
-                (ex/raise :type :validation
-                          :code :unknown-size
-                          :hint "seems like the url points to resource with unknown size"))
-
-              (when (> size max-size)
-                (ex/raise :type :validation
-                          :code :file-too-large
-                          :hint (str/ffmt "the file size % is greater than the maximum %"
-                                          size
-                                          default-max-file-size)))
-
-              (when (nil? format)
-                (ex/raise :type :validation
-                          :code :media-type-not-allowed
-                          :hint "seems like the url points to an invalid media object"))
-
-              {:size size
-               :mtype mtype
-               :format format}))
-
-          (download-media [uri]
-            (-> (http/req! cfg {:method :get :uri uri} {:response-type :input-stream})
-                (p/then process-response)))
-
-          (process-response [{:keys [body headers] :as response}]
-            (let [{:keys [size mtype]} (parse-and-validate-size headers)
-                  path                 (tmp/tempfile :prefix "penpot.media.download.")
-                  written              (io/write-to-file! body path :size size)]
-
-              (when (not= written size)
-                (ex/raise :type :internal
-                          :code :mismatch-write-size
-                          :hint "unexpected state: unable to write to file"))
-
-              {:filename "tempfile"
-               :size size
-               :path path
-               :mtype mtype}))]
-
-    (p/let [content (download-media url)]
-      (->> (merge params {:content content :name (or name (:filename content))})
-           (create-file-media-object cfg)))))
-
-;; --- Clone File Media object (Upload and create from url)
-
-(declare clone-file-media-object)
-
-(s/def ::clone-file-media-object
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file-id ::is-local ::id]))
-
-(sv/defmethod ::clone-file-media-object
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (files/check-edition-permissions! conn profile-id file-id)
-    (-> (assoc cfg :conn conn)
-        (clone-file-media-object params))))
-
-(defn clone-file-media-object
-  [{:keys [conn]} {:keys [id file-id is-local]}]
-  (let [mobj (db/get-by-id conn :file-media-object id)]
-    (db/insert! conn :file-media-object
-                {:id (uuid/next)
-                 :file-id file-id
-                 :is-local is-local
-                 :name (:name mobj)
-                 :media-id (:media-id mobj)
-                 :thumbnail-id (:thumbnail-id mobj)
-                 :width  (:width mobj)
-                 :height (:height mobj)
-                 :mtype  (:mtype mobj)})))

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

@@ -1,424 +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.profile
-  (:require
-   [app.auth :as auth]
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.emails :as eml]
-   [app.http.session :as session]
-   [app.loggers.audit :as audit]
-   [app.main :as-alias main]
-   [app.media :as media]
-   [app.rpc :as-alias rpc]
-   [app.rpc.climit :as climit]
-   [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
-   [app.storage :as sto]
-   [app.tokens :as tokens]
-   [app.util.services :as sv]
-   [app.util.time :as dt]
-   [app.worker :as-alias wrk]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
-   [promesa.core :as p]
-   [promesa.exec :as px]))
-
-(declare decode-row)
-(declare get-profile)
-(declare strip-private-attrs)
-(declare filter-props)
-(declare check-profile-existence!)
-
-;; --- QUERY: Get profile (own)
-
-(s/def ::get-profile
-  (s/keys :opt [::rpc/profile-id]))
-
-(sv/defmethod ::get-profile
-  {::rpc/auth false
-   ::doc/added "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id]}]
-  ;; We need to return the anonymous profile object in two cases, when
-  ;; no profile-id is in session, and when db call raises not found. In all other
-  ;; cases we need to reraise the exception.
-  (try
-    (-> (get-profile pool profile-id)
-        (strip-private-attrs)
-        (update :props filter-props))
-    (catch Throwable _
-      {:id uuid/zero :fullname "Anonymous User"})))
-
-(defn get-profile
-  "Get profile by id. Throws not-found exception if no profile found."
-  [conn id & {:as attrs}]
-  (-> (db/get-by-id conn :profile id attrs)
-      (decode-row)))
-
-
-;; --- MUTATION: Update Profile (own)
-
-(s/def ::email ::us/email)
-(s/def ::fullname ::us/not-empty-string)
-(s/def ::lang ::us/string)
-(s/def ::theme ::us/string)
-
-(s/def ::update-profile
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::fullname]
-          :opt-un [::lang ::theme]))
-
-(sv/defmethod ::update-profile
-  {::doc/added "1.0"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id fullname lang theme] :as params}]
-  (db/with-atomic [conn pool]
-    ;; NOTE: we need to retrieve the profile independently if we use
-    ;; it or not for explicit locking and avoid concurrent updates of
-    ;; the same row/object.
-    (let [profile (-> (db/get-by-id conn :profile profile-id ::db/for-update? true)
-                      (decode-row))
-
-          ;; Update the profile map with direct params
-          profile (-> profile
-                      (assoc :fullname fullname)
-                      (assoc :lang lang)
-                      (assoc :theme theme))
-          ]
-
-      (db/update! conn :profile
-                  {:fullname fullname
-                   :lang lang
-                   :theme theme
-                   :props (db/tjson (:props profile))}
-                  {:id profile-id})
-
-      (-> profile
-          (strip-private-attrs)
-          (d/without-nils)
-          (rph/with-meta {::audit/props (audit/profile->props profile)})))))
-
-
-;; --- MUTATION: Update Password
-
-(declare validate-password!)
-(declare update-profile-password!)
-(declare invalidate-profile-session!)
-
-(s/def ::password ::us/not-empty-string)
-(s/def ::old-password ::us/not-empty-string)
-
-(s/def ::update-profile-password
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::password ::old-password]))
-
-(sv/defmethod ::update-profile-password
-  {::climit/queue :auth}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id password] :as params}]
-  (db/with-atomic [conn pool]
-    (let [profile    (validate-password! conn (assoc params :profile-id profile-id))
-          session-id (::session/id params)]
-
-      (when (= (str/lower (:email profile))
-               (str/lower (:password params)))
-        (ex/raise :type :validation
-                  :code :email-as-password
-                  :hint "you can't use your email as password"))
-
-      (update-profile-password! conn (assoc profile :password password))
-      (invalidate-profile-session! conn profile-id session-id)
-      nil)))
-
-(defn- invalidate-profile-session!
-  "Removes all sessions except the current one."
-  [conn profile-id session-id]
-  (let [sql "delete from http_session where profile_id = ? and id != ?"]
-    (:next.jdbc/update-count (db/exec-one! conn [sql profile-id session-id]))))
-
-(defn- validate-password!
-  [conn {:keys [profile-id old-password] :as params}]
-  (let [profile (db/get-by-id conn :profile profile-id ::db/for-update? true)]
-    (when-not (:valid (auth/verify-password old-password (:password profile)))
-      (ex/raise :type :validation
-                :code :old-password-not-match))
-    profile))
-
-(defn update-profile-password!
-  [conn {:keys [id password] :as profile}]
-  (db/update! conn :profile
-              {:password (auth/derive-password password)}
-              {:id id}))
-
-;; --- MUTATION: Update Photo
-
-(declare upload-photo)
-(declare update-profile-photo)
-
-(s/def ::file ::media/upload)
-(s/def ::update-profile-photo
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::file]))
-
-(sv/defmethod ::update-profile-photo
-  [cfg {:keys [::rpc/profile-id file] :as params}]
-  ;; Validate incoming mime type
-  (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
-  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
-    (update-profile-photo cfg (assoc params :profile-id profile-id))))
-
-;; TODO: reimplement it without p/let
-
-(defn update-profile-photo
-  [{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id file] :as params}]
-  (letfn [(on-uploaded [photo]
-            (let [profile (db/get-by-id pool :profile profile-id ::db/for-update? true)]
-
-              ;; Schedule deletion of old photo
-              (when-let [id (:photo-id profile)]
-                (sto/touch-object! storage id))
-
-              ;; Save new photo
-              (db/update! pool :profile
-                          {:photo-id (:id photo)}
-                          {:id profile-id})
-
-              (-> (rph/wrap)
-                  (rph/with-meta {::audit/replace-props
-                                  {:file-name (:filename file)
-                                   :file-size (:size file)
-                                   :file-path (str (:path file))
-                                   :file-mtype (:mtype file)}}))))]
-    (->> (upload-photo cfg params)
-         (p/fmap executor on-uploaded))))
-
-(defn upload-photo
-  [{:keys [::sto/storage ::wrk/executor climit] :as cfg} {:keys [file]}]
-  (letfn [(get-info [content]
-            (climit/with-dispatch (:process-image climit)
-              (media/run {:cmd :info :input content})))
-
-          (generate-thumbnail [info]
-            (climit/with-dispatch (:process-image climit)
-              (media/run {:cmd :profile-thumbnail
-                          :format :jpeg
-                          :quality 85
-                          :width 256
-                          :height 256
-                          :input info})))
-
-          ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data.
-          (calculate-hash [data]
-            (px/with-dispatch executor
-              (sto/calculate-hash data)))]
-
-    (p/let [info    (get-info file)
-            thumb   (generate-thumbnail info)
-            hash    (calculate-hash (:data thumb))
-            content (-> (sto/content (:data thumb) (:size thumb))
-                        (sto/wrap-with-hash hash))]
-      (sto/put-object! storage {::sto/content content
-                                ::sto/deduplicate? true
-                                :bucket "profile"
-                                :content-type (:mtype thumb)}))))
-
-
-;; --- MUTATION: Request Email Change
-
-(declare ^:private request-email-change!)
-(declare ^:private change-email-immediately!)
-
-(s/def ::request-email-change
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::email]))
-
-(sv/defmethod ::request-email-change
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id email] :as params}]
-  (db/with-atomic [conn pool]
-    (let [profile (db/get-by-id conn :profile profile-id)
-          cfg     (assoc cfg ::conn conn)
-          params  (assoc params
-                         :profile profile
-                         :email (str/lower email))]
-      (if (contains? cf/flags :smtp)
-        (request-email-change! cfg params)
-        (change-email-immediately! cfg params)))))
-
-(defn- change-email-immediately!
-  [{:keys [::conn]} {:keys [profile email] :as params}]
-  (when (not= email (:email profile))
-    (check-profile-existence! conn params))
-
-  (db/update! conn :profile
-              {:email email}
-              {:id (:id profile)})
-
-  {:changed true})
-
-(defn- request-email-change!
-  [{:keys [::conn] :as cfg} {:keys [profile email] :as params}]
-  (let [token   (tokens/generate (::main/props cfg)
-                                 {:iss :change-email
-                                  :exp (dt/in-future "15m")
-                                  :profile-id (:id profile)
-                                  :email email})
-        ptoken  (tokens/generate (::main/props cfg)
-                                 {:iss :profile-identity
-                                  :profile-id (:id profile)
-                                  :exp (dt/in-future {:days 30})})]
-
-    (when (not= email (:email profile))
-      (check-profile-existence! conn params))
-
-    (when-not (eml/allow-send-emails? conn profile)
-      (ex/raise :type :validation
-                :code :profile-is-muted
-                :hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
-
-    (when (eml/has-bounce-reports? conn email)
-      (ex/raise :type :validation
-                :code :email-has-permanent-bounces
-                :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
-
-    (eml/send! {::eml/conn conn
-                ::eml/factory eml/change-email
-                :public-uri (cf/get :public-uri)
-                :to (:email profile)
-                :name (:fullname profile)
-                :pending-email email
-                :token token
-                :extra-data ptoken})
-    nil))
-
-
-;; --- MUTATION: Update Profile Props
-
-(s/def ::props map?)
-(s/def ::update-profile-props
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::props]))
-
-(sv/defmethod ::update-profile-props
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id props]}]
-  (db/with-atomic [conn pool]
-    (let [profile (get-profile conn profile-id ::db/for-update? true)
-          props   (reduce-kv (fn [props k v]
-                               ;; We don't accept namespaced keys
-                               (if (simple-ident? k)
-                                 (if (nil? v)
-                                   (dissoc props k)
-                                   (assoc props k v))
-                                 props))
-                             (:props profile)
-                             props)]
-
-      (db/update! conn :profile
-                  {:props (db/tjson props)}
-                  {:id profile-id})
-
-      (filter-props props))))
-
-
-;; --- MUTATION: Delete Profile
-
-(declare ^:private get-owned-teams-with-participants)
-
-(s/def ::delete-profile
-  (s/keys :req [::rpc/profile-id]))
-
-(sv/defmethod ::delete-profile
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [teams      (get-owned-teams-with-participants conn profile-id)
-          deleted-at (dt/now)]
-
-      ;; If we found owned teams with participants, we don't allow
-      ;; delete profile until the user properly transfer ownership or
-      ;; explicitly removes all participants from the team
-      (when (some pos? (map :participants teams))
-        (ex/raise :type :validation
-                  :code :owner-teams-with-people
-                  :hint "The user need to transfer ownership of owned teams."
-                  :context {:teams (mapv :id teams)}))
-
-      (doseq [{:keys [id]} teams]
-        (db/update! conn :team
-                    {:deleted-at deleted-at}
-                    {:id id}))
-
-      (db/update! conn :profile
-                  {:deleted-at deleted-at}
-                  {:id profile-id})
-
-      (rph/with-transform {} (session/delete-fn cfg)))))
-
-
-;; --- HELPERS
-
-(def sql:owned-teams
-  "with owner_teams as (
-      select tpr.team_id as id
-        from team_profile_rel as tpr
-       where tpr.is_owner is true
-         and tpr.profile_id = ?
-   )
-   select tpr.team_id as id,
-          count(tpr.profile_id) - 1 as participants
-     from team_profile_rel as tpr
-    where tpr.team_id in (select id from owner_teams)
-      and tpr.profile_id != ?
-    group by 1")
-
-(defn- get-owned-teams-with-participants
-  [conn profile-id]
-  (db/exec! conn [sql:owned-teams profile-id profile-id]))
-
-(def ^:private sql:profile-existence
-  "select exists (select * from profile
-                   where email = ?
-                     and deleted_at is null) as val")
-
-(defn check-profile-existence!
-  [conn {:keys [email] :as params}]
-  (let [email  (str/lower email)
-        result (db/exec-one! conn [sql:profile-existence email])]
-    (when (:val result)
-      (ex/raise :type :validation
-                :code :email-already-exists))
-    params))
-
-(def ^:private sql:profile-by-email
-  "select p.* from profile as p
-    where p.email = ?
-      and (p.deleted_at is null or
-           p.deleted_at > now())")
-
-(defn get-profile-by-email
-  "Returns a profile looked up by email or `nil` if not match found."
-  [conn email]
-  (->> (db/exec! conn [sql:profile-by-email (str/lower email)])
-       (map decode-row)
-       (first)))
-
-(defn strip-private-attrs
-  "Only selects a publicly visible profile attrs."
-  [row]
-  (dissoc row :password :deleted-at))
-
-(defn filter-props
-  "Removes all namespace qualified props from `props` attr."
-  [props]
-  (into {} (filter (fn [[k _]] (simple-ident? k))) props))
-
-(defn decode-row
-  [{:keys [props] :as row}]
-  (cond-> row
-    (db/pgobject? props "jsonb")
-    (assoc :props (db/decode-transit-pgobject props))))

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

@@ -1,268 +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.projects
-  (:require
-   [app.common.spec :as us]
-   [app.db :as db]
-   [app.loggers.audit :as-alias audit]
-   [app.loggers.webhooks :as webhooks]
-   [app.rpc :as-alias rpc]
-   [app.rpc.commands.teams :as teams]
-   [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
-   [app.rpc.permissions :as perms]
-   [app.rpc.quotes :as quotes]
-   [app.util.services :as sv]
-   [app.util.time :as dt]
-   [clojure.spec.alpha :as s]))
-
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/string)
-
-;; --- Check Project Permissions
-
-(def ^:private sql:project-permissions
-  "select tpr.is_owner,
-          tpr.is_admin,
-          tpr.can_edit
-     from team_profile_rel as tpr
-    inner join project as p on (p.team_id = tpr.team_id)
-    where p.id = ?
-      and tpr.profile_id = ?
-   union all
-   select ppr.is_owner,
-          ppr.is_admin,
-          ppr.can_edit
-     from project_profile_rel as ppr
-    where ppr.project_id = ?
-      and ppr.profile_id = ?")
-
-(defn- get-permissions
-  [conn profile-id project-id]
-  (let [rows     (db/exec! conn [sql:project-permissions
-                                 project-id profile-id
-                                 project-id profile-id])
-        is-owner (boolean (some :is-owner rows))
-        is-admin (boolean (some :is-admin rows))
-        can-edit (boolean (some :can-edit rows))]
-     (when (seq rows)
-       {:is-owner is-owner
-        :is-admin (or is-owner is-admin)
-        :can-edit (or is-owner is-admin can-edit)
-        :can-read true})))
-
-(def has-edit-permissions?
-  (perms/make-edition-predicate-fn get-permissions))
-
-(def has-read-permissions?
-  (perms/make-read-predicate-fn get-permissions))
-
-(def check-edition-permissions!
-  (perms/make-check-fn has-edit-permissions?))
-
-(def check-read-permissions!
-  (perms/make-check-fn has-read-permissions?))
-
-;; --- QUERY: Get projects
-
-(declare get-projects)
-
-(s/def ::team-id ::us/uuid)
-(s/def ::get-projects
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]))
-
-(sv/defmethod ::get-projects
-  {::doc/added "1.18"}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id team-id]}]
-  (with-open [conn (db/open pool)]
-    (teams/check-read-permissions! conn profile-id team-id)
-    (get-projects conn profile-id team-id)))
-
-(def sql:projects
-  "select p.*,
-          coalesce(tpp.is_pinned, false) as is_pinned,
-          (select count(*) from file as f
-            where f.project_id = p.id
-              and deleted_at is null) as count
-     from project as p
-    inner join team as t on (t.id = p.team_id)
-     left join team_project_profile_rel as tpp
-            on (tpp.project_id = p.id and
-                tpp.team_id = p.team_id and
-                tpp.profile_id = ?)
-    where p.team_id = ?
-      and p.deleted_at is null
-      and t.deleted_at is null
-    order by p.modified_at desc")
-
-(defn get-projects
-  [conn profile-id team-id]
-  (db/exec! conn [sql:projects profile-id team-id]))
-
-;; --- QUERY: Get all projects
-
-(declare get-all-projects)
-
-(s/def ::get-all-projects
-  (s/keys :req [::rpc/profile-id]))
-
-(sv/defmethod ::get-all-projects
-  {::doc/added "1.18"}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id]}]
-  (with-open [conn (db/open pool)]
-    (get-all-projects conn profile-id)))
-
-(def sql:all-projects
-  "select p1.*, t.name as team_name, t.is_default as is_default_team
-     from project as p1
-    inner join team as t on (t.id = p1.team_id)
-    where t.id in (select team_id
-                     from team_profile_rel as tpr
-                    where tpr.profile_id = ?
-                      and (tpr.can_edit = true or
-                           tpr.is_owner = true or
-                           tpr.is_admin = true))
-      and t.deleted_at is null
-      and p1.deleted_at is null
-   union
-   select p2.*, t.name as team_name, t.is_default as is_default_team
-     from project as p2
-    inner join team as t on (t.id = p2.team_id)
-    where p2.id in (select project_id
-                     from project_profile_rel as ppr
-                    where ppr.profile_id = ?
-                      and (ppr.can_edit = true or
-                           ppr.is_owner = true or
-                           ppr.is_admin = true))
-      and t.deleted_at is null
-      and p2.deleted_at is null
-    order by team_name, name;")
-
-(defn get-all-projects
-  [conn profile-id]
-  (db/exec! conn [sql:all-projects profile-id profile-id]))
-
-
-;; --- QUERY: Get project
-
-(s/def ::get-project
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]))
-
-(sv/defmethod ::get-project
-  {::doc/added "1.18"}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id id]}]
-  (with-open [conn (db/open pool)]
-    (let [project (db/get-by-id conn :project id)]
-      (check-read-permissions! conn profile-id id)
-      project)))
-
-
-
-;; --- MUTATION: Create Project
-
-(s/def ::create-project
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::name]
-          :opt-un [::id]))
-
-(sv/defmethod ::create-project
-  {::doc/added "1.18"
-   ::webhooks/event? true}
-  [{: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})
-
-    (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 true})
-      (assoc project :is-pinned true))))
-
-
-;; --- MUTATION: Toggle Project Pin
-
-(def ^:private
-  sql:update-project-pin
-  "insert into team_project_profile_rel (team_id, project_id, profile_id, is_pinned)
-   values (?, ?, ?, ?)
-       on conflict (team_id, project_id, profile_id)
-       do update set is_pinned=?")
-
-(s/def ::is-pinned ::us/boolean)
-(s/def ::project-id ::us/uuid)
-(s/def ::update-project-pin
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id ::team-id ::is-pinned]))
-
-(sv/defmethod ::update-project-pin
-  {::doc/added "1.18"
-   ::webhooks/batch-timeout (dt/duration "5s")
-   ::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
-   ::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-edition-permissions! conn profile-id id)
-    (db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
-    nil))
-
-;; --- MUTATION: Rename Project
-
-(declare rename-project)
-
-(s/def ::rename-project
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::name ::id]))
-
-(sv/defmethod ::rename-project
-  {::doc/added "1.18"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id id)
-    (let [project (db/get-by-id conn :project id ::db/for-update? true)]
-      (db/update! conn :project
-                  {:name name}
-                  {:id id})
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:team-id (:team-id project)
-                        :prev-name (:name project)}}))))
-
-;; --- MUTATION: Delete Project
-
-(s/def ::delete-project
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]))
-
-;; TODO: right now, we just don't allow delete default projects, in a
-;; future we need to ensure raise a correct exception signaling that
-;; this is not allowed.
-
-(sv/defmethod ::delete-project
-  {::doc/added "1.18"
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id id)
-    (let [project (db/update! conn :project
-                              {:deleted-at (dt/now)}
-                              {:id id :is-default false})]
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:team-id (:team-id project)
-                        :name (:name project)
-                        :created-at (:created-at project)
-                        :modified-at (:modified-at project)}}))))
-
-

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

@@ -8,7 +8,6 @@
   (:require
    [app.common.spec :as us]
    [app.db :as db]
-   [app.rpc :as-alias rpc]
    [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
@@ -48,21 +47,22 @@
     order by f.created_at asc")
 
 (defn search-files
-  [conn profile-id team-id search-term]
+  [conn {:keys [profile-id team-id search-term] :as params}]
   (db/exec! conn [sql:search-files
                   profile-id team-id
                   profile-id team-id
                   search-term]))
 
+(s/def ::profile-id ::us/uuid)
 (s/def ::team-id ::us/uuid)
 (s/def ::search-files ::us/string)
 
 (s/def ::search-files
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]
+  (s/keys :req-un [::profile-id ::team-id]
           :opt-un [::search-term]))
 
 (sv/defmethod ::search-files
   {::doc/added "1.17"}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id team-id search-term]}]
-  (some->> search-term (search-files pool profile-id team-id)))
+  [{:keys [pool]} {:keys [search-term] :as params}]
+  (when search-term
+    (search-files pool params)))

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

@@ -1,860 +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
-  (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.logging :as l]
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.emails :as eml]
-   [app.loggers.audit :as audit]
-   [app.main :as-alias main]
-   [app.media :as media]
-   [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.storage :as sto]
-   [app.tokens :as tokens]
-   [app.util.services :as sv]
-   [app.util.time :as dt]
-   [app.worker :as-alias wrk]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
-   [promesa.core :as p]
-   [promesa.exec :as px]))
-
-;; --- Helpers & Specs
-
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/string)
-(s/def ::file-id ::us/uuid)
-(s/def ::team-id ::us/uuid)
-
-(def ^:private sql:team-permissions
-  "select tpr.is_owner,
-          tpr.is_admin,
-          tpr.can_edit
-     from team_profile_rel as tpr
-     join team as t on (t.id = tpr.team_id)
-    where tpr.profile_id = ?
-      and tpr.team_id = ?
-      and t.deleted_at is null")
-
-(defn get-permissions
-  [conn profile-id team-id]
-  (let [rows     (db/exec! conn [sql:team-permissions profile-id team-id])
-        is-owner (boolean (some :is-owner rows))
-        is-admin (boolean (some :is-admin rows))
-        can-edit (boolean (some :can-edit rows))]
-     (when (seq rows)
-       {:is-owner is-owner
-        :is-admin (or is-owner is-admin)
-        :can-edit (or is-owner is-admin can-edit)
-        :can-read true})))
-
-(def has-edit-permissions?
-  (perms/make-edition-predicate-fn get-permissions))
-
-(def has-read-permissions?
-  (perms/make-read-predicate-fn get-permissions))
-
-(def check-edition-permissions!
-  (perms/make-check-fn has-edit-permissions?))
-
-(def check-read-permissions!
-  (perms/make-check-fn has-read-permissions?))
-
-;; --- Query: Teams
-
-(declare retrieve-teams)
-
-(s/def ::get-teams
-  (s/keys :req [::rpc/profile-id]))
-
-(sv/defmethod ::get-teams
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
-  (with-open [conn (db/open pool)]
-    (retrieve-teams conn profile-id)))
-
-(def sql:teams
-  "select t.*,
-          tp.is_owner,
-          tp.is_admin,
-          tp.can_edit,
-          (t.id = ?) as is_default
-     from team_profile_rel as tp
-     join team as t on (t.id = tp.team_id)
-    where t.deleted_at is null
-      and tp.profile_id = ?
-    order by tp.created_at asc")
-
-(defn process-permissions
-  [team]
-  (let [is-owner    (:is-owner team)
-        is-admin    (:is-admin team)
-        can-edit    (:can-edit team)
-        permissions {:type :membership
-                     :is-owner is-owner
-                     :is-admin (or is-owner is-admin)
-                     :can-edit (or is-owner is-admin can-edit)}]
-    (-> team
-        (dissoc :is-owner :is-admin :can-edit)
-        (assoc :permissions permissions))))
-
-(defn retrieve-teams
-  [conn profile-id]
-  (let [profile (profile/get-profile conn profile-id)]
-    (->> (db/exec! conn [sql:teams (:default-team-id profile) profile-id])
-         (mapv process-permissions))))
-
-;; --- Query: Team (by ID)
-
-(declare retrieve-team)
-
-(s/def ::get-team
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]))
-
-(sv/defmethod ::get-team
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id]}]
-  (with-open [conn (db/open pool)]
-    (retrieve-team conn profile-id id)))
-
-(defn retrieve-team
-  [conn profile-id team-id]
-  (let [profile (profile/get-profile conn profile-id)
-        sql     (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?")
-        result  (db/exec-one! conn [sql (:default-team-id profile) profile-id team-id])]
-
-    (when-not result
-      (ex/raise :type :not-found
-                :code :team-does-not-exist))
-
-    (process-permissions result)))
-
-;; --- Query: Team Members
-
-(def sql:team-members
-  "select tp.*,
-          p.id,
-          p.email,
-          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 = ?")
-
-(defn retrieve-team-members
-  [conn team-id]
-  (db/exec! conn [sql:team-members team-id]))
-
-(s/def ::team-id ::us/uuid)
-(s/def ::get-team-members
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]))
-
-(sv/defmethod ::get-team-members
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
-  (with-open [conn (db/open pool)]
-    (check-read-permissions! conn profile-id team-id)
-    (retrieve-team-members conn team-id)))
-
-
-;; --- Query: Team Users
-
-(declare retrieve-users)
-(declare retrieve-team-for-file)
-
-(s/def ::get-team-users
-  (s/and (s/keys :req [::rpc/profile-id]
-                 :opt-un [::team-id ::file-id])
-         #(or (:team-id %) (:file-id %))))
-
-(sv/defmethod ::get-team-users
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id]}]
-  (with-open [conn (db/open pool)]
-    (if team-id
-      (do
-        (check-read-permissions! conn profile-id team-id)
-        (retrieve-users conn team-id))
-      (let [{team-id :id} (retrieve-team-for-file conn file-id)]
-        (check-read-permissions! conn profile-id team-id)
-        (retrieve-users conn team-id)))))
-
-;; This is a similar query to team members but can contain more data
-;; because some user can be explicitly added to project or file (not
-;; implemented in UI)
-
-(def sql:team-users
-  "select pf.id, pf.fullname, pf.photo_id
-     from profile as pf
-    inner join team_profile_rel as tpr on (tpr.profile_id = pf.id)
-    where tpr.team_id = ?
-    union
-   select pf.id, pf.fullname, pf.photo_id
-     from profile as pf
-    inner join project_profile_rel as ppr on (ppr.profile_id = pf.id)
-    inner join project as p on (ppr.project_id = p.id)
-    where p.team_id = ?
-   union
-   select pf.id, pf.fullname, pf.photo_id
-     from profile as pf
-    inner join file_profile_rel as fpr on (fpr.profile_id = pf.id)
-    inner join file as f on (fpr.file_id = f.id)
-    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 retrieve-users
-  [conn team-id]
-  (db/exec! conn [sql:team-users team-id team-id team-id]))
-
-(defn retrieve-team-for-file
-  [conn file-id]
-  (->> [sql:team-by-file file-id]
-       (db/exec-one! conn)))
-
-;; --- Query: Team Stats
-
-(declare retrieve-team-stats)
-
-(s/def ::get-team-stats
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]))
-
-(sv/defmethod ::get-team-stats
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
-  (with-open [conn (db/open pool)]
-    (check-read-permissions! conn profile-id team-id)
-    (retrieve-team-stats conn team-id)))
-
-(def sql:team-stats
-  "select (select count(*) from project where team_id = ?) as projects,
-          (select count(*) from file as f join project as p on (p.id = f.project_id) where p.team_id = ?) as files")
-
-(defn retrieve-team-stats
-  [conn team-id]
-  (db/exec-one! conn [sql:team-stats team-id team-id]))
-
-
-;; --- Query: Team invitations
-
-(s/def ::get-team-invitations
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]))
-
-(def sql:team-invitations
-  "select email_to as email, role, (valid_until < now()) as expired
-   from team_invitation where team_id = ? order by valid_until desc, created_at desc")
-
-(defn get-team-invitations
-  [conn team-id]
-  (->> (db/exec! conn [sql:team-invitations team-id])
-       (mapv #(update % :role keyword))))
-
-(sv/defmethod ::get-team-invitations
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
-  (with-open [conn (db/open pool)]
-    (check-read-permissions! conn profile-id team-id)
-    (get-team-invitations conn team-id)))
-
-;; --- Mutation: Create Team
-
-(declare create-team)
-(declare create-project)
-(declare create-project-role)
-(declare ^:private create-team*)
-(declare ^:private create-team-role)
-(declare ^:private create-team-default-project)
-
-(s/def ::create-team
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::name]
-          :opt-un [::id]))
-
-(sv/defmethod ::create-team
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (quotes/check-quote! conn {::quotes/id ::quotes/teams-per-profile
-                               ::quotes/profile-id profile-id})
-
-    (create-team conn (assoc params :profile-id profile-id))))
-
-(defn create-team
-  "This is a complete team creation process, it creates the team
-  object and all related objects (default role and default project)."
-  [conn params]
-  (let [team    (create-team* conn params)
-        params  (assoc params
-                       :team-id (:id team)
-                       :role :owner)
-        project (create-team-default-project conn params)]
-    (create-team-role conn params)
-    (assoc team :default-project-id (:id project))))
-
-(defn- create-team*
-  [conn {:keys [id name is-default] :as params}]
-  (let [id         (or id (uuid/next))
-        is-default (if (boolean? is-default) is-default false)]
-    (db/insert! conn :team
-                {:id id
-                 :name name
-                 :is-default is-default})))
-
-(defn- create-team-role
-  [conn {:keys [profile-id team-id role] :as params}]
-  (let [params {:team-id team-id
-                :profile-id profile-id}]
-    (->> (perms/assign-role-flags params role)
-         (db/insert! conn :team-profile-rel))))
-
-(defn- create-team-default-project
-  [conn {:keys [profile-id team-id] :as params}]
-  (let [project {:id (uuid/next)
-                 :team-id team-id
-                 :name "Drafts"
-                 :is-default true}
-        project (create-project conn project)]
-    (create-project-role conn profile-id (:id project) :owner)
-    project))
-
-;; NOTE: we have project creation here because there are cyclic
-;; dependency between teams and projects namespaces, and the project
-;; creation happens in both sides, on team creation and on simple
-;; project creation, so it make sense to have this functions in this
-;; namespace too.
-
-(defn create-project
-  [conn {:keys [id team-id name is-default] :as params}]
-  (let [id         (or id (uuid/next))
-        is-default (if (boolean? is-default) is-default false)]
-    (db/insert! conn :project
-                {:id id
-                 :name name
-                 :team-id team-id
-                 :is-default is-default})))
-
-(defn create-project-role
-  [conn profile-id project-id role]
-  (let [params {:project-id project-id
-                :profile-id profile-id}]
-    (->> (perms/assign-role-flags params role)
-         (db/insert! conn :project-profile-rel))))
-
-;; --- Mutation: Update Team
-
-(s/def ::update-team
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::name ::id]))
-
-(sv/defmethod ::update-team
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id id)
-    (db/update! conn :team
-                {:name name}
-                {:id id})
-    nil))
-
-
-;; --- Mutation: Leave Team
-
-(declare role->params)
-
-(defn leave-team
-  [conn {:keys [profile-id id reassign-to]}]
-  (let [perms   (get-permissions conn profile-id id)
-        members (retrieve-team-members conn id)]
-
-    (cond
-      ;; we can only proceed if there are more members in the team
-      ;; besides the current profile
-      (<= (count members) 1)
-      (ex/raise :type :validation
-                :code :no-enough-members-for-leave
-                :context {:members (count members)})
-
-      ;; if the `reassign-to` is filled and has a different value
-      ;; than the current profile-id, we proceed to reassing the
-      ;; owner role to profile identified by the `reassign-to`.
-      (and reassign-to (not= reassign-to profile-id))
-      (let [member (d/seek #(= reassign-to (:id %)) members)]
-        (when-not member
-          (ex/raise :type :not-found :code :member-does-not-exist))
-
-        ;; unasign owner role to current profile
-        (db/update! conn :team-profile-rel
-                    {:is-owner false}
-                    {:team-id id
-                     :profile-id profile-id})
-
-        ;; assign owner role to new profile
-        (db/update! conn :team-profile-rel
-                    (role->params :owner)
-                    {:team-id id :profile-id reassign-to}))
-
-      ;; and finally, if all other conditions does not match and the
-      ;; current profile is owner, we dont allow it because there
-      ;; must always be an owner.
-      (:is-owner perms)
-      (ex/raise :type :validation
-                :code :owner-cant-leave-team
-                :hint "releasing owner before leave"))
-
-    (db/delete! conn :team-profile-rel
-                {:profile-id profile-id
-                 :team-id id})
-
-    nil))
-
-(s/def ::reassign-to ::us/uuid)
-(s/def ::leave-team
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]
-          :opt-un [::reassign-to]))
-
-(sv/defmethod ::leave-team
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (leave-team conn (assoc params :profile-id profile-id))))
-
-;; --- Mutation: Delete Team
-
-(s/def ::delete-team
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]))
-
-;; TODO: right now just don't allow delete default team, in future it
-;; should raise a specific exception for signal that this action is
-;; not allowed.
-
-(sv/defmethod ::delete-team
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms (get-permissions conn profile-id id)]
-      (when-not (:is-owner perms)
-        (ex/raise :type :validation
-                  :code :only-owner-can-delete-team))
-
-      (db/update! conn :team
-                  {:deleted-at (dt/now)}
-                  {:id id :is-default false})
-      nil)))
-
-
-;; --- Mutation: Team Update Role
-
-(s/def ::team-id ::us/uuid)
-(s/def ::member-id ::us/uuid)
-;; Temporarily disabled viewer role
-;; https://tree.taiga.io/project/uxboxproject/issue/1083
-;; (s/def ::role #{:owner :admin :editor :viewer})
-(s/def ::role #{:owner :admin :editor})
-
-(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
-  [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,
-  ;; we will change it to more efficient fetch mechanisms.
-  (let [perms   (get-permissions conn profile-id team-id)
-        members (retrieve-team-members conn team-id)
-        member  (d/seek #(= member-id (:id %)) members)
-
-        is-owner? (:is-owner perms)
-        is-admin? (:is-admin perms)]
-
-    ;; If no member is found, just 404
-    (when-not member
-      (ex/raise :type :not-found
-                :code :member-does-not-exist))
-
-    ;; First check if we have permissions to change roles
-    (when-not (or is-owner? is-admin?)
-      (ex/raise :type :validation
-                :code :insufficient-permissions))
-
-    ;; Don't allow change role of owner member
-    (when (:is-owner member)
-      (ex/raise :type :validation
-                :code :cant-change-role-to-owner))
-
-    ;; Don't allow promote to owner to admin users.
-    (when (and (not is-owner?) (= role :owner))
-      (ex/raise :type :validation
-                :code :cant-promote-to-owner))
-
-    (let [params (role->params role)]
-      ;; Only allow single owner on team
-      (when (= role :owner)
-        (db/update! conn :team-profile-rel
-                    {:is-owner false}
-                    {:team-id team-id
-                     :profile-id profile-id}))
-
-      (db/update! conn :team-profile-rel
-                  params
-                  {:team-id team-id
-                   :profile-id member-id})
-      nil)))
-
-(s/def ::update-team-member-role
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::member-id ::role]))
-
-(sv/defmethod ::update-team-member-role
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (update-team-member-role conn (assoc params :profile-id profile-id))))
-
-
-;; --- Mutation: Delete Team Member
-
-(s/def ::delete-team-member
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::member-id]))
-
-(sv/defmethod ::delete-team-member
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms (get-permissions conn profile-id team-id)]
-      (when-not (or (:is-owner perms)
-                    (:is-admin perms))
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
-
-      (when (= member-id profile-id)
-        (ex/raise :type :validation
-                  :code :cant-remove-yourself))
-
-      (db/delete! conn :team-profile-rel {:profile-id member-id
-                                          :team-id team-id})
-
-      nil)))
-
-;; --- Mutation: Update Team Photo
-
-(declare upload-photo)
-(declare ^:private update-team-photo)
-
-(s/def ::file ::media/upload)
-(s/def ::update-team-photo
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::file]))
-
-(sv/defmethod ::update-team-photo
-  {::doc/added "1.17"}
-  [cfg {:keys [::rpc/profile-id file] :as params}]
-  ;; Validate incoming mime type
-  (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
-  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
-    (update-team-photo cfg (assoc params :profile-id profile-id))))
-
-(defn update-team-photo
-  [{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id team-id] :as params}]
-  (p/let [team  (px/with-dispatch executor
-                  (retrieve-team pool profile-id team-id))
-          photo (profile/upload-photo cfg params)]
-
-    ;; Mark object as touched for make it ellegible for tentative
-    ;; garbage collection.
-    (when-let [id (:photo-id team)]
-      (sto/touch-object! storage id))
-
-    ;; Save new photo
-    (db/update! pool :team
-                {:photo-id (:id photo)}
-                {:id team-id})
-
-    (assoc team :photo-id (:id photo))))
-
-
-;; --- Mutation: Create Team Invitation
-
-(def sql:upsert-team-invitation
-  "insert into team_invitation(team_id, email_to, role, valid_until)
-   values (?, ?, ?, ?)
-       on conflict(team_id, email_to) do
-          update set role = ?, updated_at = now();")
-
-(defn- create-invitation-token
-  [cfg {:keys [profile-id valid-until team-id member-id member-email role]}]
-  (tokens/generate (::main/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 (::main/props cfg)
-                   {:iss :profile-identity
-                    :profile-id (:id profile)
-                    :exp (dt/in-future {:days 30})}))
-
-(defn- create-invitation
-  [{:keys [::conn] :as cfg} {:keys [team profile role email] :as params}]
-  (let [member (profile/get-profile-by-email conn email)
-        expire (dt/in-future "168h") ;; 7 days
-        itoken (create-invitation-token cfg {:profile-id (:id profile)
-                                             :valid-until expire
-                                             :team-id (:id team)
-                                             :member-email (or (:email member) email)
-                                             :member-id (:id member)
-                                             :role role})
-        ptoken (create-profile-identity-token cfg profile)]
-
-    (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"))
-
-    ;; Secondly check if the invited member email is part of the global spam/bounce report.
-    (when (eml/has-bounce-reports? conn email)
-      (ex/raise :type :validation
-                :code :email-has-permanent-bounces
-                :email email
-                :hint "the email you invite has been repeatedly reported as spam or bounce"))
-
-    (when (contains? cf/flags :log-invitation-tokens)
-      (l/trace :hint "invitation token" :token itoken))
-
-    ;; 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 {: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)})))
-      (do
-        (db/exec-one! conn [sql:upsert-team-invitation
-                            (:id team) (str/lower email) (name role) expire (name role)])
-        (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))
-
-(s/def ::email ::us/email)
-(s/def ::emails ::us/set-of-valid-emails)
-(s/def ::create-team-invitations
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::role]
-          :opt-un [::email ::emails]))
-
-(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"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email 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   (cond-> (or emails #{}) (string? email) (conj email))]
-
-
-      (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))
-
-      ;; First check if the current profile is allowed to send emails.
-      (when-not (eml/allow-send-emails? conn profile)
-        (ex/raise :type :validation
-                  :code :profile-is-muted
-                  :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
-
-      (let [cfg         (assoc cfg ::conn conn)
-            invitations (->> emails
-                             (map (fn [email]
-                                    {:email (str/lower email)
-                                     :team team
-                                     :profile profile
-                                     :role role}))
-                             (map (partial create-invitation cfg)))]
-        (with-meta (vec invitations)
-          {::audit/props {:invitations (count invitations)}})))))
-
-
-;; --- Mutation: Create Team & Invite Members
-
-(s/def ::emails ::us/set-of-valid-emails)
-(s/def ::create-team-with-invitations
-  (s/merge ::create-team
-           (s/keys :req-un [::emails ::role])))
-
-(sv/defmethod ::create-team-with-invitations
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id emails role] :as params}]
-  (db/with-atomic [conn pool]
-    (let [team     (create-team conn params)
-          profile  (db/get-by-id conn :profile profile-id)
-          cfg      (assoc cfg ::conn conn)]
-
-      ;; Create invitations for all provided emails.
-      (->> emails
-           (map (fn [email]
-                  {:team team
-                   :profile profile
-                   :email (str/lower email)
-                   :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)}))
-
-      (-> team
-          (vary-meta assoc ::audit/props {:invitations (count emails)})
-          (rph/with-defer
-            #(when-let [collector (::audit/collector cfg)]
-               (audit/submit! collector
-                              {:type "command"
-                               :name "create-team-invitations"
-                               :profile-id profile-id
-                               :props {:emails emails
-                                       :role role
-                                       :profile-id profile-id
-                                       :invitations (count emails)}})))))))
-
-;; --- Query: get-team-invitation-token
-
-(s/def ::get-team-invitation-token
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::email]))
-
-(sv/defmethod ::get-team-invitation-token
-  {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
-  (check-read-permissions! pool profile-id team-id)
-  (let [invit (-> (db/get pool :team-invitation
-                          {:team-id team-id
-                           :email-to (str/lower email)})
-                  (update :role keyword))
-        member (profile/get-profile-by-email pool (:email 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) (:email-to invit))})]
-    {:token token}))
-
-;; --- Mutation: Update invitation role
-
-(s/def ::update-team-invitation-role
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::email ::role]))
-
-(sv/defmethod ::update-team-invitation-role
-  {::doc/added "1.17"}
-  [{: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 (str/lower email)})
-      nil)))
-
-;; --- Mutation: Delete invitation
-
-(s/def ::delete-team-invitation
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::email]))
-
-(sv/defmethod ::delete-team-invitation
-  {::doc/added "1.17"}
-  [{: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))
-
-      (db/delete! conn :team-invitation
-                {:team-id team-id :email-to (str/lower email)})
-      nil)))

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

@@ -11,13 +11,10 @@
    [app.db :as db]
    [app.http.session :as session]
    [app.loggers.audit :as audit]
-   [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]
+   [app.rpc.mutations.teams :as teams]
+   [app.rpc.queries.profile :as profile]
    [app.tokens :as tokens]
    [app.tokens.spec.team-invitation :as-alias spec.team-invitation]
    [app.util.services :as sv]
@@ -30,20 +27,20 @@
 
 (s/def ::verify-token
   (s/keys :req-un [::token]
-          :opt [::rpc/profile-id]))
+          :opt-un [::profile-id]))
 
 (sv/defmethod ::verify-token
-  {::rpc/auth false
+  {:auth false
    ::doc/added "1.15"}
-  [{:keys [::db/pool] :as cfg} {:keys [token] :as params}]
+  [{:keys [pool sprops] :as cfg} {:keys [token] :as params}]
   (db/with-atomic [conn pool]
-    (let [claims (tokens/verify (::main/props cfg) {:token token})
+    (let [claims (tokens/verify sprops {:token token})
           cfg    (assoc cfg :conn conn)]
       (process-token cfg params claims))))
 
 (defmethod process-token :change-email
   [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
-  (when (profile/get-profile-by-email conn email)
+  (when (profile/retrieve-profile-data-by-email conn email)
     (ex/raise :type :validation
               :code :email-already-exists))
 
@@ -57,8 +54,8 @@
      ::audit/profile-id profile-id}))
 
 (defmethod process-token :verify-email
-  [{:keys [conn] :as cfg} _ {:keys [profile-id] :as claims}]
-  (let [profile (profile/get-profile conn profile-id)
+  [{:keys [conn session] :as cfg} _ {:keys [profile-id] :as claims}]
+  (let [profile (profile/retrieve-profile conn profile-id)
         claims  (assoc claims :profile profile)]
 
     (when-not (:is-active profile)
@@ -72,14 +69,14 @@
                   {:id (:id profile)}))
 
     (-> claims
-        (rph/with-transform (session/create-fn cfg profile-id))
+        (rph/with-transform (session/create-fn session profile-id))
         (rph/with-meta {::audit/name "verify-profile-email"
                         ::audit/props (audit/profile->props profile)
                         ::audit/profile-id (:id profile)}))))
 
 (defmethod process-token :auth
   [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
-  (let [profile (profile/get-profile conn profile-id)]
+  (let [profile (profile/retrieve-profile conn profile-id)]
     (assoc claims :profile profile)))
 
 ;; --- Team Invitation
@@ -98,11 +95,6 @@
       (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 invited member to the team
     (db/insert! conn :team-profile-rel params {:on-conflict-do-nothing true})
 
@@ -134,11 +126,10 @@
           :opt-un [::spec.team-invitation/member-id]))
 
 (defmethod process-token :team-invitation
-  [{:keys [conn] :as cfg}
-   {:keys [::rpc/profile-id token]}
+  [{:keys [conn session] :as cfg} {:keys [profile-id token]}
    {:keys [member-id team-id member-email] :as claims}]
 
-  (us/verify! ::team-invitation-claims claims)
+  (us/assert ::team-invitation-claims claims)
 
   (let [invitation (db/get* conn :team-invitation
                             {:team-id team-id :email-to member-email})
@@ -180,7 +171,7 @@
                                {:columns [:id :email]})]
         (let [profile (accept-invitation cfg claims invitation member)]
           (-> (assoc claims :state :created)
-              (rph/with-transform (session/create-fn cfg (:id profile)))
+              (rph/with-transform (session/create-fn session (:id profile)))
               (rph/with-meta {::audit/name "accept-team-invitation"
                               ::audit/props (merge
                                              (audit/profile->props profile)

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

@@ -8,15 +8,15 @@
   (:require
    [app.common.exceptions :as ex]
    [app.db :as db]
-   [app.rpc :as-alias rpc]
    [app.rpc.commands.comments :as comments]
    [app.rpc.commands.files :as files]
    [app.rpc.cond :as-alias cond]
    [app.rpc.doc :as-alias doc]
+   [app.rpc.queries.share-link :as slnk]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
-;; --- QUERY: View Only Bundle
+;; --- Query: View Only Bundle
 
 (defn- get-project
   [conn id]
@@ -30,8 +30,7 @@
         users   (comments/get-file-comments-users conn file-id profile-id)
 
         links   (->> (db/query conn :share-link {:file-id file-id})
-                     (mapv (fn [row]
-                             (update row :pages db/decode-pgarray #{}))))
+                     (mapv slnk/decode-share-link-row))
 
         fonts   (db/query conn :team-font-variant
                           {:team-id (:team-id project)
@@ -74,16 +73,16 @@
 
 (s/def ::get-view-only-bundle
   (s/keys :req-un [::files/file-id]
-          :opt-un [::files/share-id
-                   ::files/features]
-          :opt [::rpc/profile-id]))
+          :opt-un [::files/profile-id
+                   ::files/share-id
+                   ::files/features]))
 
 (sv/defmethod ::get-view-only-bundle
-  {::rpc/auth false
+  {:auth false
    ::cond/get-object #(files/get-minimal-file %1 (:file-id %2))
    ::cond/key-fn files/get-file-etag
    ::cond/reuse-key? true
    ::doc/added "1.17"}
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id] :as params}]
+  [{:keys [pool]} params]
   (with-open [conn (db/open pool)]
-    (get-view-only-bundle conn (assoc params :profile-id profile-id))))
+    (get-view-only-bundle conn params)))

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

@@ -12,9 +12,8 @@
    [app.db :as db]
    [app.http.client :as http]
    [app.loggers.webhooks :as webhooks]
-   [app.rpc :as-alias rpc]
-   [app.rpc.commands.teams :refer [check-edition-permissions! check-read-permissions!]]
    [app.rpc.doc :as-alias doc]
+   [app.rpc.queries.teams :refer [check-edition-permissions! check-read-permissions!]]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
@@ -24,16 +23,17 @@
 
 ;; --- Mutation: Create Webhook
 
+(s/def ::profile-id ::us/uuid)
 (s/def ::team-id ::us/uuid)
 (s/def ::uri ::us/not-empty-string)
 (s/def ::is-active ::us/boolean)
 (s/def ::mtype
   #{"application/json"
+    "application/x-www-form-urlencoded"
     "application/transit+json"})
 
 (s/def ::create-webhook
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::uri ::mtype]
+  (s/keys :req-un [::profile-id ::team-id ::uri ::mtype]
           :opt-un [::is-active]))
 
 ;; NOTE: for now the quote is hardcoded but this need to be solved in
@@ -74,8 +74,7 @@
     (when (>= total max-hooks-for-team)
       (ex/raise :type :restriction
                 :code :webhooks-quote-reached
-                :hint (str/ffmt "can't create more than % webhooks per team"
-                                max-hooks-for-team)))))
+                :hint (str/ffmt "can't create more than % webhooks per team" max-hooks-for-team)))))
 
 (defn- insert-webhook!
   [{:keys [::db/pool]} {:keys [team-id uri mtype is-active] :as params}]
@@ -98,10 +97,10 @@
 
 (sv/defmethod ::create-webhook
   {::doc/added "1.17"}
-  [{:keys [::db/pool ::wrk/executor] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
+  [{:keys [::db/pool ::wrk/executor] :as cfg} {:keys [profile-id team-id] :as params}]
   (check-edition-permissions! pool profile-id team-id)
-  (validate-quotes! cfg params)
-  (->> (validate-webhook! cfg nil params)
+  (->> (validate-quotes! cfg params)
+       (p/fmap executor (fn [_] (validate-webhook! cfg nil params)))
        (p/fmap executor (fn [_] (insert-webhook! cfg params)))))
 
 (s/def ::update-webhook
@@ -109,19 +108,18 @@
 
 (sv/defmethod ::update-webhook
   {::doc/added "1.17"}
-  [{:keys [::db/pool ::wrk/executor] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [::db/pool ::wrk/executor] :as cfg} {:keys [id profile-id] :as params}]
   (let [whook (db/get pool :webhook {:id id})]
     (check-edition-permissions! pool profile-id (:team-id whook))
     (->> (validate-webhook! cfg whook params)
          (p/fmap executor (fn [_] (update-webhook! cfg whook params))))))
 
 (s/def ::delete-webhook
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]))
+  (s/keys :req-un [::profile-id ::id]))
 
 (sv/defmethod ::delete-webhook
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id]}]
+  [{:keys [::db/pool] :as cfg} {:keys [profile-id id]}]
   (db/with-atomic [conn pool]
     (let [whook (db/get conn :webhook {:id id})]
       (check-edition-permissions! conn profile-id (:team-id whook))
@@ -132,15 +130,14 @@
 
 (s/def ::team-id ::us/uuid)
 (s/def ::get-webhooks
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]))
+  (s/keys :req-un [::profile-id ::team-id]))
 
 (def sql:get-webhooks
   "select id, uri, mtype, is_active, error_code, error_count
    from webhook where team_id = ? order by uri")
 
 (sv/defmethod ::get-webhooks
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id team-id)
     (db/exec! conn [sql:get-webhooks team-id])))

backend/src/app/rpc/doc.clj

@@ -9,7 +9,6 @@
   (:require
    [app.common.data :as d]
    [app.config :as cf]
-   [app.loggers.webhooks :as-alias webhooks]
    [app.rpc :as-alias rpc]
    [app.util.services :as sv]
    [app.util.template :as tmpl]
@@ -36,7 +35,6 @@
                :name (d/name name)
                :module (-> (:ns mdata) (str/split ".") last)
                :auth (:auth mdata true)
-               :webhook (::webhooks/event? mdata false)
                :docs (::sv/docstring mdata)
                :deprecated (::deprecated mdata)
                :added (::added mdata)
@@ -53,7 +51,6 @@
      (->> (:queries methods)
           (map (partial gen-doc :query))
           (sort-by (juxt :module :name)))
-
      :mutation-methods
      (->> (:mutations methods)
           (map (partial gen-doc :query))
@@ -70,8 +67,6 @@
       (respond (yrs/response 404)))))
 
 
-(s/def ::routes vector?)
-
 (defmethod ig/pre-init-spec ::routes [_]
   (s/keys :req-un [::rpc/methods]))
 

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

@@ -0,0 +1,123 @@
+;; 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.mutations.comments
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.rpc.commands.comments :as cmd.comments]
+   [app.rpc.commands.files :as cmd.files]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.retry :as retry]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+;; --- Mutation: Create Comment Thread
+
+(s/def ::create-comment-thread ::cmd.comments/create-comment-thread)
+
+(sv/defmethod ::create-comment-thread
+  {::retry/max-retries 3
+   ::retry/matches retry/conflict-db-insert?
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-comment-permissions! conn profile-id file-id share-id)
+    (cmd.comments/create-comment-thread conn params)))
+
+;; --- Mutation: Update Comment Thread Status
+
+(s/def ::id ::us/uuid)
+(s/def ::share-id (s/nilable ::us/uuid))
+
+(s/def ::update-comment-thread-status ::cmd.comments/update-comment-thread-status)
+
+(sv/defmethod ::update-comment-thread-status
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id id share-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [cthr (db/get-by-id conn :comment-thread id {:for-update true})]
+      (when-not cthr (ex/raise :type :not-found))
+      (cmd.files/check-comment-permissions! conn profile-id (:file-id cthr) share-id)
+      (cmd.comments/upsert-comment-thread-status! conn profile-id (:id cthr)))))
+
+
+;; --- Mutation: Update Comment Thread
+
+(s/def ::update-comment-thread ::cmd.comments/update-comment-thread)
+
+(sv/defmethod ::update-comment-thread
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id id is-resolved share-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
+      (when-not thread
+        (ex/raise :type :not-found))
+
+      (cmd.files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
+      (db/update! conn :comment-thread
+                  {:is-resolved is-resolved}
+                  {:id id})
+      nil)))
+
+
+;; --- Mutation: Add Comment
+
+(s/def ::add-comment ::cmd.comments/create-comment)
+
+(sv/defmethod ::add-comment
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (cmd.comments/create-comment conn params)))
+
+
+;; --- Mutation: Update Comment
+
+(s/def ::update-comment ::cmd.comments/update-comment)
+
+(sv/defmethod ::update-comment
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (cmd.comments/update-comment conn params)))
+
+
+;; --- Mutation: Delete Comment Thread
+
+(s/def ::delete-comment-thread ::cmd.comments/delete-comment-thread)
+
+(sv/defmethod ::delete-comment-thread
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
+      (when-not (= (:owner-id thread) profile-id)
+        (ex/raise :type :validation :code :not-allowed))
+      (db/delete! conn :comment-thread {:id id})
+      nil)))
+
+
+;; --- Mutation: Delete comment
+
+(s/def ::delete-comment ::cmd.comments/delete-comment)
+
+(sv/defmethod ::delete-comment
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [comment (db/get-by-id conn :comment id {:for-update true})]
+      (when-not (= (:owner-id comment) profile-id)
+        (ex/raise :type :validation :code :not-allowed))
+      (db/delete! conn :comment {:id id}))))

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

@@ -0,0 +1,236 @@
+;; 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.mutations.files
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.loggers.audit :as audit]
+   [app.rpc.climit :as-alias climit]
+   [app.rpc.commands.files :as cmd.files]
+   [app.rpc.commands.files.create :as cmd.files.create]
+   [app.rpc.commands.files.temp :as cmd.files.temp]
+   [app.rpc.commands.files.update :as cmd.files.update]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.helpers :as rph]
+   [app.rpc.queries.projects :as proj]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]))
+
+;; --- Mutation: Create File
+
+(s/def ::create-file ::cmd.files.create/create-file)
+
+(sv/defmethod ::create-file
+  {::doc/added "1.0"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id features components-v2] :as params}]
+  (db/with-atomic [conn pool]
+    (proj/check-edition-permissions! conn profile-id project-id)
+    (let [team-id  (cmd.files/get-team-id conn project-id)
+          features (cond-> (or features #{})
+                     ;; BACKWARD COMPATIBILITY with the components-v2 param
+                     components-v2 (conj "components/v2"))
+          params   (assoc params :features features)]
+      (-> (cmd.files.create/create-file conn params)
+          (vary-meta assoc ::audit/props {:team-id team-id})))))
+
+
+;; --- Mutation: Rename File
+
+(s/def ::rename-file ::cmd.files/rename-file)
+
+(sv/defmethod ::rename-file
+  {::doc/added "1.0"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id id)
+    (cmd.files/rename-file conn params)))
+
+
+;; --- Mutation: Set File shared
+
+(s/def ::set-file-shared ::cmd.files/set-file-shared)
+
+(sv/defmethod ::set-file-shared
+  {::doc/added "1.2"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [id profile-id is-shared] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id id)
+    (when-not is-shared
+      (cmd.files/absorb-library conn params)
+      (cmd.files/unlink-files conn params))
+    (cmd.files/set-file-shared conn params)))
+
+;; --- Mutation: Delete File
+
+(s/def ::delete-file ::cmd.files/delete-file)
+
+(sv/defmethod ::delete-file
+  {::doc/added "1.0"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id id)
+    (cmd.files/absorb-library conn params)
+    (cmd.files/mark-file-deleted conn params)))
+
+;; --- Mutation: Link file to library
+
+(s/def ::link-file-to-library ::cmd.files/link-file-to-library)
+
+(sv/defmethod ::link-file-to-library
+  {::doc/added "1.3"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
+  (when (= file-id library-id)
+    (ex/raise :type :validation
+              :code :invalid-library
+              :hint "A file cannot be linked to itself"))
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id file-id)
+    (cmd.files/check-edition-permissions! conn profile-id library-id)
+    (cmd.files/link-file-to-library conn params)))
+
+;; --- Mutation: Unlink file from library
+
+(s/def ::unlink-file-from-library ::cmd.files/unlink-file-from-library)
+
+(sv/defmethod ::unlink-file-from-library
+  {::doc/added "1.3"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id file-id)
+    (cmd.files/unlink-file-from-library conn params)))
+
+
+;; --- Mutation: Update synchronization status of a link
+
+(s/def ::update-sync ::cmd.files/update-file-library-sync-status)
+
+(sv/defmethod ::update-sync
+  {::doc/added "1.10"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id file-id)
+    (cmd.files/update-sync conn params)))
+
+
+;; --- Mutation: Ignore updates in linked files
+
+(declare ignore-sync)
+
+(s/def ::ignore-sync ::cmd.files/ignore-file-library-sync-status)
+
+(sv/defmethod ::ignore-sync
+  {::doc/added "1.10"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id file-id)
+    (cmd.files/ignore-sync conn params)))
+
+
+;; --- MUTATION: update-file
+
+(s/def ::components-v2 ::us/boolean)
+(s/def ::update-file
+  (s/and ::cmd.files.update/update-file
+         (s/keys :opt-un [::components-v2])))
+
+(sv/defmethod ::update-file
+  {::climit/queue :update-file
+   ::climit/key-fn :id
+   ::doc/added "1.0"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [id profile-id features components-v2] :as params}]
+  (db/with-atomic [conn pool]
+    (db/xact-lock! conn id)
+    (cmd.files/check-edition-permissions! conn profile-id id)
+
+    (let [;; BACKWARD COMPATIBILITY with the components-v2 parameter
+          features  (cond-> (or features #{})
+                      components-v2 (conj "components/v2"))
+          tpoint    (dt/tpoint)
+          params    (assoc params :features features)
+          cfg       (assoc cfg :conn conn)]
+
+      (-> (cmd.files.update/update-file cfg params)
+          (rph/with-defer #(let [elapsed (tpoint)]
+                             (l/trace :hint "update-file" :time (dt/format-duration elapsed))))))))
+
+;; --- Mutation: upsert object thumbnail
+
+(s/def ::upsert-file-object-thumbnail ::cmd.files/upsert-file-object-thumbnail)
+
+(sv/defmethod ::upsert-file-object-thumbnail
+  {::doc/added "1.13"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id file-id)
+    (cmd.files/upsert-file-object-thumbnail! conn params)
+    nil))
+
+
+;; --- Mutation: upsert file thumbnail
+
+(s/def ::upsert-file-thumbnail ::cmd.files/upsert-file-thumbnail)
+
+(sv/defmethod ::upsert-file-thumbnail
+  "Creates or updates the file thumbnail. Mainly used for paint the
+  grid thumbnails."
+  {::doc/added "1.13"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id file-id)
+    (cmd.files/upsert-file-thumbnail conn params)
+    nil))
+
+
+;; --- MUTATION COMMAND: create-temp-file
+
+(s/def ::create-temp-file ::cmd.files.temp/create-temp-file)
+
+(sv/defmethod ::create-temp-file
+  {::doc/added "1.7"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
+  (db/with-atomic [conn pool]
+    (proj/check-edition-permissions! conn profile-id project-id)
+    (cmd.files.create/create-file conn (assoc params :deleted-at (dt/in-future {:days 1})))))
+
+;; --- MUTATION COMMAND: update-temp-file
+
+(s/def ::update-temp-file ::cmd.files.temp/update-temp-file)
+
+(sv/defmethod ::update-temp-file
+  {::doc/added "1.7"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (cmd.files.temp/update-temp-file conn params)
+    nil))
+
+;; --- MUTATION COMMAND: persist-temp-file
+
+(s/def ::persist-temp-file ::cmd.files.temp/persist-temp-file)
+
+(sv/defmethod ::persist-temp-file
+  {::doc/added "1.7"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (cmd.files/check-edition-permissions! conn profile-id id)
+    (cmd.files.temp/persist-temp-file conn params)))

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

@@ -6,20 +6,24 @@
 
 (ns app.rpc.mutations.fonts
   (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
    [app.common.spec :as us]
+   [app.common.uuid :as uuid]
    [app.db :as db]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.media :as media]
-   [app.rpc.commands.fonts :as fonts]
-   [app.rpc.commands.teams :as teams]
+   [app.rpc.climit :as-alias climit]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
-   [app.rpc.quotes :as quotes]
+   [app.rpc.queries.teams :as teams]
    [app.storage :as sto]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]))
+   [clojure.spec.alpha :as s]
+   [promesa.core :as p]
+   [promesa.exec :as px]))
 
 (declare create-font-variant)
 
@@ -39,19 +43,79 @@
   (s/keys :req-un [::profile-id ::team-id ::data
                    ::font-id ::font-family ::font-weight ::font-style]))
 
-(declare create-font-variant)
-
 (sv/defmethod ::create-font-variant
   {::doc/added "1.3"
-   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}]
-  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
+  (let [cfg (update cfg :storage media/configure-assets-storage)]
     (teams/check-edition-permissions! pool profile-id team-id)
-    (quotes/check-quote! pool {::quotes/id ::quotes/font-variants-per-team
-                               ::quotes/profile-id profile-id
-                               ::quotes/team-id team-id})
-    (fonts/create-font-variant cfg params)))
+    (create-font-variant cfg params)))
+
+(defn create-font-variant
+  [{:keys [storage pool executor climit] :as cfg} {:keys [data] :as params}]
+  (letfn [(generate-fonts [data]
+            (climit/with-dispatch (:process-font climit)
+              (media/run {:cmd :generate-fonts :input data})))
+
+          ;; Function responsible of calculating cryptographyc hash of
+          ;; the provided data.
+          (calculate-hash [data]
+            (px/with-dispatch executor
+              (sto/calculate-hash data)))
+
+          (validate-data [data]
+            (when (and (not (contains? data "font/otf"))
+                       (not (contains? data "font/ttf"))
+                       (not (contains? data "font/woff"))
+                       (not (contains? data "font/woff2")))
+              (ex/raise :type :validation
+                        :code :invalid-font-upload))
+            data)
+
+          (persist-font-object [data mtype]
+            (when-let [resource (get data mtype)]
+              (p/let [hash    (calculate-hash resource)
+                      content (-> (sto/content resource)
+                                  (sto/wrap-with-hash hash))]
+                (sto/put-object! storage {::sto/content content
+                                          ::sto/touched-at (dt/now)
+                                          ::sto/deduplicate? true
+                                          :content-type mtype
+                                          :bucket "team-font-variant"}))))
+
+          (persist-fonts [data]
+            (p/let [otf   (persist-font-object data "font/otf")
+                    ttf   (persist-font-object data "font/ttf")
+                    woff1 (persist-font-object data "font/woff")
+                    woff2 (persist-font-object data "font/woff2")]
+
+              (d/without-nils
+               {:otf otf
+                :ttf ttf
+                :woff1 woff1
+                :woff2 woff2})))
+
+          (insert-into-db [{:keys [woff1 woff2 otf ttf]}]
+            (db/insert! pool :team-font-variant
+                        {:id (uuid/next)
+                         :team-id (:team-id params)
+                         :font-id (:font-id params)
+                         :font-family (:font-family params)
+                         :font-weight (:font-weight params)
+                         :font-style (:font-style params)
+                         :woff1-file-id (:id woff1)
+                         :woff2-file-id (:id woff2)
+                         :otf-file-id (:id otf)
+                         :ttf-file-id (:id ttf)}))
+          ]
+
+    (->> (generate-fonts data)
+         (p/map validate-data)
+         (p/mcat executor persist-fonts)
+         (p/map executor insert-into-db)
+         (p/map (fn [result]
+                  (let [params (update params :data (comp vec keys))]
+                    (rph/with-meta result {::audit/replace-props params})))))))
 
 ;; --- UPDATE FONT FAMILY
 
@@ -60,20 +124,14 @@
 
 (sv/defmethod ::update-font
   {::doc/added "1.3"
-   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [team-id profile-id id name] :as params}]
   (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
-    (rph/with-meta
-      (db/update! conn :team-font-variant
-                  {:font-family name}
-                  {:font-id id
-                   :team-id team-id})
-      {::audit/replace-props {:id id
-                              :name name
-                              :team-id team-id
-                              :profile-id profile-id}})))
+    (db/update! conn :team-font-variant
+                {:font-family name}
+                {:font-id id
+                 :team-id team-id})))
 
 ;; --- DELETE FONT
 
@@ -82,19 +140,14 @@
 
 (sv/defmethod ::delete-font
   {::doc/added "1.3"
-   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
-    (let [font (db/update! conn :team-font-variant
-                           {:deleted-at (dt/now)}
-                           {:font-id id :team-id team-id})]
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:id id
-                        :team-id team-id
-                        :name (:font-family font)
-                        :profile-id profile-id}}))))
+    (db/update! conn :team-font-variant
+                {:deleted-at (dt/now)}
+                {:font-id id :team-id team-id})
+    nil))
 
 ;; --- DELETE FONT VARIANT
 
@@ -103,14 +156,12 @@
 
 (sv/defmethod ::delete-font-variant
   {::doc/added "1.3"
-   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
-    (let [variant (db/update! conn :team-font-variant
-                              {:deleted-at (dt/now)}
-                              {:id id :team-id team-id})]
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:font-family (:font-family variant)
-                        :font-id (:font-id variant)}}))))
+
+    (db/update! conn :team-font-variant
+                {:deleted-at (dt/now)}
+                {:id id :team-id team-id})
+    nil))

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

@@ -0,0 +1,58 @@
+;; 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.mutations.management
+  "Move & Duplicate RPC methods for files and projects."
+  (:require
+   [app.db :as db]
+   [app.rpc.commands.management :as cmd.mgm]
+   [app.rpc.doc :as-alias doc]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+;; --- MUTATION: Duplicate File
+
+(s/def ::duplicate-file ::cmd.mgm/duplicate-file)
+
+(sv/defmethod ::duplicate-file
+  {::doc/added "1.2"
+   ::doc/deprecated "1.16"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (cmd.mgm/duplicate-file conn params)))
+
+;; --- MUTATION: Duplicate Project
+
+(s/def ::duplicate-project ::cmd.mgm/duplicate-project)
+
+(sv/defmethod ::duplicate-project
+  {::doc/added "1.2"
+   ::doc/deprecated "1.16"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (cmd.mgm/duplicate-project conn params)))
+
+;; --- MUTATION: Move file
+
+(s/def ::move-files ::cmd.mgm/move-files)
+
+(sv/defmethod ::move-files
+  {::doc/added "1.2"
+   ::doc/deprecated "1.16"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (cmd.mgm/move-files conn params)))
+
+;; --- MUTATION: Move project
+
+(s/def ::move-project ::cmd.mgm/move-project)
+
+(sv/defmethod ::move-project
+  {::doc/added "1.2"
+   ::doc/deprecated "1.16"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (cmd.mgm/move-project conn params)))

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

@@ -6,50 +6,280 @@
 
 (ns app.rpc.mutations.media
   (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.media :as cm]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
    [app.db :as db]
+   [app.http.client :as http]
    [app.media :as media]
-   [app.rpc.commands.files :as files]
-   [app.rpc.commands.media :as cmd.media]
-   [app.rpc.doc :as-alias doc]
-   [app.storage :as-alias sto]
+   [app.rpc.climit :as climit]
+   [app.rpc.queries.teams :as teams]
+   [app.storage :as sto]
+   [app.storage.tmp :as tmp]
    [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [datoteka.io :as io]
+   [promesa.core :as p]
+   [promesa.exec :as px]))
+
+(def default-max-file-size (* 1024 1024 10)) ; 10 MiB
+
+(def thumbnail-options
+  {:width 100
+   :height 100
+   :quality 85
+   :format :jpeg})
+
+(s/def ::id ::us/uuid)
+(s/def ::name ::us/string)
+(s/def ::profile-id ::us/uuid)
+(s/def ::file-id ::us/uuid)
+(s/def ::team-id ::us/uuid)
 
 ;; --- Create File Media object (upload)
 
-(s/def ::upload-file-media-object ::cmd.media/upload-file-media-object)
+(declare create-file-media-object)
+(declare select-file)
+
+(s/def ::content ::media/upload)
+(s/def ::is-local ::us/boolean)
+
+(s/def ::upload-file-media-object
+  (s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content]
+          :opt-un [::id]))
 
 (sv/defmethod ::upload-file-media-object
-  {::doc/added "1.2"
-   ::doc/deprecated "1.18"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id content] :as params}]
-  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
-    (files/check-edition-permissions! pool profile-id file-id)
+  (let [file (select-file pool file-id)
+        cfg  (update cfg :storage media/configure-assets-storage)]
+
+    (teams/check-edition-permissions! pool profile-id (:team-id file))
     (media/validate-media-type! content)
-    (cmd.media/validate-content-size! content)
-    (cmd.media/create-file-media-object cfg params)))
+
+    (when (> (:size content) (cf/get :media-max-file-size default-max-file-size))
+      (ex/raise :type :restriction
+                :code :media-max-file-size-reached
+                :hint (str/ffmt "the uploaded file size % is greater than the maximum %"
+                                (:size content)
+                                default-max-file-size)))
+
+    (create-file-media-object cfg params)))
+
+(defn- big-enough-for-thumbnail?
+  "Checks if the provided image info is big enough for
+  create a separate thumbnail storage object."
+  [info]
+  (or (> (:width info) (:width thumbnail-options))
+      (> (:height info) (:height thumbnail-options))))
+
+(defn- svg-image?
+  [info]
+  (= (:mtype info) "image/svg+xml"))
+
+;; NOTE: we use the `on conflict do update` instead of `do nothing`
+;; because postgresql does not returns anything if no update is
+;; performed, the `do update` does the trick.
+
+(def sql:create-file-media-object
+  "insert into file_media_object (id, file_id, is_local, name, media_id, thumbnail_id, width, height, mtype)
+   values (?, ?, ?, ?, ?, ?, ?, ?, ?)
+       on conflict (id) do update set created_at=file_media_object.created_at
+       returning *")
+
+;; NOTE: the following function executes without a transaction, this
+;; means that if something fails in the middle of this function, it
+;; will probably leave leaked/unreferenced objects in the database and
+;; probably in the storage layer. For handle possible object leakage,
+;; we create all media objects marked as touched, this ensures that if
+;; something fails, all leaked (already created storage objects) will
+;; be eventually marked as deleted by the touched-gc task.
+;;
+;; The touched-gc task, performs periodic analysis of all touched
+;; storage objects and check references of it. This is the reason why
+;; `reference` metadata exists: it indicates the name of the table
+;; witch holds the reference to storage object (it some kind of
+;; inverse, soft referential integrity).
+
+(defn create-file-media-object
+  [{:keys [storage pool climit executor] :as cfg}
+   {:keys [id file-id is-local name content] :as params}]
+  (letfn [;; Function responsible to retrieve the file information, as
+          ;; it is synchronous operation it should be wrapped into
+          ;; with-dispatch macro.
+          (get-info [content]
+            (climit/with-dispatch (:process-image climit)
+              (media/run {:cmd :info :input content})))
+
+          ;; Function responsible of calculating cryptographyc hash of
+          ;; the provided data.
+          (calculate-hash [data]
+            (px/with-dispatch executor
+              (sto/calculate-hash data)))
+
+          ;; Function responsible of generating thumnail. As it is synchronous
+          ;; opetation, it should be wrapped into with-dispatch macro
+          (generate-thumbnail [info]
+            (climit/with-dispatch (:process-image climit)
+              (media/run (assoc thumbnail-options
+                                :cmd :generic-thumbnail
+                                :input info))))
+
+          (create-thumbnail [info]
+            (when (and (not (svg-image? info))
+                       (big-enough-for-thumbnail? info))
+              (p/let [thumb   (generate-thumbnail info)
+                      hash    (calculate-hash (:data thumb))
+                      content (-> (sto/content (:data thumb) (:size thumb))
+                                  (sto/wrap-with-hash hash))]
+                (sto/put-object! storage
+                                 {::sto/content content
+                                  ::sto/deduplicate? true
+                                  ::sto/touched-at (dt/now)
+                                  :content-type (:mtype thumb)
+                                  :bucket "file-media-object"}))))
+
+          (create-image [info]
+            (p/let [data    (:path info)
+                    hash    (calculate-hash data)
+                    content (-> (sto/content data)
+                                (sto/wrap-with-hash hash))]
+              (sto/put-object! storage
+                               {::sto/content content
+                                ::sto/deduplicate? true
+                                ::sto/touched-at (dt/now)
+                                :content-type (:mtype info)
+                                :bucket "file-media-object"})))
+
+          (insert-into-database [info image thumb]
+            (px/with-dispatch executor
+              (db/exec-one! pool [sql:create-file-media-object
+                                  (or id (uuid/next))
+                                  file-id is-local name
+                                  (:id image)
+                                  (:id thumb)
+                                  (:width info)
+                                  (:height info)
+                                  (:mtype info)])))]
+
+    (p/let [info  (get-info content)
+            thumb (create-thumbnail info)
+            image (create-image info)]
+      (insert-into-database info image thumb))))
 
 ;; --- Create File Media Object (from URL)
 
-(s/def ::create-file-media-object-from-url ::cmd.media/create-file-media-object-from-url)
+(declare ^:private create-file-media-object-from-url)
+
+(s/def ::create-file-media-object-from-url
+  (s/keys :req-un [::profile-id ::file-id ::is-local ::url]
+          :opt-un [::id ::name]))
 
 (sv/defmethod ::create-file-media-object-from-url
-  {::doc/added "1.3"
-   ::doc/deprecated "1.18"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
-  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
-    (files/check-edition-permissions! pool profile-id file-id)
-    (#'cmd.media/create-file-media-object-from-url cfg params)))
+  (let [file (select-file pool file-id)
+        cfg  (update cfg :storage media/configure-assets-storage)]
+    (teams/check-edition-permissions! pool profile-id (:team-id file))
+    (create-file-media-object-from-url cfg params)))
+
+(defn- create-file-media-object-from-url
+  [cfg {:keys [url name] :as params}]
+  (letfn [(parse-and-validate-size [headers]
+            (let [size     (some-> (get headers "content-length") d/parse-integer)
+                  mtype    (get headers "content-type")
+                  format   (cm/mtype->format mtype)
+                  max-size (cf/get :media-max-file-size default-max-file-size)]
+
+              (when-not size
+                (ex/raise :type :validation
+                          :code :unknown-size
+                          :hint "seems like the url points to resource with unknown size"))
+
+              (when (> size max-size)
+                (ex/raise :type :validation
+                          :code :file-too-large
+                          :hint (str/ffmt "the file size % is greater than the maximum %"
+                                          size
+                                          default-max-file-size)))
+
+              (when (nil? format)
+                (ex/raise :type :validation
+                          :code :media-type-not-allowed
+                          :hint "seems like the url points to an invalid media object"))
+
+              {:size size
+               :mtype mtype
+               :format format}))
+
+          (download-media [uri]
+            (-> (http/req! cfg {:method :get :uri uri} {:response-type :input-stream})
+                (p/then process-response)))
+
+          (process-response [{:keys [body headers] :as response}]
+            (let [{:keys [size mtype]} (parse-and-validate-size headers)
+                  path                 (tmp/tempfile :prefix "penpot.media.download.")
+                  written              (io/write-to-file! body path :size size)]
+
+              (when (not= written size)
+                (ex/raise :type :internal
+                          :code :mismatch-write-size
+                          :hint "unexpected state: unable to write to file"))
+
+              {:filename "tempfile"
+               :size size
+               :path path
+               :mtype mtype}))]
+
+    (p/let [content (download-media url)]
+      (->> (merge params {:content content :name (or name (:filename content))})
+           (create-file-media-object cfg)))))
 
 ;; --- Clone File Media object (Upload and create from url)
 
-(s/def ::clone-file-media-object ::cmd.media/clone-file-media-object)
+(declare clone-file-media-object)
+
+(s/def ::clone-file-media-object
+  (s/keys :req-un [::profile-id ::file-id ::is-local ::id]))
 
 (sv/defmethod ::clone-file-media-object
-  {::doc/added "1.2"
-   ::doc/deprecated "1.18"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
-    (files/check-edition-permissions! conn profile-id file-id)
-    (-> (assoc cfg :conn conn)
-        (cmd.media/clone-file-media-object params))))
+    (let [file (select-file conn file-id)]
+      (teams/check-edition-permissions! conn profile-id (:team-id file))
+      (-> (assoc cfg :conn conn)
+          (clone-file-media-object params)))))
+
+(defn clone-file-media-object
+  [{:keys [conn] :as cfg} {:keys [id file-id is-local]}]
+  (let [mobj (db/get-by-id conn :file-media-object id)]
+    (db/insert! conn :file-media-object
+                {:id (uuid/next)
+                 :file-id file-id
+                 :is-local is-local
+                 :name (:name mobj)
+                 :media-id (:media-id mobj)
+                 :thumbnail-id (:thumbnail-id mobj)
+                 :width  (:width mobj)
+                 :height (:height mobj)
+                 :mtype  (:mtype mobj)})))
+
+;; --- HELPERS
+
+(def ^:private
+  sql:select-file
+  "select file.*,
+          project.team_id as team_id
+     from file
+    inner join project on (project.id = file.project_id)
+    where file.id = ?")
+
+(defn- select-file
+  [conn id]
+  (let [row (db/exec-one! conn [sql:select-file id])]
+    (when-not row
+      (ex/raise :type :not-found))
+    row))

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

@@ -11,18 +11,25 @@
    [app.common.spec :as us]
    [app.config :as cf]
    [app.db :as db]
+   [app.emails :as eml]
    [app.http.session :as session]
    [app.loggers.audit :as audit]
    [app.media :as media]
+   [app.rpc :as-alias rpc]
    [app.rpc.climit :as-alias climit]
-   [app.rpc.commands.profile :as profile]
+   [app.rpc.commands.auth :as cmd.auth]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
+   [app.rpc.mutations.teams :as teams]
+   [app.rpc.queries.profile :as profile]
    [app.storage :as sto]
+   [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]))
+   [cuerdas.core :as str]
+   [promesa.core :as p]
+   [promesa.exec :as px]))
 
 ;; --- Helpers & Specs
 
@@ -42,15 +49,14 @@
           :opt-un [::lang ::theme]))
 
 (sv/defmethod ::update-profile
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}]
+  {::doc/added "1.0"}
+  [{:keys [pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}]
   (db/with-atomic [conn pool]
     ;; NOTE: we need to retrieve the profile independently if we use
     ;; it or not for explicit locking and avoid concurrent updates of
     ;; the same row/object.
-    (let [profile (-> (db/get-by-id conn :profile profile-id ::db/for-update? true)
-                      (profile/decode-row))
+    (let [profile (-> (db/get-by-id conn :profile profile-id {:for-update true})
+                      (profile/decode-profile-row))
 
           ;; Update the profile map with direct params
           profile (-> profile
@@ -67,68 +73,161 @@
                   {:id profile-id})
 
       (-> profile
-          (profile/strip-private-attrs)
-          (d/without-nils)
+          profile/strip-private-attrs
+          d/without-nils
           (rph/with-meta {::audit/props (audit/profile->props profile)})))))
 
 
 ;; --- MUTATION: Update Password
 
+(declare validate-password!)
+(declare update-profile-password!)
+(declare invalidate-profile-session!)
+
 (s/def ::update-profile-password
   (s/keys :req-un [::profile-id ::password ::old-password]))
 
 (sv/defmethod ::update-profile-password
-  {::climit/queue :auth
-   ::doc/added "1.0"
-   ::doc/deprecated "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [password] :as params}]
+  {::climit/queue :auth}
+  [{:keys [pool] :as cfg} {:keys [password] :as params}]
   (db/with-atomic [conn pool]
-    (let [profile    (#'profile/validate-password! conn params)
-          session-id (::session/id params)]
+    (let [profile    (validate-password! conn params)
+          session-id (::rpc/session-id params)]
       (when (= (str/lower (:email profile))
                (str/lower (:password params)))
         (ex/raise :type :validation
                   :code :email-as-password
                   :hint "you can't use your email as password"))
-      (profile/update-profile-password! conn (assoc profile :password password))
-      (#'profile/invalidate-profile-session! conn (:id profile) session-id)
+      (update-profile-password! conn (assoc profile :password password))
+      (invalidate-profile-session! conn (:id profile) session-id)
       nil)))
 
+(defn- invalidate-profile-session!
+  "Removes all sessions except the current one."
+  [conn profile-id session-id]
+  (let [sql "delete from http_session where profile_id = ? and id != ?"]
+    (:next.jdbc/update-count (db/exec-one! conn [sql profile-id session-id]))))
+
+(defn- validate-password!
+  [conn {:keys [profile-id old-password] :as params}]
+  (let [profile (db/get-by-id conn :profile profile-id)]
+    (when-not (:valid (cmd.auth/verify-password old-password (:password profile)))
+      (ex/raise :type :validation
+                :code :old-password-not-match))
+    profile))
+
+(defn update-profile-password!
+  [conn {:keys [id password] :as profile}]
+  (db/update! conn :profile
+              {:password (cmd.auth/derive-password password)}
+              {:id id}))
 
 ;; --- MUTATION: Update Photo
 
+(declare update-profile-photo)
+
 (s/def ::file ::media/upload)
 (s/def ::update-profile-photo
   (s/keys :req-un [::profile-id ::file]))
 
 (sv/defmethod ::update-profile-photo
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"}
   [cfg {:keys [file] :as params}]
   ;; Validate incoming mime type
   (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
-  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
-    (profile/update-profile-photo cfg params)))
+  (let [cfg (update cfg :storage media/configure-assets-storage)]
+    (update-profile-photo cfg params)))
+
+(defn update-profile-photo
+  [{:keys [pool storage executor] :as cfg} {:keys [profile-id file] :as params}]
+  (p/let [profile (px/with-dispatch executor
+                    (db/get-by-id pool :profile profile-id))
+          photo   (teams/upload-photo cfg params)]
+
+    ;; Schedule deletion of old photo
+    (when-let [id (:photo-id profile)]
+      (sto/touch-object! storage id))
+
+    ;; Save new photo
+    (db/update! pool :profile
+                {:photo-id (:id photo)}
+                {:id profile-id})
+
+    (-> (rph/wrap)
+        (rph/with-meta {::audit/replace-props
+                        {:file-name (:filename file)
+                         :file-size (:size file)
+                         :file-path (str (:path file))
+                         :file-mtype (:mtype file)}}))))
 
 ;; --- MUTATION: Request Email Change
 
+(declare request-email-change)
+(declare change-email-immediately)
+
 (s/def ::request-email-change
   (s/keys :req-un [::email]))
 
 (sv/defmethod ::request-email-change
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id email] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id email] :as params}]
   (db/with-atomic [conn pool]
     (let [profile (db/get-by-id conn :profile profile-id)
-          cfg     (assoc cfg ::profile/conn conn)
+          cfg     (assoc cfg :conn conn)
           params  (assoc params
                          :profile profile
                          :email (str/lower email))]
-
       (if (contains? cf/flags :smtp)
-        (#'profile/request-email-change! cfg params)
-        (#'profile/change-email-immediately! cfg params)))))
+        (request-email-change cfg params)
+        (change-email-immediately cfg params)))))
+
+(defn- change-email-immediately
+  [{:keys [conn]} {:keys [profile email] :as params}]
+  (when (not= email (:email profile))
+    (cmd.auth/check-profile-existence! conn params))
+  (db/update! conn :profile
+              {:email email}
+              {:id (:id profile)})
+  {:changed true})
+
+(defn- request-email-change
+  [{:keys [conn sprops] :as cfg} {:keys [profile email] :as params}]
+  (let [token   (tokens/generate sprops
+                                 {:iss :change-email
+                                  :exp (dt/in-future "15m")
+                                  :profile-id (:id profile)
+                                  :email email})
+        ptoken  (tokens/generate sprops
+                                 {:iss :profile-identity
+                                  :profile-id (:id profile)
+                                  :exp (dt/in-future {:days 30})})]
+
+    (when (not= email (:email profile))
+      (cmd.auth/check-profile-existence! conn params))
+
+    (when-not (eml/allow-send-emails? conn profile)
+      (ex/raise :type :validation
+                :code :profile-is-muted
+                :hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
+
+    (when (eml/has-bounce-reports? conn email)
+      (ex/raise :type :validation
+                :code :email-has-permanent-bounces
+                :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
+
+    (eml/send! {::eml/conn conn
+                ::eml/factory eml/change-email
+                :public-uri (:public-uri cfg)
+                :to (:email profile)
+                :name (:fullname profile)
+                :pending-email email
+                :token token
+                :extra-data ptoken})
+    nil))
+
+
+(defn select-profile-for-update
+  [conn id]
+  (db/get-by-id conn :profile id {:for-update true}))
+
 
 ;; --- MUTATION: Update Profile Props
 
@@ -137,11 +236,9 @@
   (s/keys :req-un [::profile-id ::props]))
 
 (sv/defmethod ::update-profile-props
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id props]}]
+  [{:keys [pool] :as cfg} {:keys [profile-id props]}]
   (db/with-atomic [conn pool]
-    (let [profile (profile/get-profile conn profile-id ::db/for-update? true)
+    (let [profile (profile/retrieve-profile-data conn profile-id)
           props   (reduce-kv (fn [props k v]
                                ;; We don't accept namespaced keys
                                (if (simple-ident? k)
@@ -156,20 +253,22 @@
                   {:props (db/tjson props)}
                   {:id profile-id})
 
-      (profile/filter-props props))))
+      (profile/filter-profile-props props))))
 
 
 ;; --- MUTATION: Delete Profile
 
+(declare get-owned-teams-with-participants)
+(declare check-can-delete-profile!)
+(declare mark-profile-as-deleted!)
+
 (s/def ::delete-profile
   (s/keys :req-un [::profile-id]))
 
 (sv/defmethod ::delete-profile
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id] :as params}]
+  [{:keys [pool session] :as cfg} {:keys [profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [teams      (#'profile/get-owned-teams-with-participants conn profile-id)
+    (let [teams      (get-owned-teams-with-participants conn profile-id)
           deleted-at (dt/now)]
 
       ;; If we found owned teams with participants, we don't allow
@@ -190,4 +289,22 @@
                   {:deleted-at deleted-at}
                   {:id profile-id})
 
-      (rph/with-transform {} (session/delete-fn cfg)))))
+      (rph/with-transform {} (session/delete-fn session)))))
+
+(def sql:owned-teams
+  "with owner_teams as (
+      select tpr.team_id as id
+        from team_profile_rel as tpr
+       where tpr.is_owner is true
+         and tpr.profile_id = ?
+   )
+   select tpr.team_id as id,
+          count(tpr.profile_id) - 1 as participants
+     from team_profile_rel as tpr
+    where tpr.team_id in (select id from owner_teams)
+      and tpr.profile_id != ?
+    group by 1")
+
+(defn- get-owned-teams-with-participants
+  [conn profile-id]
+  (db/exec! conn [sql:owned-teams profile-id profile-id]))

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

@@ -7,14 +7,15 @@
 (ns app.rpc.mutations.projects
   (:require
    [app.common.spec :as us]
+   [app.common.uuid :as uuid]
    [app.db :as db]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
-   [app.rpc.commands.projects :as projects]
-   [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
-   [app.rpc.quotes :as quotes]
+   [app.rpc.permissions :as perms]
+   [app.rpc.queries.projects :as proj]
+   [app.rpc.queries.teams :as teams]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]))
@@ -27,6 +28,10 @@
 
 ;; --- Mutation: Create Project
 
+(declare create-project)
+(declare create-project-role)
+(declare create-team-project-profile)
+
 (s/def ::team-id ::us/uuid)
 (s/def ::create-project
   (s/keys :req-un [::profile-id ::team-id ::name]
@@ -34,26 +39,45 @@
 
 (sv/defmethod ::create-project
   {::doc/added "1.0"
-   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [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})
-
-    (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 true})
-
+    (let [project (create-project conn params)
+          params  (assoc params
+                         :project-id (:id project)
+                         :role :owner)]
+      (create-project-role conn params)
+      (create-team-project-profile conn params)
       (assoc project :is-pinned true))))
 
+(defn create-project
+  [conn {:keys [id team-id name is-default] :as params}]
+  (let [id         (or id (uuid/next))
+        is-default (if (boolean? is-default) is-default false)]
+    (db/insert! conn :project
+                {:id id
+                 :name name
+                 :team-id team-id
+                 :is-default is-default})))
+
+(defn create-project-role
+  [conn {:keys [project-id profile-id role]}]
+  (let [params {:project-id project-id
+                :profile-id profile-id}]
+    (->> (perms/assign-role-flags params role)
+         (db/insert! conn :project-profile-rel))))
+
+;; TODO: pending to be refactored
+(defn create-team-project-profile
+  [conn {:keys [team-id project-id profile-id] :as params}]
+  (db/insert! conn :team-project-profile-rel
+              {:project-id project-id
+               :profile-id profile-id
+               :team-id team-id
+               :is-pinned true}))
+
+
 ;; --- Mutation: Toggle Project Pin
 
 (def ^:private
@@ -70,17 +94,13 @@
   (s/keys :req-un [::profile-id ::id ::team-id ::is-pinned]))
 
 (sv/defmethod ::update-project-pin
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"
-   ::webhooks/batch-timeout (dt/duration "5s")
-   ::webhooks/batch-key :id
-   ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id profile-id team-id is-pinned] :as params}]
   (db/with-atomic [conn pool]
-    (projects/check-edition-permissions! conn profile-id id)
+    (proj/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))
 
+
 ;; --- Mutation: Rename Project
 
 (declare rename-project)
@@ -89,20 +109,13 @@
   (s/keys :req-un [::profile-id ::name ::id]))
 
 (sv/defmethod ::rename-project
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"
-   ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id profile-id name] :as params}]
   (db/with-atomic [conn pool]
-    (projects/check-edition-permissions! conn profile-id id)
-    (let [project (db/get-by-id conn :project id)]
-      (db/update! conn :project
-                  {:name name}
-                  {:id id})
-
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:team-id (:team-id project)
-                        :prev-name (:name project)}}))))
+    (proj/check-edition-permissions! conn profile-id id)
+    (db/update! conn :project
+                {:name name}
+                {:id id})
+    nil))
 
 ;; --- Mutation: Delete Project
 
@@ -115,16 +128,12 @@
 
 (sv/defmethod ::delete-project
   {::doc/added "1.0"
-   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (projects/check-edition-permissions! conn profile-id id)
+    (proj/check-edition-permissions! conn profile-id id)
     (let [project (db/update! conn :project
                               {:deleted-at (dt/now)}
                               {:id id :is-default false})]
       (rph/with-meta (rph/wrap)
-        {::audit/props {:team-id (:team-id project)
-                        :name (:name project)
-                        :created-at (:created-at project)
-                        :modified-at (:modified-at project)}}))))
+        {::audit/props {:team-id (:team-id project)}}))))

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

@@ -11,7 +11,6 @@
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.rpc.commands.files :as files]
-   [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
@@ -36,9 +35,8 @@
 
   Share links are resources that allows external users access to specific
   pages of a file with specific permissions (who-comment and who-inspect)."
-  {::doc/added "1.5"
-   ::doc/deprecated "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id file-id] :as params}]
+
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (create-share-link conn params)))
@@ -53,17 +51,18 @@
                            :who-inspect who-inspect
                            :pages pages
                            :owner-id profile-id})]
-    (update slink :pages db/decode-pgarray #{})))
+    (-> slink
+        (update :pages db/decode-pgarray #{}))))
 
 ;; --- Mutation: Delete Share Link
 
+(declare delete-share-link)
+
 (s/def ::delete-share-link
   (s/keys :req-un [::profile-id ::id]))
 
 (sv/defmethod ::delete-share-link
-  {::doc/added "1.5"
-   ::doc/deprecated "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (let [slink (db/get-by-id conn :share-link id)]
       (files/check-edition-permissions! conn profile-id (:file-id slink))

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

@@ -0,0 +1,537 @@
+;; 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.mutations.teams
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.emails :as eml]
+   [app.loggers.audit :as audit]
+   [app.media :as media]
+   [app.rpc.climit :as climit]
+   [app.rpc.helpers :as rph]
+   [app.rpc.mutations.projects :as projects]
+   [app.rpc.permissions :as perms]
+   [app.rpc.queries.profile :as profile]
+   [app.rpc.queries.teams :as teams]
+   [app.storage :as sto]
+   [app.tokens :as tokens]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [promesa.core :as p]
+   [promesa.exec :as px]))
+
+;; --- Helpers & Specs
+
+(s/def ::id ::us/uuid)
+(s/def ::name ::us/string)
+(s/def ::profile-id ::us/uuid)
+
+;; --- Mutation: Create Team
+
+(declare create-team)
+(declare create-team-entry)
+(declare create-team-role)
+(declare create-team-default-project)
+
+(s/def ::create-team
+  (s/keys :req-un [::profile-id ::name]
+          :opt-un [::id]))
+
+(sv/defmethod ::create-team
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (create-team conn params)))
+
+(defn create-team
+  "This is a complete team creation process, it creates the team
+  object and all related objects (default role and default project)."
+  [conn params]
+  (let [team    (create-team-entry conn params)
+        params  (assoc params
+                       :team-id (:id team)
+                       :role :owner)
+        project (create-team-default-project conn params)]
+    (create-team-role conn params)
+    (assoc team :default-project-id (:id project))))
+
+(defn- create-team-entry
+  [conn {:keys [id name is-default] :as params}]
+  (let [id         (or id (uuid/next))
+        is-default (if (boolean? is-default) is-default false)]
+    (db/insert! conn :team
+                {:id id
+                 :name name
+                 :is-default is-default})))
+
+(defn- create-team-role
+  [conn {:keys [team-id profile-id role] :as params}]
+  (let [params {:team-id team-id
+                :profile-id profile-id}]
+    (->> (perms/assign-role-flags params role)
+         (db/insert! conn :team-profile-rel))))
+
+(defn- create-team-default-project
+  [conn {:keys [team-id profile-id] :as params}]
+  (let [project {:id (uuid/next)
+                 :team-id team-id
+                 :name "Drafts"
+                 :is-default true}
+        project (projects/create-project conn project)]
+    (projects/create-project-role conn {:project-id (:id project)
+                                        :profile-id profile-id
+                                        :role :owner})
+    project))
+
+;; --- Mutation: Update Team
+
+(s/def ::update-team
+  (s/keys :req-un [::profile-id ::name ::id]))
+
+(sv/defmethod ::update-team
+  [{:keys [pool] :as cfg} {:keys [id name profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (teams/check-edition-permissions! conn profile-id id)
+    (db/update! conn :team
+                {:name name}
+                {:id id})
+    nil))
+
+
+;; --- Mutation: Leave Team
+
+(declare role->params)
+
+(s/def ::reassign-to ::us/uuid)
+(s/def ::leave-team
+  (s/keys :req-un [::profile-id ::id]
+          :opt-un [::reassign-to]))
+
+(sv/defmethod ::leave-team
+  [{:keys [pool] :as cfg} {:keys [id profile-id reassign-to]}]
+  (db/with-atomic [conn pool]
+    (let [perms   (teams/get-permissions conn profile-id id)
+          members (teams/retrieve-team-members conn id)]
+
+      (cond
+        ;; we can only proceed if there are more members in the team
+        ;; besides the current profile
+        (<= (count members) 1)
+        (ex/raise :type :validation
+                  :code :no-enough-members-for-leave
+                  :context {:members (count members)})
+
+        ;; if the `reassign-to` is filled and has a different value
+        ;; than the current profile-id, we proceed to reassing the
+        ;; owner role to profile identified by the `reassign-to`.
+        (and reassign-to (not= reassign-to profile-id))
+        (let [member (d/seek #(= reassign-to (:id %)) members)]
+          (when-not member
+            (ex/raise :type :not-found :code :member-does-not-exist))
+
+          ;; unasign owner role to current profile
+          (db/update! conn :team-profile-rel
+                      {:is-owner false}
+                      {:team-id id
+                       :profile-id profile-id})
+
+          ;; assign owner role to new profile
+          (db/update! conn :team-profile-rel
+                      (role->params :owner)
+                      {:team-id id :profile-id reassign-to}))
+
+        ;; and finally, if all other conditions does not match and the
+        ;; current profile is owner, we dont allow it because there
+        ;; must always be an owner.
+        (:is-owner perms)
+        (ex/raise :type :validation
+                  :code :owner-cant-leave-team
+                  :hint "releasing owner before leave"))
+
+      (db/delete! conn :team-profile-rel
+                  {:profile-id profile-id
+                   :team-id id})
+
+      nil)))
+
+;; --- Mutation: Delete Team
+
+(s/def ::delete-team
+  (s/keys :req-un [::profile-id ::id]))
+
+;; TODO: right now just don't allow delete default team, in future it
+;; should raise a specific exception for signal that this action is
+;; not allowed.
+
+(sv/defmethod ::delete-team
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [perms (teams/get-permissions conn profile-id id)]
+      (when-not (:is-owner perms)
+        (ex/raise :type :validation
+                  :code :only-owner-can-delete-team))
+
+      (db/update! conn :team
+                  {:deleted-at (dt/now)}
+                  {:id id :is-default false})
+      nil)))
+
+
+;; --- Mutation: Team Update Role
+
+(declare retrieve-team-member)
+
+(s/def ::team-id ::us/uuid)
+(s/def ::member-id ::us/uuid)
+;; Temporarily disabled viewer role
+;; https://tree.taiga.io/project/uxboxproject/issue/1083
+;; (s/def ::role #{:owner :admin :editor :viewer})
+(s/def ::role #{:owner :admin :editor})
+
+(s/def ::update-team-member-role
+  (s/keys :req-un [::profile-id ::team-id ::member-id ::role]))
+
+(sv/defmethod ::update-team-member-role
+  [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id role] :as params}]
+  (db/with-atomic [conn pool]
+    (let [perms (teams/get-permissions conn profile-id team-id)
+          ;; 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,
+          ;; we will change it to more efficient fetch mechanisms.
+          members (teams/retrieve-team-members conn team-id)
+          member  (d/seek #(= member-id (:id %)) members)
+
+          is-owner? (:is-owner perms)
+          is-admin? (:is-admin perms)]
+
+      ;; If no member is found, just 404
+      (when-not member
+        (ex/raise :type :not-found
+                  :code :member-does-not-exist))
+
+      ;; First check if we have permissions to change roles
+      (when-not (or is-owner? is-admin?)
+        (ex/raise :type :validation
+                  :code :insufficient-permissions))
+
+      ;; Don't allow change role of owner member
+      (when (:is-owner member)
+        (ex/raise :type :validation
+                  :code :cant-change-role-to-owner))
+
+      ;; Don't allow promote to owner to admin users.
+      (when (and (not is-owner?) (= role :owner))
+        (ex/raise :type :validation
+                  :code :cant-promote-to-owner))
+
+      (let [params (role->params role)]
+        ;; Only allow single owner on team
+        (when (= role :owner)
+          (db/update! conn :team-profile-rel
+                      {:is-owner false}
+                      {:team-id team-id
+                       :profile-id profile-id}))
+
+        (db/update! conn :team-profile-rel
+                    params
+                    {:team-id team-id
+                     :profile-id member-id})
+        nil))))
+
+(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}))
+
+
+;; --- Mutation: Delete Team Member
+
+(s/def ::delete-team-member
+  (s/keys :req-un [::profile-id ::team-id ::member-id]))
+
+(sv/defmethod ::delete-team-member
+  [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [perms (teams/get-permissions conn profile-id team-id)]
+      (when-not (or (:is-owner perms)
+                    (:is-admin perms))
+        (ex/raise :type :validation
+                  :code :insufficient-permissions))
+
+      (when (= member-id profile-id)
+        (ex/raise :type :validation
+                  :code :cant-remove-yourself))
+
+      (db/delete! conn :team-profile-rel {:profile-id member-id
+                                          :team-id team-id})
+
+      nil)))
+
+;; --- Mutation: Update Team Photo
+
+(declare ^:private upload-photo)
+(declare ^:private update-team-photo)
+
+(s/def ::file ::media/upload)
+(s/def ::update-team-photo
+  (s/keys :req-un [::profile-id ::team-id ::file]))
+
+(sv/defmethod ::update-team-photo
+  [cfg {:keys [file] :as params}]
+  ;; Validate incoming mime type
+  (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
+  (let [cfg (update cfg :storage media/configure-assets-storage)]
+    (update-team-photo cfg params)))
+
+(defn update-team-photo
+  [{:keys [pool storage executor] :as cfg} {:keys [profile-id team-id] :as params}]
+  (p/let [team  (px/with-dispatch executor
+                  (teams/retrieve-team pool profile-id team-id))
+          photo (upload-photo cfg params)]
+
+    ;; Mark object as touched for make it ellegible for tentative
+    ;; garbage collection.
+    (when-let [id (:photo-id team)]
+      (sto/touch-object! storage id))
+
+    ;; Save new photo
+    (db/update! pool :team
+                {:photo-id (:id photo)}
+                {:id team-id})
+
+    (assoc team :photo-id (:id photo))))
+
+(defn upload-photo
+  [{:keys [storage executor climit] :as cfg} {:keys [file]}]
+  (letfn [(get-info [content]
+            (climit/with-dispatch (:process-image climit)
+              (media/run {:cmd :info :input content})))
+
+          (generate-thumbnail [info]
+            (climit/with-dispatch (:process-image climit)
+              (media/run {:cmd :profile-thumbnail
+                          :format :jpeg
+                          :quality 85
+                          :width 256
+                          :height 256
+                          :input info})))
+
+          ;; Function responsible of calculating cryptographyc hash of
+          ;; the provided data.
+          (calculate-hash [data]
+            (px/with-dispatch executor
+              (sto/calculate-hash data)))]
+
+    (p/let [info    (get-info file)
+            thumb   (generate-thumbnail info)
+            hash    (calculate-hash (:data thumb))
+            content (-> (sto/content (:data thumb) (:size thumb))
+                        (sto/wrap-with-hash hash))]
+      (sto/put-object! storage {::sto/content content
+                                ::sto/deduplicate? true
+                                :bucket "profile"
+                                :content-type (:mtype thumb)}))))
+
+;; --- Mutation: Invite Member
+
+(declare create-team-invitation)
+
+(s/def ::email ::us/email)
+(s/def ::emails ::us/set-of-valid-emails)
+(s/def ::invite-team-member
+  (s/keys :req-un [::profile-id ::team-id ::role]
+          :opt-un [::email ::emails]))
+
+(sv/defmethod ::invite-team-member
+  "A rpc call that allow to send a single or multiple invitations to
+  join the team."
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id email emails role] :as params}]
+  (db/with-atomic [conn pool]
+    (let [perms    (teams/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   (cond-> (or emails #{}) (string? email) (conj email))]
+
+      (when-not (:is-admin perms)
+        (ex/raise :type :validation
+                  :code :insufficient-permissions))
+
+      ;; First check if the current profile is allowed to send emails.
+      (when-not (eml/allow-send-emails? conn profile)
+        (ex/raise :type :validation
+                  :code :profile-is-muted
+                  :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
+
+      (let [invitations (->> emails
+                             (map (fn [email]
+                                    (assoc cfg
+                                           :email email
+                                           :conn conn
+                                           :team team
+                                           :profile profile
+                                           :role role)))
+                             (map create-team-invitation))]
+        (with-meta (vec invitations)
+          {::audit/props {:invitations (count invitations)}})))))
+
+(def sql:upsert-team-invitation
+  "insert into team_invitation(team_id, email_to, role, valid_until)
+   values (?, ?, ?, ?)
+       on conflict(team_id, email_to) do
+          update set role = ?, valid_until = ?, updated_at = now();")
+
+(defn- create-team-invitation
+  [{:keys [conn sprops team profile role email] :as cfg}]
+  (let [member    (profile/retrieve-profile-data-by-email conn email)
+        token-exp (dt/in-future "168h") ;; 7 days
+        email     (str/lower email)
+        itoken    (tokens/generate sprops
+                                   {:iss :team-invitation
+                                    :exp token-exp
+                                    :profile-id (:id profile)
+                                    :role role
+                                    :team-id (:id team)
+                                    :member-email (:email member email)
+                                    :member-id (:id member)})
+        ptoken    (tokens/generate sprops
+                                   {:iss :profile-identity
+                                    :profile-id (:id profile)
+                                    :exp (dt/in-future {:days 30})})]
+
+    (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"))
+
+    ;; Secondly check if the invited member email is part of the global spam/bounce report.
+    (when (eml/has-bounce-reports? conn email)
+      (ex/raise :type :validation
+                :code :email-has-permanent-bounces
+                :email email
+                :hint "the email you invite has been repeatedly reported as spam or bounce"))
+
+    (when (contains? cf/flags :log-invitation-tokens)
+      (l/trace :hint "invitation token" :token itoken))
+
+    ;; 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 {: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)})))
+      (do
+        (db/exec-one! conn [sql:upsert-team-invitation
+                            (:id team) (str/lower email) (name role)
+                            token-exp (name role) token-exp])
+        (eml/send! {::eml/conn conn
+                    ::eml/factory eml/invite-to-team
+                    :public-uri (:public-uri cfg)
+                    :to email
+                    :invited-by (:fullname profile)
+                    :team (:name team)
+                    :token itoken
+                    :extra-data ptoken})))
+
+    itoken))
+
+;; --- Mutation: Create Team & Invite Members
+
+(s/def ::emails ::us/set-of-valid-emails)
+(s/def ::create-team-and-invite-members
+  (s/and ::create-team (s/keys :req-un [::emails ::role])))
+
+(sv/defmethod ::create-team-and-invite-members
+  [{:keys [pool] :as cfg} {:keys [profile-id emails role] :as params}]
+  (db/with-atomic [conn pool]
+    (let [team     (create-team conn params)
+          profile  (db/get-by-id conn :profile profile-id)]
+
+      ;; Create invitations for all provided emails.
+      (doseq [email emails]
+        (create-team-invitation
+         (assoc cfg
+                :conn conn
+                :team team
+                :profile profile
+                :email email
+                :role role)))
+
+      (-> team
+          (vary-meta assoc ::audit/props {:invitations (count emails)})
+          (rph/with-defer
+            #(when-let [collector (::audit/collector cfg)]
+               (audit/submit! collector
+                              {:type "mutation"
+                               :name "invite-team-member"
+                               :profile-id profile-id
+                               :props {:emails emails
+                                       :role role
+                                       :profile-id profile-id
+                                       :invitations (count emails)}})))))))
+
+;; --- Mutation: Update invitation role
+
+(s/def ::update-team-invitation-role
+  (s/keys :req-un [::profile-id ::team-id ::email ::role]))
+
+(sv/defmethod ::update-team-invitation-role
+  [{:keys [pool] :as cfg} {:keys [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 (str/lower email)})
+      nil)))
+
+;; --- Mutation: Delete invitation
+
+(s/def ::delete-team-invitation
+  (s/keys :req-un [::profile-id ::team-id ::email]))
+
+(sv/defmethod ::delete-team-invitation
+  [{:keys [pool] :as cfg} {:keys [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))
+
+      (db/delete! conn :team-invitation
+                {:team-id team-id :email-to (str/lower email)})
+      nil)))

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

@@ -0,0 +1,28 @@
+;; 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.mutations.verify-token
+  (:require
+   [app.db :as db]
+   [app.rpc.commands.verify-token :refer [process-token]]
+   [app.rpc.doc :as-alias doc]
+   [app.tokens :as tokens]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+(s/def ::verify-token
+  (s/keys :req-un [::token]
+          :opt-un [::profile-id]))
+
+(sv/defmethod ::verify-token
+  {:auth false
+   ::doc/added "1.1"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool sprops] :as cfg} {:keys [token] :as params}]
+  (db/with-atomic [conn pool]
+    (let [claims (tokens/verify sprops {:token token})
+          cfg    (assoc cfg :conn conn)]
+      (process-token cfg params claims))))

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

@@ -0,0 +1,82 @@
+;; 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.queries.comments
+  (:require
+   [app.db :as db]
+   [app.rpc.commands.comments :as cmd.comments]
+   [app.rpc.commands.files :as cmd.files]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.queries.teams :as teams]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+(defn decode-row
+  [{:keys [participants position] :as row}]
+  (cond-> row
+    (db/pgpoint? position) (assoc :position (db/decode-pgpoint position))
+    (db/pgobject? participants) (assoc :participants (db/decode-transit-pgobject participants))))
+
+;; --- QUERY: Comment Threads
+
+(s/def ::comment-threads ::cmd.comments/get-comment-threads)
+
+(sv/defmethod ::comment-threads
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} params]
+  (with-open [conn (db/open pool)]
+    (cmd.comments/retrieve-comment-threads conn params)))
+
+;; --- QUERY: Unread Comment Threads
+
+(s/def ::unread-comment-threads ::cmd.comments/get-unread-comment-threads)
+
+(sv/defmethod ::unread-comment-threads
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (teams/check-read-permissions! conn profile-id team-id)
+    (cmd.comments/retrieve-unread-comment-threads conn params)))
+
+;; --- QUERY: Single Comment Thread
+
+(s/def ::comment-thread ::cmd.comments/get-comment-thread)
+
+(sv/defmethod ::comment-thread
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (cmd.files/check-comment-permissions! conn profile-id file-id share-id)
+    (cmd.comments/get-comment-thread conn params)))
+
+;; --- QUERY: Comments
+
+(s/def ::comments ::cmd.comments/get-comments)
+
+(sv/defmethod ::comments
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool] :as cfg} {:keys [profile-id thread-id share-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (let [thread (db/get-by-id conn :comment-thread thread-id)]
+      (cmd.files/check-comment-permissions! conn profile-id (:file-id thread) share-id))
+    (cmd.comments/get-comments conn thread-id)))
+
+
+;; --- QUERY: Get file comments users
+
+(s/def ::file-comments-users ::cmd.comments/get-profiles-for-file-comments)
+
+(sv/defmethod ::file-comments-users
+  {::doc/deprecated "1.15"
+   ::doc/added "1.13"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id]}]
+  (with-open [conn (db/open pool)]
+    (cmd.files/check-comment-permissions! conn profile-id file-id share-id)
+    (cmd.comments/get-file-comments-users conn file-id profile-id)))

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

@@ -0,0 +1,184 @@
+;; 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.queries.files
+  (:require
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.rpc.commands.files :as cmd.files]
+   [app.rpc.commands.search :as cmd.search]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.helpers :as rph]
+   [app.rpc.queries.projects :as projects]
+   [app.rpc.queries.teams :as teams]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+;; --- Query: Project Files
+
+(s/def ::project-files ::cmd.files/get-project-files)
+
+(sv/defmethod ::project-files
+  {::doc/added "1.1"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (projects/check-read-permissions! conn profile-id project-id)
+    (cmd.files/get-project-files conn project-id)))
+
+;; --- Query: File (By ID)
+
+(s/def ::components-v2 ::us/boolean)
+(s/def ::file
+  (s/and ::cmd.files/get-file
+         (s/keys :opt-un [::components-v2])))
+
+(defn get-file
+  [conn id features]
+  (let [file   (cmd.files/get-file conn id features)
+        thumbs (cmd.files/get-object-thumbnails conn id)]
+    (assoc file :thumbnails thumbs)))
+
+(sv/defmethod ::file
+  "Retrieve a file by its ID. Only authenticated users."
+  {::doc/added "1.0"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id id features components-v2] :as params}]
+  (with-open [conn (db/open pool)]
+    (let [perms    (cmd.files/get-permissions pool profile-id id)
+          ;; BACKWARD COMPATIBILTY with the components-v2 parameter
+          features (cond-> (or features #{})
+                     components-v2 (conj "components/v2"))]
+
+      (cmd.files/check-read-permissions! perms)
+      (-> (get-file conn id features)
+          (assoc :permissions perms)))))
+
+;; --- QUERY: page
+
+(s/def ::page
+  (s/and ::cmd.files/get-page
+         (s/keys :opt-un [::components-v2])))
+
+(sv/defmethod ::page
+  "Retrieves the page data from file and returns it. If no page-id is
+  specified, the first page will be returned. If object-id is
+  specified, only that object and its children will be returned in the
+  page objects data structure.
+
+  If you specify the object-id, the page-id parameter becomes
+  mandatory.
+
+  Mainly used for rendering purposes."
+  {::doc/added "1.5"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id features components-v2] :as params}]
+  (with-open [conn (db/open pool)]
+    (cmd.files/check-read-permissions! conn profile-id file-id)
+    (let [;; BACKWARD COMPATIBILTY with the components-v2 parameter
+          features (cond-> (or features #{})
+                     components-v2 (conj "components/v2"))
+          params   (assoc params :features features)]
+
+      (cmd.files/get-page conn params))))
+
+;; --- QUERY: file-data-for-thumbnail
+
+(s/def ::file-data-for-thumbnail
+  (s/and ::cmd.files/get-file-data-for-thumbnail
+         (s/keys :opt-un [::components-v2])))
+
+(sv/defmethod ::file-data-for-thumbnail
+  "Retrieves the data for generate the thumbnail of the file. Used
+  mainly for render thumbnails on dashboard."
+  {::doc/added "1.11"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id features components-v2] :as props}]
+  (with-open [conn (db/open pool)]
+    (cmd.files/check-read-permissions! conn profile-id file-id)
+    (let [;; BACKWARD COMPATIBILTY with the components-v2 parameter
+          features (cond-> (or features #{})
+                     components-v2 (conj "components/v2"))
+          file     (cmd.files/get-file conn file-id features)]
+      {:file-id file-id
+       :revn (:revn file)
+       :page (cmd.files/get-file-data-for-thumbnail conn file)})))
+
+;; --- Query: Shared Library Files
+
+(s/def ::team-shared-files ::cmd.files/get-team-shared-files)
+
+(sv/defmethod ::team-shared-files
+  {::doc/added "1.3"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (teams/check-read-permissions! conn profile-id team-id)
+    (cmd.files/get-team-shared-files conn params)))
+
+
+;; --- Query: File Libraries used by a File
+
+(s/def ::file-libraries ::cmd.files/get-file-libraries)
+
+(sv/defmethod ::file-libraries
+  {::doc/added "1.3"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id features] :as params}]
+  (with-open [conn (db/open pool)]
+    (cmd.files/check-read-permissions! conn profile-id file-id)
+    (cmd.files/get-file-libraries conn file-id features)))
+
+
+;; --- Query: Files that use this File library
+
+(s/def ::library-using-files ::cmd.files/get-library-file-references)
+
+(sv/defmethod ::library-using-files
+  {::doc/added "1.13"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (cmd.files/check-read-permissions! conn profile-id file-id)
+    (cmd.files/get-library-file-references conn file-id)))
+
+;; --- QUERY: team-recent-files
+
+(s/def ::team-recent-files ::cmd.files/get-team-recent-files)
+
+(sv/defmethod ::team-recent-files
+  {::doc/added "1.0"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+  (with-open [conn (db/open pool)]
+    (teams/check-read-permissions! conn profile-id team-id)
+    (cmd.files/get-team-recent-files conn team-id)))
+
+
+;; --- QUERY: get file thumbnail
+
+(s/def ::file-thumbnail ::cmd.files/get-file-thumbnail)
+
+(sv/defmethod ::file-thumbnail
+  {::doc/added "1.13"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool]} {:keys [profile-id file-id revn]}]
+  (with-open [conn (db/open pool)]
+    (cmd.files/check-read-permissions! conn profile-id file-id)
+    (-> (cmd.files/get-file-thumbnail conn file-id revn)
+        (rph/with-http-cache cmd.files/long-cache-duration))))
+
+
+;; --- QUERY: search files
+
+(s/def ::search-files ::cmd.search/search-files)
+
+(sv/defmethod ::search-files
+  {::doc/added "1.0"
+   ::doc/deprecated "1.17"}
+  [{:keys [pool]} {:keys [search-term] :as params}]
+  (when search-term
+    (cmd.search/search-files pool params)))

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

@@ -9,15 +9,30 @@
    [app.common.spec :as us]
    [app.db :as db]
    [app.rpc.commands.files :as files]
-   [app.rpc.commands.projects :as projects]
-   [app.rpc.commands.teams :as teams]
-   [app.rpc.doc :as-alias doc]
+   [app.rpc.queries.projects :as projects]
+   [app.rpc.queries.teams :as teams]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
-;; --- Query: Font Variants
+;; --- Query: Team Font Variants
+
+;; TODO: deprecated, should be removed on 1.7.x
 
 (s/def ::team-id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
+(s/def ::team-font-variants
+  (s/keys :req-un [::profile-id ::team-id]))
+
+(sv/defmethod ::team-font-variants
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (teams/check-read-permissions! conn profile-id team-id)
+    (db/query conn :team-font-variant
+              {:team-id team-id
+               :deleted-at nil})))
+
+;; --- Query: Font Variants
+
 (s/def ::file-id ::us/uuid)
 (s/def ::project-id ::us/uuid)
 (s/def ::font-variants
@@ -32,7 +47,6 @@
          (contains? o :project-id)))))
 
 (sv/defmethod ::font-variants
-  {::doc/added "1.7"}
   [{:keys [pool] :as cfg} {:keys [profile-id team-id file-id project-id] :as params}]
   (with-open [conn (db/open pool)]
     (cond

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

@@ -6,27 +6,111 @@
 
 (ns app.rpc.queries.profile
   (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.db :as db]
-   [app.rpc :as-alias rpc]
-   [app.rpc.commands.profile :as profile]
-   [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]))
 
-(s/def ::profile ::profile/get-profile)
+;; --- Helpers & Specs
+
+(declare strip-private-attrs)
+
+(s/def ::email ::us/email)
+(s/def ::fullname ::us/string)
+(s/def ::old-password ::us/string)
+(s/def ::password ::us/string)
+(s/def ::path ::us/string)
+(s/def ::user ::us/uuid)
+(s/def ::profile-id ::us/uuid)
+(s/def ::theme ::us/string)
+
+;; --- Query: Profile (own)
+
+(declare retrieve-profile)
+(declare retrieve-additional-data)
+
+(s/def ::profile
+  (s/keys :opt-un [::profile-id]))
 
 (sv/defmethod ::profile
-  {::rpc/auth false
-   ::doc/added "1.0"
-   ::doc/deprecated "1.18"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id]}]
+  {:auth false}
+  [{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
   ;; We need to return the anonymous profile object in two cases, when
   ;; no profile-id is in session, and when db call raises not found. In all other
   ;; cases we need to reraise the exception.
-  (try
-    (-> (profile/get-profile pool profile-id)
-        (profile/strip-private-attrs)
-        (update :props profile/filter-props))
-    (catch Throwable _
-      {:id uuid/zero :fullname "Anonymous User"})))
+  (or (ex/try*
+       #(some->> profile-id (retrieve-profile pool))
+       #(when (not= :not-found (:type (ex-data %))) (throw %)))
+      {:id uuid/zero
+       :fullname "Anonymous User"}))
+
+(def ^:private sql:default-profile-team
+  "select t.id, name
+     from team as t
+    inner join team_profile_rel as tp on (tp.team_id = t.id)
+    where tp.profile_id = ?
+      and tp.is_owner is true
+      and t.is_default is true")
+
+(def ^:private sql:default-profile-project
+  "select p.id, name
+     from project as p
+    inner join project_profile_rel as tp on (tp.project_id = p.id)
+    where tp.profile_id = ?
+      and tp.is_owner is true
+      and p.is_default is true
+      and p.team_id = ?")
+
+(defn retrieve-additional-data
+  [conn id]
+  (let [team    (db/exec-one! conn [sql:default-profile-team id])
+        project (db/exec-one! conn [sql:default-profile-project id (:id team)])]
+    {:default-team-id (:id team)
+     :default-project-id (:id project)}))
+
+(defn populate-additional-data
+  [conn profile]
+  (merge profile (retrieve-additional-data conn (:id profile))))
+
+(defn filter-profile-props
+  [props]
+  (into {} (filter (fn [[k _]] (simple-ident? k))) props))
+
+(defn decode-profile-row
+  [{:keys [props] :as row}]
+  (cond-> row
+    (db/pgobject? props "jsonb")
+    (assoc :props (db/decode-transit-pgobject props))))
+
+(defn retrieve-profile-data
+  [conn id]
+  (-> (db/get-by-id conn :profile id)
+      (decode-profile-row)))
+
+(defn retrieve-profile
+  [conn id]
+  (let [profile (->> (retrieve-profile-data conn id)
+                     (strip-private-attrs)
+                     (populate-additional-data conn))]
+    (update profile :props filter-profile-props)))
+
+(def ^:private sql:profile-by-email
+  "select p.* from profile as p
+    where p.email = ?
+      and (p.deleted_at is null or
+           p.deleted_at > now())")
+
+(defn retrieve-profile-data-by-email
+  [conn email]
+  (ex/ignoring
+   (db/exec-one! conn [sql:profile-by-email (str/lower email)])))
+
+;; --- Attrs Helpers
+
+(defn strip-private-attrs
+  "Only selects a publicly visible profile attrs."
+  [row]
+  (dissoc row :password :deleted-at))

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

@@ -8,39 +8,135 @@
   (:require
    [app.common.spec :as us]
    [app.db :as db]
-   [app.rpc.commands.projects :as projects]
-   [app.rpc.commands.teams :as teams]
-   [app.rpc.doc :as-alias doc]
+   [app.rpc.permissions :as perms]
+   [app.rpc.queries.teams :as teams]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
+;; --- Check Project Permissions
+
+(def ^:private sql:project-permissions
+  "select tpr.is_owner,
+          tpr.is_admin,
+          tpr.can_edit
+     from team_profile_rel as tpr
+    inner join project as p on (p.team_id = tpr.team_id)
+    where p.id = ?
+      and tpr.profile_id = ?
+   union all
+   select ppr.is_owner,
+          ppr.is_admin,
+          ppr.can_edit
+     from project_profile_rel as ppr
+    where ppr.project_id = ?
+      and ppr.profile_id = ?")
+
+(defn- get-permissions
+  [conn profile-id project-id]
+  (let [rows     (db/exec! conn [sql:project-permissions
+                                 project-id profile-id
+                                 project-id profile-id])
+        is-owner (boolean (some :is-owner rows))
+        is-admin (boolean (some :is-admin rows))
+        can-edit (boolean (some :can-edit rows))]
+     (when (seq rows)
+       {:is-owner is-owner
+        :is-admin (or is-owner is-admin)
+        :can-edit (or is-owner is-admin can-edit)
+        :can-read true})))
+
+(def has-edit-permissions?
+  (perms/make-edition-predicate-fn get-permissions))
+
+(def has-read-permissions?
+  (perms/make-read-predicate-fn get-permissions))
+
+(def check-edition-permissions!
+  (perms/make-check-fn has-edit-permissions?))
+
+(def check-read-permissions!
+  (perms/make-check-fn has-read-permissions?))
+
 ;; --- Query: Projects
 
+(declare retrieve-projects)
+
 (s/def ::team-id ::us/uuid)
 (s/def ::profile-id ::us/uuid)
 (s/def ::projects
   (s/keys :req-un [::profile-id ::team-id]))
 
 (sv/defmethod ::projects
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"}
   [{:keys [pool]} {:keys [profile-id team-id]}]
   (with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
-    (projects/get-projects conn profile-id team-id)))
+    (retrieve-projects conn profile-id team-id)))
+
+(def sql:projects
+  "select p.*,
+          coalesce(tpp.is_pinned, false) as is_pinned,
+          (select count(*) from file as f
+            where f.project_id = p.id
+              and deleted_at is null) as count
+     from project as p
+    inner join team as t on (t.id = p.team_id)
+     left join team_project_profile_rel as tpp
+            on (tpp.project_id = p.id and
+                tpp.team_id = p.team_id and
+                tpp.profile_id = ?)
+    where p.team_id = ?
+      and p.deleted_at is null
+      and t.deleted_at is null
+    order by p.modified_at desc")
+
+(defn retrieve-projects
+  [conn profile-id team-id]
+  (db/exec! conn [sql:projects profile-id team-id]))
+
 
 ;; --- Query: All projects
 
+(declare retrieve-all-projects)
+
 (s/def ::profile-id ::us/uuid)
 (s/def ::all-projects
   (s/keys :req-un [::profile-id]))
 
 (sv/defmethod ::all-projects
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"}
   [{:keys [pool]} {:keys [profile-id]}]
   (with-open [conn (db/open pool)]
-    (projects/get-all-projects conn profile-id)))
+    (retrieve-all-projects conn profile-id)))
+
+(def sql:all-projects
+  "select p1.*, t.name as team_name, t.is_default as is_default_team
+     from project as p1
+    inner join team as t on (t.id = p1.team_id)
+    where t.id in (select team_id
+                     from team_profile_rel as tpr
+                    where tpr.profile_id = ?
+                      and (tpr.can_edit = true or
+                           tpr.is_owner = true or
+                           tpr.is_admin = true))
+      and t.deleted_at is null
+      and p1.deleted_at is null
+   union
+   select p2.*, t.name as team_name, t.is_default as is_default_team
+     from project as p2
+    inner join team as t on (t.id = p2.team_id)
+    where p2.id in (select project_id
+                     from project_profile_rel as ppr
+                    where ppr.profile_id = ?
+                      and (ppr.can_edit = true or
+                           ppr.is_owner = true or
+                           ppr.is_admin = true))
+      and t.deleted_at is null
+      and p2.deleted_at is null
+    order by team_name, name;")
+
+(defn retrieve-all-projects
+  [conn profile-id]
+  (db/exec! conn [sql:all-projects profile-id profile-id]))
+
 
 ;; --- Query: Project
 
@@ -49,11 +145,9 @@
   (s/keys :req-un [::profile-id ::id]))
 
 (sv/defmethod ::project
-  {::doc/added "1.0"
-   ::doc/deprecated "1.18"}
   [{:keys [pool]} {:keys [profile-id id]}]
   (with-open [conn (db/open pool)]
     (let [project (db/get-by-id conn :project id)]
-      (projects/check-read-permissions! conn profile-id id)
+      (check-read-permissions! conn profile-id id)
       project)))
 

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

@@ -0,0 +1,23 @@
+;; 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.queries.share-link
+  (:require
+   [app.db :as db]))
+
+(defn decode-share-link-row
+  [row]
+  (-> row
+      (dissoc :flags)
+      (update :pages db/decode-pgarray #{})))
+
+(defn retrieve-share-link
+  [conn file-id share-id]
+  (some-> (db/get-by-params conn :share-link
+                            {:id share-id :file-id file-id}
+                            {:check-not-found false})
+          (decode-share-link-row)))
+

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

@@ -0,0 +1,249 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.rpc.queries.teams
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.rpc.permissions :as perms]
+   [app.rpc.queries.profile :as profile]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+;; --- Team Edition Permissions
+
+(def ^:private sql:team-permissions
+  "select tpr.is_owner,
+          tpr.is_admin,
+          tpr.can_edit
+     from team_profile_rel as tpr
+     join team as t on (t.id = tpr.team_id)
+    where tpr.profile_id = ?
+      and tpr.team_id = ?
+      and t.deleted_at is null")
+
+(defn get-permissions
+  [conn profile-id team-id]
+  (let [rows     (db/exec! conn [sql:team-permissions profile-id team-id])
+        is-owner (boolean (some :is-owner rows))
+        is-admin (boolean (some :is-admin rows))
+        can-edit (boolean (some :can-edit rows))]
+     (when (seq rows)
+       {:is-owner is-owner
+        :is-admin (or is-owner is-admin)
+        :can-edit (or is-owner is-admin can-edit)
+        :can-read true})))
+
+(def has-edit-permissions?
+  (perms/make-edition-predicate-fn get-permissions))
+
+(def has-read-permissions?
+  (perms/make-read-predicate-fn get-permissions))
+
+(def check-edition-permissions!
+  (perms/make-check-fn has-edit-permissions?))
+
+(def check-read-permissions!
+  (perms/make-check-fn has-read-permissions?))
+
+;; --- Query: Teams
+
+(declare retrieve-teams)
+
+(s/def ::profile-id ::us/uuid)
+(s/def ::teams
+  (s/keys :req-un [::profile-id]))
+
+(sv/defmethod ::teams
+  [{:keys [pool] :as cfg} {:keys [profile-id]}]
+  (with-open [conn (db/open pool)]
+    (retrieve-teams conn profile-id)))
+
+(def sql:teams
+  "select t.*,
+          tp.is_owner,
+          tp.is_admin,
+          tp.can_edit,
+          (t.id = ?) as is_default
+     from team_profile_rel as tp
+     join team as t on (t.id = tp.team_id)
+    where t.deleted_at is null
+      and tp.profile_id = ?
+    order by tp.created_at asc")
+
+(defn process-permissions
+  [team]
+  (let [is-owner    (:is-owner team)
+        is-admin    (:is-admin team)
+        can-edit    (:can-edit team)
+        permissions {:type :membership
+                     :is-owner is-owner
+                     :is-admin (or is-owner is-admin)
+                     :can-edit (or is-owner is-admin can-edit)}]
+    (-> team
+        (dissoc :is-owner :is-admin :can-edit)
+        (assoc :permissions permissions))))
+
+(defn retrieve-teams
+  [conn profile-id]
+  (let [defaults (profile/retrieve-additional-data conn profile-id)]
+    (->> (db/exec! conn [sql:teams (:default-team-id defaults) profile-id])
+         (mapv process-permissions))))
+
+;; --- Query: Team (by ID)
+
+(declare retrieve-team)
+
+(s/def ::id ::us/uuid)
+(s/def ::team
+  (s/keys :req-un [::profile-id ::id]))
+
+(sv/defmethod ::team
+  [{:keys [pool] :as cfg} {:keys [profile-id id]}]
+  (with-open [conn (db/open pool)]
+    (retrieve-team conn profile-id id)))
+
+(defn retrieve-team
+  [conn profile-id team-id]
+  (let [defaults (profile/retrieve-additional-data conn profile-id)
+        sql      (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?")
+        result   (db/exec-one! conn [sql (:default-team-id defaults) profile-id team-id])]
+    (when-not result
+      (ex/raise :type :not-found
+                :code :team-does-not-exist))
+    (process-permissions result)))
+
+
+;; --- Query: Team Members
+
+(declare retrieve-team-members)
+
+(s/def ::team-id ::us/uuid)
+(s/def ::team-members
+  (s/keys :req-un [::profile-id ::team-id]))
+
+(sv/defmethod ::team-members
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+  (with-open [conn (db/open pool)]
+    (check-read-permissions! conn profile-id team-id)
+    (retrieve-team-members conn team-id)))
+
+(def sql:team-members
+  "select tp.*,
+          p.id,
+          p.email,
+          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 = ?")
+
+(defn retrieve-team-members
+  [conn team-id]
+  (db/exec! conn [sql:team-members team-id]))
+
+
+;; --- Query: Team Users
+
+(declare retrieve-users)
+(declare retrieve-team-for-file)
+
+(s/def ::file-id ::us/uuid)
+(s/def ::team-users
+  (s/and (s/keys :req-un [::profile-id]
+                 :opt-un [::team-id ::file-id])
+         #(or (:team-id %) (:file-id %))))
+
+(sv/defmethod ::team-users
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id file-id]}]
+  (with-open [conn (db/open pool)]
+    (if team-id
+      (do
+        (check-read-permissions! conn profile-id team-id)
+        (retrieve-users conn team-id))
+      (let [{team-id :id} (retrieve-team-for-file conn file-id)]
+        (check-read-permissions! conn profile-id team-id)
+        (retrieve-users conn team-id)))))
+
+;; This is a similar query to team members but can contain more data
+;; because some user can be explicitly added to project or file (not
+;; implemented in UI)
+
+(def sql:team-users
+  "select pf.id, pf.fullname, pf.photo_id
+     from profile as pf
+    inner join team_profile_rel as tpr on (tpr.profile_id = pf.id)
+    where tpr.team_id = ?
+    union
+   select pf.id, pf.fullname, pf.photo_id
+     from profile as pf
+    inner join project_profile_rel as ppr on (ppr.profile_id = pf.id)
+    inner join project as p on (ppr.project_id = p.id)
+    where p.team_id = ?
+   union
+   select pf.id, pf.fullname, pf.photo_id
+     from profile as pf
+    inner join file_profile_rel as fpr on (fpr.profile_id = pf.id)
+    inner join file as f on (fpr.file_id = f.id)
+    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 retrieve-users
+  [conn team-id]
+  (db/exec! conn [sql:team-users team-id team-id team-id]))
+
+(defn retrieve-team-for-file
+  [conn file-id]
+  (->> [sql:team-by-file file-id]
+       (db/exec-one! conn)))
+
+;; --- Query: Team Stats
+
+(declare retrieve-team-stats)
+
+(s/def ::team-stats
+  (s/keys :req-un [::profile-id ::team-id]))
+
+(sv/defmethod ::team-stats
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+  (with-open [conn (db/open pool)]
+    (check-read-permissions! conn profile-id team-id)
+    (retrieve-team-stats conn team-id)))
+
+(def sql:team-stats
+  "select (select count(*) from project where team_id = ?) as projects,
+          (select count(*) from file as f join project as p on (p.id = f.project_id) where p.team_id = ?) as files")
+
+(defn retrieve-team-stats
+  [conn team-id]
+  (db/exec-one! conn [sql:team-stats team-id team-id]))
+
+
+;; --- Query: Team invitations
+
+(s/def ::team-id ::us/uuid)
+(s/def ::team-invitations
+  (s/keys :req-un [::profile-id ::team-id]))
+
+(def sql:team-invitations
+  "select email_to as email, role, (valid_until < now()) as expired 
+   from team_invitation where team_id = ? order by valid_until desc")
+
+(sv/defmethod ::team-invitations
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+  (with-open [conn (db/open pool)]
+    (check-read-permissions! conn profile-id team-id)
+    (->> (db/exec! conn [sql:team-invitations team-id])
+         (mapv #(update % :role keyword)))))

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

@@ -8,7 +8,6 @@
   (:require
    [app.common.spec :as us]
    [app.db :as db]
-   [app.rpc :as-alias rpc]
    [app.rpc.commands.viewer :as viewer]
    [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
@@ -20,9 +19,9 @@
          (s/keys :opt-un [::components-v2])))
 
 (sv/defmethod ::view-only-bundle
-  {::rpc/auth false
+  {:auth false
    ::doc/added "1.3"
-   ::doc/deprecated "1.18"}
+   ::doc/deprecated "1.17"}
   [{:keys [pool] :as cfg} {:keys [features components-v2] :as params}]
   (with-open [conn (db/open pool)]
     (let [;; BACKWARD COMPATIBILTY with the components-v2 parameter

backend/src/app/rpc/quotes.clj

@@ -1,360 +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.quotes
-  "Penpot resource usage quotes."
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.logging :as l]
-   [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)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; PUBLIC API
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(s/def ::conn ::db/conn-or-pool)
-(s/def ::file-id ::us/uuid)
-(s/def ::team-id ::us/uuid)
-(s/def ::project-id ::us/uuid)
-(s/def ::profile-id ::us/uuid)
-(s/def ::incr (s/and int? pos?))
-(s/def ::target ::us/string)
-
-(s/def ::quote
-  (s/keys :req [::id ::profile-id]
-          :opt [::conn
-                ::team-id
-                ::project-id
-                ::file-id
-                ::incr]))
-
-(def ^:private enabled (volatile! true))
-
-(defn enable!
-  "Enable quotes checking at runtime (from server REPL)."
-  []
-  (vswap! enabled (constantly true)))
-
-(defn disable!
-  "Disable quotes checking at runtime (from server REPL)."
-  []
-  (vswap! enabled (constantly false)))
-
-(defn check-quote!
-  [conn quote]
-  (us/assert! ::db/conn-or-pool conn)
-  (us/assert! ::quote quote)
-  (when (contains? cf/flags :quotes)
-    (when @enabled
-      (check-quote (assoc quote ::conn conn ::target (name (::id quote)))))))
-
-(defn- send-notification!
-  [{:keys [::conn] :as params}]
-  (l/warn :hint "max quote reached"
-          :target (::target params)
-          :profile-id (some-> params ::profile-id str)
-          :team-id (some-> params ::team-id str)
-          :project-id (some-> params ::project-id str)
-          :file-id (some-> params ::file-id str)
-          :quote (::quote params)
-          :total (::total params)
-          :incr  (::inc params 1))
-
-  (when-let [admins (seq (cf/get :admins))]
-    (let [subject (str/istr "[quotes:notification]: max quote reached ~(::target params)")
-          content (str/istr "- Param: profile-id '~(::profile-id params)}'\n"
-                            "- Param: team-id '~(::team-id params)'\n"
-                            "- Param: project-id '~(::project-id params)'\n"
-                            "- Param: file-id '~(::file-id params)'\n"
-                            "- Quote ID: '~(::target params)'\n"
-                            "- Max: ~(::quote params)\n"
-                            "- Total: ~(::total params) (INCR ~(::incr params 1))\n")]
-      (wrk/submit! {::wrk/task :sendmail
-                    ::wrk/delay (dt/duration "30s")
-                    ::wrk/max-retries 4
-                    ::wrk/priority 200
-                    ::wrk/conn conn
-                    ::wrk/dedupe true
-                    ::wrk/label "quotes-notification"
-                    :to (vec admins)
-                    :subject subject
-                    :body [{:type "text/plain"
-                            :content content}]}))))
-
-(defn- generic-check!
-  [{:keys [::conn ::incr ::quote-sql ::count-sql ::default ::target] :or {incr 1} :as params}]
-  (let [quote (->> (db/exec! conn quote-sql)
-                   (map :quote)
-                   (reduce max (- Integer/MAX_VALUE)))
-        quote (if (pos? quote) quote default)
-        total (->> (db/exec! conn count-sql) first :total)]
-
-    (when (> (+ total incr) quote)
-      (if (contains? cf/flags :soft-quotes)
-        (send-notification! (assoc params ::quote quote ::total total))
-        (ex/raise :type :restriction
-                  :code :max-quote-reached
-                  :target target
-                  :quote quote
-                  :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;")
-
-(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));")
-
-(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));")
-
-(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));")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: TEAMS-PER-PROFILE
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:private sql:get-teams-per-profile
-  "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}]
-  (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 sql:get-access-tokens-per-profile
-  "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}]
-  (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])
-      (assoc ::count-sql [sql:get-access-tokens-per-profile profile-id])
-      (generic-check!)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: 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")
-
-(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}]
-  (-> 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 sql:get-font-variants-per-team
-  "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}]
-  (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])
-      (assoc ::count-sql [sql:get-font-variants-per-team team-id])
-      (generic-check!)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: INVITATIONS-PER-TEAM
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:private sql:get-invitations-per-team
-  "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}]
-  (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 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;")
-
-;; 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}]
-  (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 sql:get-files-per-project
-  "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}]
-  (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])
-      (assoc ::count-sql [sql:get-files-per-project project-id])
-      (generic-check!)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: 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 = ?")
-
-(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}]
-  (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
-                          profile-id team-id profile-id profile-id])
-      (assoc ::count-sql [sql:get-comment-threads-per-file file-id])
-      (generic-check!)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: 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 = ?")
-
-(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}]
-  (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
-                          profile-id team-id profile-id profile-id])
-      (assoc ::count-sql [sql:get-comments-per-file file-id])
-      (generic-check!)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: DEFAULT
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmethod check-quote :default
-  [{:keys [::id]}]
-  (ex/raise :type :internal
-            :code :quote-not-defined
-            :quote id
-            :hint "backend using a quote identifier not defined"))

backend/src/app/rpc/retry.clj

@@ -5,23 +5,23 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.retry
-  "A fault tolerance RPC middleware. Allow retry some operations that we
-  know we can retry."
+  "A fault tolerance helpers. Allow retry some operations that we know
+  we can retry."
   (:require
    [app.common.logging :as l]
-   [app.util.retry :refer [conflict-exception?]]
    [app.util.services :as sv]
    [promesa.core :as p]))
 
 (defn conflict-db-insert?
   "Check if exception matches a insertion conflict on postgresql."
   [e]
-  (conflict-exception? e))
-
-(def always-false (constantly false))
+  (and (instance? org.postgresql.util.PSQLException e)
+       (= "23505" (.getSQLState e))))
 
 (defn wrap-retry
-  [_ f {:keys [::matches ::sv/name] :or {matches always-false} :as mdata}]
+  [_ f {:keys [::matches ::sv/name]
+        :or {matches (constantly false)}
+        :as mdata}]
 
   (when (::enabled mdata)
     (l/debug :hint "wrapping retry" :name name))
@@ -29,8 +29,8 @@
   (if-let [max-retries (::max-retries mdata)]
     (fn [cfg params]
       (letfn [(run [retry]
-                (->> (f cfg params)
-                     (p/merr (partial handle-error retry))))
+                (-> (f cfg params)
+                    (p/catch (partial handle-error retry))))
 
               (handle-error [retry cause]
                 (if (matches cause)
@@ -40,6 +40,6 @@
                       (run current-retry)
                       (throw cause)))
                   (throw cause)))]
-        (run 1)))
+        (run 0)))
     f))
 

backend/src/app/rpc/rlimit.clj

@@ -52,7 +52,7 @@
    [app.config :as cf]
    [app.http :as-alias http]
    [app.loggers.audit :refer [parse-client-ip]]
-   [app.redis :as rds]
+   [app.redis :as redis]
    [app.redis.script :as-alias rscript]
    [app.rpc :as-alias rpc]
    [app.rpc.rlimit.result :as-alias lresult]
@@ -71,7 +71,7 @@
   (dt/duration 400))
 
 (def ^:private default-options
-  {:codec rds/string-codec
+  {:codec redis/string-codec
    :timeout default-timeout})
 
 (def ^:private bucket-rate-limit-script
@@ -141,23 +141,23 @@
   (let [script (-> bucket-rate-limit-script
                    (assoc ::rscript/keys [(str key "." service "." user-id)])
                    (assoc ::rscript/vals (conj params (dt/->seconds now))))]
-    (->> (rds/eval! redis script)
-         (p/fmap (fn [result]
-                   (let [allowed?  (boolean (nth result 0))
-                         remaining (nth result 1)
-                         reset     (* (/ (inst-ms interval) rate)
-                                      (- capacity remaining))]
-                     (l/trace :hint "limit processed"
-                              :service service
-                              :limit (name (::name limit))
-                              :strategy (name (::strategy limit))
-                              :opts (::opts limit)
+    (-> (redis/eval! redis script)
+        (p/then (fn [result]
+                  (let [allowed?  (boolean (nth result 0))
+                        remaining (nth result 1)
+                        reset     (* (/ (inst-ms interval) rate)
+                                     (- capacity remaining))]
+                    (l/trace :hint "limit processed"
+                             :service service
+                             :limit (name (::name limit))
+                             :strategy (name (::strategy limit))
+                             :opts (::opts limit)
                              :allowed? allowed?
                              :remaining remaining)
-                     (-> limit
-                         (assoc ::lresult/allowed? allowed?)
-                         (assoc ::lresult/reset (dt/plus now reset))
-                         (assoc ::lresult/remaining remaining))))))))
+                    (-> limit
+                        (assoc ::lresult/allowed? allowed?)
+                        (assoc ::lresult/reset (dt/plus now reset))
+                        (assoc ::lresult/remaining remaining))))))))
 
 (defmethod process-limit :window
   [redis user-id now {:keys [::nreq ::unit ::key ::service] :as limit}]
@@ -166,113 +166,94 @@
         script (-> window-rate-limit-script
                    (assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))])
                    (assoc ::rscript/vals [nreq (dt/->seconds ttl)]))]
-    (->> (rds/eval! redis script)
-         (p/fmap (fn [result]
-                   (let [allowed?  (boolean (nth result 0))
-                         remaining (nth result 1)]
-                     (l/trace :hint "limit processed"
-                              :service service
-                              :limit (name (::name limit))
-                              :strategy (name (::strategy limit))
-                              :opts (::opts limit)
-                              :allowed? allowed?
+    (-> (redis/eval! redis script)
+        (p/then (fn [result]
+                  (let [allowed?  (boolean (nth result 0))
+                        remaining (nth result 1)]
+                    (l/trace :hint "limit processed"
+                             :service service
+                             :limit (name (::name limit))
+                             :strategy (name (::strategy limit))
+                             :opts (::opts limit)
+                             :allowed? allowed?
                              :remaining remaining)
-                     (-> limit
-                         (assoc ::lresult/allowed? allowed?)
-                         (assoc ::lresult/remaining remaining)
-                         (assoc ::lresult/reset (dt/plus ts {unit 1})))))))))
+                    (-> limit
+                        (assoc ::lresult/allowed? allowed?)
+                        (assoc ::lresult/remaining remaining)
+                        (assoc ::lresult/reset (dt/plus ts {unit 1})))))))))
 
-(defn- process-limits!
+(defn- process-limits
   [redis user-id limits now]
-  (->> (p/all (map (partial process-limit redis user-id now) limits))
-       (p/fmap (fn [results]
-                 (let [remaining (->> results
-                                      (d/index-by ::name ::lresult/remaining)
-                                      (uri/map->query-string))
-                       reset     (->> results
-                                      (d/index-by ::name (comp dt/->seconds ::lresult/reset))
-                                      (uri/map->query-string))
-                       rejected  (->> results
-                                      (filter (complement ::lresult/allowed?))
-                                      (first))]
+  (-> (p/all (map (partial process-limit redis user-id now) limits))
+      (p/then (fn [results]
+                (let [remaining (->> results
+                                     (d/index-by ::name ::lresult/remaining)
+                                     (uri/map->query-string))
+                      reset     (->> results
+                                     (d/index-by ::name (comp dt/->seconds ::lresult/reset))
+                                     (uri/map->query-string))
+                      rejected  (->> results
+                                     (filter (complement ::lresult/allowed?))
+                                     (first))]
 
-                   (when rejected
-                     (l/warn :hint "rejected rate limit"
-                             :user-id (str user-id)
-                             :limit-service (-> rejected ::service name)
-                             :limit-name (-> rejected ::name name)
-                             :limit-strategy (-> rejected ::strategy name)))
+                  (when rejected
+                    (l/warn :hint "rejected rate limit"
+                            :user-id (str user-id)
+                            :limit-service (-> rejected ::service name)
+                            :limit-name (-> rejected ::name name)
+                            :limit-strategy (-> rejected ::strategy name)))
 
-                   {:enabled? true
-                    :allowed? (not (some? rejected))
-                    :headers  {"x-rate-limit-remaining" remaining
-                               "x-rate-limit-reset" reset}})))))
+                  {:enabled? true
+                   :allowed? (not (some? rejected))
+                   :headers  {"x-rate-limit-remaining" remaining
+                              "x-rate-limit-reset" reset}})))))
 
 (defn- handle-response
   [f cfg params result]
   (if (:enabled? result)
     (let [headers (:headers result)]
-      (if (:allowed? result)
-        (->> (f cfg params)
-             (p/fmap (fn [response]
-                       (vary-meta response update ::http/headers merge headers))))
-        (p/rejected
-         (ex/error :type :rate-limit
-                   :code :request-blocked
-                   :hint "rate limit reached"
-                   ::http/headers headers))))
+      (when-not (:allowed? result)
+        (ex/raise :type :rate-limit
+                  :code :request-blocked
+                  :hint "rate limit reached"
+                  ::http/headers headers))
+      (-> (f cfg params)
+          (p/then (fn [response]
+                    (vary-meta response update ::http/headers merge headers)))))
     (f cfg params)))
 
-(defn- get-limits
-  [state skey sname]
-  (some->> (or (get-in @state [::limits skey])
-               (get-in @state [::limits :default]))
-           (map #(assoc % ::service sname))
-           (seq)))
-
-(defn- get-uid
-  [{:keys [::http/request] :as params}]
-  (or (::rpc/profile-id params)
-      (some-> request parse-client-ip)
-      uuid/zero))
-
 (defn wrap
-  [{:keys [::rpc/rlimit ::rds/redis] :as cfg} f mdata]
-  (us/assert! ::rpc/rlimit rlimit)
-  (us/assert! ::rds/redis redis)
-
+  [{:keys [rlimit redis] :as cfg} f mdata]
   (if rlimit
     (let [skey  (keyword (::rpc/type cfg) (->> mdata ::sv/spec name))
           sname (str (::rpc/type cfg) "." (->> mdata ::sv/spec name))]
+      (fn [cfg {:keys [::http/request] :as params}]
+        (let [uid (or (:profile-id params)
+                      (some-> request parse-client-ip)
+                      uuid/zero)
 
-      (fn [cfg params]
-        (if @enabled?
-          (try
-            (let [uid (get-uid params)
-                  rsp (when-let [limits (get-limits rlimit skey sname)]
-                        (let [redis (rds/get-or-connect redis ::rpc/rlimit default-options)
-                              rsp   (->> (process-limits! redis uid limits (dt/now))
-                                         (p/merr (fn [cause]
-                                                   ;; If we have an error on processing the rate-limit we just skip
-                                                   ;; it for do not cause service interruption because of redis
-                                                   ;; downtime or similar situation.
-                                                   (l/error :hint "error on processing rate-limit" :cause cause)
-                                                   (p/resolved {:enabled? false}))))]
+              rsp (when (and uid @enabled?)
+                    (when-let [limits (or (get-in @rlimit [::limits skey])
+                                          (get-in @rlimit [::limits :default]))]
+                      (let [redis  (redis/get-or-connect redis ::rlimit default-options)
+                            limits (map #(assoc % ::service sname) limits)
+                            resp   (-> (process-limits redis uid limits (dt/now))
+                                       (p/catch (fn [cause]
+                                                  ;; If we have an error on processing the rate-limit we just skip
+                                                  ;; it for do not cause service interruption because of redis
+                                                  ;; downtime or similar situation.
+                                                  (l/error :hint "error on processing rate-limit" :cause cause)
+                                                  {:enabled? false})))]
 
-                          ;; If soft rate are enabled, we process the rate-limit but return unprotected
-                          ;; response.
-                          (if (contains? cf/flags :soft-rpc-rlimit)
-                            {:enabled? false}
-                            rsp)))]
+                        ;; If soft rate are enabled, we process the rate-limit but return unprotected
+                        ;; response.
+                        (if (contains? cf/flags :soft-rpc-rlimit)
+                          (p/resolved {:enabled? false})
+                          resp))))
 
-              (->> (p/promise rsp)
-                   (p/fmap #(or % {:enabled? false}))
-                   (p/mcat #(handle-response f cfg params %))))
+              rsp (or rsp (p/resolved {:enabled? false}))]
 
-            (catch Throwable cause
-              (p/rejected cause)))
-
-          (f cfg params))))
+          (p/then rsp (partial handle-response f cfg params)))))
     f))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -308,9 +289,8 @@
          (s/keys :req [::nreq
                        ::unit]))))
 
-(s/def ::rpc/rlimit
-  (s/nilable
-   #(instance? clojure.lang.Agent %)))
+(s/def ::rlimit
+  #(instance? clojure.lang.Agent %))
 
 (s/def ::config
   (s/map-of (s/or :kw keyword? :set set?)
@@ -352,7 +332,7 @@
          ::limits limits}))))
 
 (defn- refresh-config
-  [{:keys [::state ::path ::wrk/executor ::wrk/scheduled-executor] :as cfg}]
+  [{:keys [state path executor scheduled-executor] :as params}]
   (letfn [(update-config [{:keys [::updated-at] :as state}]
             (let [updated-at' (fs/last-modified-time path)]
               (merge state
@@ -369,7 +349,7 @@
           (schedule-next [state]
             (px/schedule! scheduled-executor
                           (inst-ms (::refresh state))
-                          (partial refresh-config cfg))
+                          (partial refresh-config params))
             state)]
 
     (send-via executor state update-config)
@@ -391,11 +371,10 @@
     (and (fs/exists? path) (fs/regular-file? path) path)))
 
 (defmethod ig/pre-init-spec :app.rpc/rlimit [_]
-  (s/keys :req [::wrk/executor
-                ::wrk/scheduled-executor]))
+  (s/keys :req-un [::wrk/executor ::wrk/scheduled-executor]))
 
 (defmethod ig/init-key ::rpc/rlimit
-  [_ {:keys [::wrk/executor] :as cfg}]
+  [_ {:keys [executor] :as params}]
   (when (contains? cf/flags :rpc-rlimit)
     (let [state (agent {})]
       (set-error-handler! state on-refresh-error)
@@ -408,6 +387,6 @@
         (send-via executor state (constantly {::refresh (dt/duration "5s")}))
 
         ;; Force a refresh
-        (refresh-config (assoc cfg ::path path ::state state)))
+        (refresh-config (assoc params :path path :state state)))
 
       state)))

backend/src/app/setup.clj

@@ -68,5 +68,5 @@
     (let [secret (or key (generate-random-key))]
       (-> (retrieve-all conn)
           (assoc :secret-key secret)
-          (assoc :tokens-key (keys/derive secret :salt "tokens"))
+          (assoc :tokens-key (keys/derive secret :salt "tokens" :size 32))
           (update :instance-id handle-instance-id conn (db/read-only? pool))))))

backend/src/app/setup/keys.clj

@@ -13,7 +13,7 @@
 
 (defn derive
   "Derive a key from secret-key"
-  [secret-key & {:keys [salt size] :or {size 32}}]
+  [secret-key & {:keys [salt size]}]
   (us/assert! ::us/not-empty-string secret-key)
   (let [engine (bk/engine {:key secret-key
                            :salt salt

backend/src/app/srepl.clj

@@ -9,11 +9,7 @@
   (:require
    [app.common.logging :as l]
    [app.common.spec :as us]
-   [app.config :as cf]
-   [app.srepl.ext]
    [app.srepl.main]
-   [app.util.json :as json]
-   [app.util.locks :as locks]
    [clojure.core.server :as ccs]
    [clojure.main :as cm]
    [clojure.spec.alpha :as s]
@@ -24,59 +20,39 @@
   (ccs/repl-init)
   (in-ns 'app.srepl.main))
 
-(defn user-repl
+(defn repl
   []
   (cm/repl
    :init repl-init
    :read ccs/repl-read))
 
-(defn json-repl
-  []
-  (let [out  *out*
-        lock (locks/create)]
-    (ccs/prepl *in*
-               (fn [m]
-                 (binding [*out* out, *flush-on-newline* true, *print-readably* true]
-                   (locks/locking lock
-                     (println (json/encode-str m))))))))
-
 ;; --- State initialization
 
-(s/def ::port ::us/integer)
+(s/def ::name ::us/not-empty-string)
+(s/def ::port int?)
 (s/def ::host ::us/not-empty-string)
-(s/def ::flag #{:urepl-server :prepl-server})
-(s/def ::type #{::prepl ::urepl})
-(s/def ::key (s/tuple ::type ::us/keyword))
 
 (defmethod ig/pre-init-spec ::server
   [_]
-  (s/keys :req [::flag]
-          :req-un [::port ::host]))
+  (s/keys :opt-un [::port ::host ::name]))
 
 (defmethod ig/prep-key ::server
-  [[type _] cfg]
-  (assoc cfg ::flag (keyword (str (name type) "-server"))))
+  [_ cfg]
+  (merge {:name "main"} cfg))
 
 (defmethod ig/init-key ::server
-  [[type _] {:keys [::flag port host] :as cfg}]
-  (when (contains? cf/flags flag)
-    (let [accept (case type
-                   ::prepl 'app.srepl/json-repl
-                   ::urepl 'app.srepl/user-repl)
-          params {:address host
-                  :port port
-                  :name (name type)
-                  :accept accept}]
-
-      (l/info :msg "initializing repl server"
-              :name (name type)
-              :port port
-              :host host)
-
-      (ccs/start-server params)
-
-      params)))
+  [_ {:keys [port host name] :as cfg}]
+  (when (and port host name)
+    (l/info :msg "initializing server repl" :port port :host host :name name)
+    (ccs/start-server {:address host
+                       :port port
+                       :name name
+                       :accept 'app.srepl/repl})
+    cfg))
 
 (defmethod ig/halt-key! ::server
-  [_ params]
-  (some-> params :name ccs/stop-server))
+  [_ cfg]
+  (when cfg
+    (ccs/stop-server (:name cfg))))
+
+

backend/src/app/srepl/ext.clj

@@ -1,77 +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.srepl.ext
-  "PREPL API for external usage (CLI or ADMIN)"
-  (:require
-   [app.auth :as auth]
-   [app.common.exceptions :as ex]
-   [app.common.uuid :as uuid]
-   [app.db :as db]
-   [app.rpc.commands.auth :as cmd.auth]
-   [app.util.json :as json]
-   [cuerdas.core :as str]))
-
-(defn- get-current-system
-  []
-  (or (deref (requiring-resolve 'app.main/system))
-      (deref (requiring-resolve 'user/system))))
-
-(defmulti ^:private run-json-cmd* ::cmd)
-
-(defn run-json-cmd
-  "Entry point with external tools integrations that uses PREPL
-  interface for interacting with running penpot backend."
-  [data]
-  (let [data (json/decode data)
-        params (merge {::cmd (keyword (:cmd data "default"))}
-                      (:params data))]
-    (run-json-cmd* params)))
-
-(defmethod run-json-cmd* :create-profile
-  [{:keys [fullname email password is-active]
-    :or {is-active true}}]
-  (when-let [system (get-current-system)]
-    (db/with-atomic [conn (:app.db/pool system)]
-      (let [params  {:id (uuid/next)
-                     :email email
-                     :fullname fullname
-                     :is-active is-active
-                     :password password
-                     :props {}}]
-        (->> (cmd.auth/create-profile! conn params)
-             (cmd.auth/create-profile-rels! conn))))))
-
-(defmethod run-json-cmd* :update-profile
-  [{:keys [fullname email password is-active]}]
-  (when-let [system (get-current-system)]
-    (db/with-atomic [conn (:app.db/pool system)]
-      (let [params (cond-> {}
-                     (some? fullname)
-                     (assoc :fullname fullname)
-
-                     (some? password)
-                     (assoc :password (auth/derive-password password))
-
-                     (some? is-active)
-                     (assoc :is-active is-active))]
-        (when (seq params)
-          (let [res (db/update! conn :profile
-                                params
-                                {:email email
-                                 :deleted-at nil}
-                                {:return-keys false})]
-            (pos? (:next.jdbc/update-count res))))))))
-
-(defmethod run-json-cmd* :derive-password
-  [{:keys [password]}]
-  (auth/derive-password password))
-
-(defmethod run-json-cmd* :default
-  [{:keys [::cmd]}]
-  (ex/raise :type :internal
-            :code :not-implemented
-            :hint (str/ffmt "command '%' not implemented" (name cmd))))