Merge pull request #2302 from penpot/niwinz-hot-improvements

Enhancements

CHANGES.md

@@ -23,6 +23,10 @@
 - Add Libraries & Templates carousel [Taiga #3860](https://tree.taiga.io/project/penpot/us/3860)
 - Ungroup frames [Taiga #4012](https://tree.taiga.io/project/penpot/us/4012)
 - Newsletter Opt-in options for subscription categories [Taiga #3242](https://tree.taiga.io/project/penpot/us/3242)
+- Print emails to console by default if smtp is disabled
+- Add `email-verification` flag for enable/disable email verification
+
+
 
 ### :bug: Bugs fixed
 
@@ -53,6 +57,7 @@
 - Fix issue when scaling to value 0 [#2252](https://github.com/penpot/penpot/issues/2252)
 - Fix problem when moving shapes inside nested frames [Taiga #4113](https://tree.taiga.io/project/penpot/issue/4113)
 
+
 ## 1.15.3-beta
 
 ### :bug: Bugs fixed

backend/deps.edn

@@ -71,7 +71,8 @@
   {:extra-paths ["test"]
    :extra-deps
    {io.github.cognitect-labs/test-runner
-    {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
+    {:git/tag "v0.5.1" :git/sha "dfb30dd"}}
+   :main-opts ["-m" "cognitect.test-runner"]
    :exec-fn cognitect.test-runner.api/test}
 
   :outdated

backend/dev/script-fix-sobjects.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 ;; This is an example on how it can be executed:
 ;; clojure -Scp $(cat classpath) -M dev/script-fix-sobjects.clj

backend/dev/user.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns user
   (:require
@@ -74,7 +74,7 @@
   []
   (alter-var-root #'system (fn [sys]
                              (when sys (ig/halt! sys))
-                             (-> main/system-config
+                             (-> (merge main/system-config main/worker-config)
                                  (ig/prep)
                                  (ig/init))))
   :started)

backend/scripts/repl

@@ -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-rpc-rate-limit enable-warn-rpc-rate-limits"
+export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-rpc-rate-limit enable-warn-rpc-rate-limits enable-smtp"
 
 # export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot"
 # export PENPOT_DATABASE_USERNAME="penpot"

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"
+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/ldap.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.auth.ldap
   (:require

backend/src/app/auth/oidc.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.auth.oidc
   "OIDC client implementation."

backend/src/app/cli/manage.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.cli.manage
   "A manage cli api."

backend/src/app/config.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.config
   "A configuration management."
@@ -11,7 +11,6 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.flags :as flags]
-   [app.common.logging :as l]
    [app.common.spec :as us]
    [app.common.version :as v]
    [app.util.time :as dt]
@@ -94,7 +93,6 @@
 (s/def ::telemetry-enabled ::us/boolean)
 
 (s/def ::audit-log-archive-uri ::us/string)
-(s/def ::audit-log-gc-max-age ::dt/duration)
 
 (s/def ::admins ::us/set-of-strings)
 (s/def ::file-change-snapshot-every ::us/integer)
@@ -171,12 +169,11 @@
 (s/def ::redis-uri ::us/string)
 (s/def ::registration-domain-whitelist ::us/set-of-strings)
 
+(s/def ::semaphore-font-process ::us/integer)
+(s/def ::semaphore-file-update ::us/integer)
+(s/def ::semaphore-image-process ::us/integer)
+(s/def ::semaphore-authentication ::us/integer)
 
-
-(s/def ::rpc-semaphore-permits-font ::us/integer)
-(s/def ::rpc-semaphore-permits-file-update ::us/integer)
-(s/def ::rpc-semaphore-permits-image ::us/integer)
-(s/def ::rpc-semaphore-permits-password ::us/integer)
 (s/def ::smtp-default-from ::us/string)
 (s/def ::smtp-default-reply-to ::us/string)
 (s/def ::smtp-host ::us/string)
@@ -212,7 +209,6 @@
                    ::admins
                    ::allow-demo-users
                    ::audit-log-archive-uri
-                   ::audit-log-gc-max-age
                    ::auth-token-cookie-name
                    ::auth-token-cookie-max-age
                    ::authenticated-cookie-name
@@ -280,10 +276,12 @@
                    ::public-uri
                    ::redis-uri
                    ::registration-domain-whitelist
-                   ::rpc-semaphore-permits-font
+
-                   ::rpc-semaphore-permits-file-update
+                   ::semaphore-process-font
-                   ::rpc-semaphore-permits-image
+                   ::semaphore-process-image
-                   ::rpc-semaphore-permits-password
+                   ::semaphore-update-file
+                   ::semaphore-auth
+
                    ::rpc-rlimit-config
                    ::sentry-dsn
                    ::sentry-debug
@@ -318,7 +316,8 @@
 (def default-flags
   [:enable-backend-api-doc
    :enable-backend-worker
-   :enable-secure-session-cookies])
+   :enable-secure-session-cookies
+   :enable-email-verification])
 
 (defn- parse-flags
   [config]
@@ -359,11 +358,7 @@
                "%version%")))
 
 (defonce ^:dynamic config (read-config))
-
+(defonce ^:dynamic flags (parse-flags config))
-(defonce ^:dynamic flags
-  (let [flags (parse-flags config)]
-    (l/info :hint "flags initialized" :flags (str/join "," (map name flags)))
-    flags))
 
 (def deletion-delay
   (dt/duration {:days 7}))

backend/src/app/db.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.db
   (:require
@@ -75,7 +75,7 @@
 (def defaults
   {:name :main
    :min-size 0
-   :max-size 30
+   :max-size 60
    :connection-timeout 10000
    :validation-timeout 10000
    :idle-timeout 120000 ; 2min
@@ -367,23 +367,23 @@
    (.rollback conn sp)))
 
 (defn interval
-  [data]
+  [o]
   (cond
-    (integer? data)
+    (or (integer? o)
-    (->> (/ data 1000.0)
+        (float? o))
+    (->> (/ o 1000.0)
          (format "%s seconds")
          (pginterval))
 
-    (string? data)
+    (string? o)
-    (pginterval data)
+    (pginterval o)
 
-    (dt/duration? data)
+    (dt/duration? o)
-    (->> (/ (.toMillis ^java.time.Duration data) 1000.0)
+    (interval (inst-ms o))
-         (format "%s seconds")
-         (pginterval))
 
     :else
-    (ex/raise :type :not-implemented)))
+    (ex/raise :type :not-implemented
+              :hint (format "no implementation found for value %s" (pr-str o)))))
 
 (defn decode-json-pgobject
   [^PGobject o]

backend/src/app/db/sql.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.db.sql
   (:refer-clojure :exclude [update])

backend/src/app/emails.clj

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

backend/src/app/http.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http
   (:require

backend/src/app/http/assets.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.assets
   "Assets related handlers."

backend/src/app/http/awsns.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.awsns
   "AWS SNS webhook handler for bounces."

backend/src/app/http/client.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.client
   "Http client abstraction layer."

backend/src/app/http/debug.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.debug
   (:refer-clojure :exclude [error-handler])

backend/src/app/http/errors.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.errors
   "A errors handling for the http server."

backend/src/app/http/feedback.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.feedback
   "A general purpose feedback module."

backend/src/app/http/middleware.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.middleware
   (:require

backend/src/app/http/session.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.session
   (:require

backend/src/app/http/websocket.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.websocket
   "A penpot notification service for file cooperative edition."

backend/src/app/loggers/audit.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.audit
   "Services related to the user activity (audit log)."
@@ -264,7 +264,7 @@
           (let [n (archive-events cfg)]
             (if n
               (do
-                (aa/thread-sleep 200)
+                (aa/thread-sleep 100)
                 (recur (+ total n)))
               (when (pos? total)
                 (l/trace :hint "events chunk archived" :num total)))))))))
@@ -345,23 +345,18 @@
 
 (def sql:clean-archived
   "delete from audit_log
-    where archived_at is not null
+    where archived_at is not null")
-      and archived_at < now() - ?::interval")
 
 (defn- clean-archived
-  [{:keys [pool max-age]}]
+  [{:keys [pool]}]
-  (let [interval (db/interval max-age)
+  (let [result (db/exec-one! pool [sql:clean-archived])
-        result   (db/exec-one! pool [sql:clean-archived interval])
         result (:next.jdbc/update-count result)]
-    (l/debug :action "clean archived audit log" :removed result)
+    (l/debug :hint "delete archived audit log entries" :deleted result)
     result))
 
-(s/def ::max-age ::cf/audit-log-gc-max-age)
-
 (defmethod ig/pre-init-spec ::gc-task [_]
-  (s/keys :req-un [::db/pool ::max-age]))
+  (s/keys :req-un [::db/pool]))
 
 (defmethod ig/init-key ::gc-task
   [_ cfg]
-  (fn [_]
+  (partial clean-archived cfg))
-    (clean-archived cfg)))

backend/src/app/loggers/database.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.database
   "A specific logger impl that persists errors on the database."

backend/src/app/loggers/loki.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.loki
   "A Loki integration."

backend/src/app/loggers/mattermost.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.mattermost
   "A mattermost integration for error reporting."

backend/src/app/loggers/sentry.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.sentry
   "A mattermost integration for error reporting."

backend/src/app/loggers/zmq.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.zmq
   "A generic ZMQ listener."

backend/src/app/main.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.main
   (:require
@@ -10,6 +10,7 @@
    [app.common.logging :as l]
    [app.config :as cf]
    [app.util.time :as dt]
+   [cuerdas.core :as str]
    [integrant.core :as ig])
   (:gen-class))
 
@@ -23,23 +24,15 @@
     :migrations (ig/ref :app.migrations/all)
     :name       :main
     :min-size   (cf/get :database-min-pool-size 0)
-    :max-size   (cf/get :database-max-pool-size 30)}
+    :max-size   (cf/get :database-max-pool-size 60)}
 
    ;; Default thread pool for IO operations
    [::default :app.worker/executor]
-   {:parallelism (cf/get :default-executor-parallelism 60)
+   {:parallelism (cf/get :default-executor-parallelism 70)}
-    :prefix :default}
-
-   ;; Constrained thread pool. Should only be used from high resources
-   ;; demanding operations.
-   [::blocking :app.worker/executor]
-   {:parallelism (cf/get :blocking-executor-parallelism 10)
-    :prefix :blocking}
 
    ;; Dedicated thread pool for backround tasks execution.
    [::worker :app.worker/executor]
-   {:parallelism (cf/get :worker-executor-parallelism 10)
+   {:parallelism (cf/get :worker-executor-parallelism 20)}
-    :prefix :worker}
 
    :app.worker/scheduler
    {:parallelism 1
@@ -47,12 +40,10 @@
 
    :app.worker/executors
    {:default (ig/ref [::default :app.worker/executor])
-    :worker   (ig/ref [::worker :app.worker/executor])
+    :worker  (ig/ref [::worker :app.worker/executor])}
-    :blocking (ig/ref [::blocking :app.worker/executor])}
 
-   :app.worker/executors-monitor
+   :app.worker/executor-monitor
    {:metrics   (ig/ref :app.metrics/metrics)
-    :scheduler (ig/ref :app.worker/scheduler)
     :executors (ig/ref :app.worker/executors)}
 
    :app.migrations/migrations
@@ -216,6 +207,10 @@
    {:pool     (ig/ref :app.db/pool)
     :executor (ig/ref [::default :app.worker/executor])}
 
+   :app.rpc/semaphores
+   {:metrics (ig/ref :app.metrics/metrics)
+    :executor (ig/ref [::default :app.worker/executor])}
+
    :app.rpc/rlimit
    {:executor  (ig/ref [::worker :app.worker/executor])
     :scheduler (ig/ref :app.worker/scheduler)}
@@ -234,7 +229,10 @@
     :http-client (ig/ref :app.http/client)
     :rlimit      (ig/ref :app.rpc/rlimit)
     :executors   (ig/ref :app.worker/executors)
-    :templates   (ig/ref :app.setup/builtin-templates)}
+    :executor    (ig/ref [::default :app.worker/executor])
+    :templates   (ig/ref :app.setup/builtin-templates)
+    :semaphores  (ig/ref :app.rpc/semaphores)
+    }
 
    :app.rpc.doc/routes
    {:methods (ig/ref :app.rpc/methods)}
@@ -245,7 +243,7 @@
    :app.worker/registry
    {:metrics (ig/ref :app.metrics/metrics)
     :tasks
-    {:sendmail           (ig/ref :app.emails/sendmail-handler)
+    {:sendmail           (ig/ref :app.emails/handler)
      :objects-gc         (ig/ref :app.tasks.objects-gc/handler)
      :file-gc            (ig/ref :app.tasks.file-gc/handler)
      :file-xlog-gc       (ig/ref :app.tasks.file-xlog-gc/handler)
@@ -257,17 +255,21 @@
      :audit-log-archive  (ig/ref :app.loggers.audit/archive-task)
      :audit-log-gc       (ig/ref :app.loggers.audit/gc-task)}}
 
-   :app.emails/sendmail-handler
+
+   :app.emails/sendmail
    {:host             (cf/get :smtp-host)
     :port             (cf/get :smtp-port)
     :ssl              (cf/get :smtp-ssl)
     :tls              (cf/get :smtp-tls)
     :username         (cf/get :smtp-username)
     :password         (cf/get :smtp-password)
-    :metrics          (ig/ref :app.metrics/metrics)
     :default-reply-to (cf/get :smtp-default-reply-to)
     :default-from     (cf/get :smtp-default-from)}
 
+   :app.emails/handler
+   {:sendmail (ig/ref :app.emails/sendmail)
+    :metrics  (ig/ref :app.metrics/metrics)}
+
    :app.tasks.tasks-gc/handler
    {:pool    (ig/ref :app.db/pool)
     :max-age cf/deletion-delay}
@@ -318,8 +320,7 @@
     :http-client (ig/ref :app.http/client)}
 
    :app.loggers.audit/gc-task
-   {:max-age  (cf/get :audit-log-gc-max-age cf/deletion-delay)
+   {:pool (ig/ref :app.db/pool)}
-    :pool     (ig/ref :app.db/pool)}
 
    :app.loggers.loki/reporter
    {:uri         (cf/get :loggers-loki-uri)
@@ -360,7 +361,7 @@
 
 
 (def worker-config
-  {   :app.worker/cron
+  {:app.worker/cron
    {:executor   (ig/ref [::worker :app.worker/executor])
     :scheduler  (ig/ref :app.worker/scheduler)
     :tasks      (ig/ref :app.worker/registry)
@@ -395,7 +396,7 @@
         :task :audit-log-archive})
 
      (when (contains? cf/flags :audit-log-gc)
-       {:cron #app/cron "0 0 0 * * ?" ;; daily
+       {:cron #app/cron "30 */5 * * * ?" ;; every 5m
         :task :audit-log-gc})]}
 
    :app.worker/worker
@@ -417,6 +418,8 @@
                                  (ig/prep)
                                  (ig/init))))
   (l/info :msg "welcome to penpot"
+          :flags (str/join "," (map name cf/flags))
+          :worker? (contains? cf/flags :backend-worker)
           :version (:full cf/version)))
 
 (defn stop

backend/src/app/media.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.media
   "Media & Font postprocessing."

backend/src/app/metrics.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.metrics
   (:refer-clojure :exclude [run!])
@@ -100,23 +100,23 @@
     ::mdef/labels ["name"]
     ::mdef/type :summary}
 
-   :rpc-semaphore-queued-submissions
+   :semaphore-queued-submissions
-   {::mdef/name "penpot_rpc_semaphore_queued_submissions"
+   {::mdef/name "penpot_semaphore_queued_submissions"
-    ::mdef/help "Current number of queued submissions on RPC-SEMAPHORE."
+    ::mdef/help "Current number of queued submissions on SEMAPHORE."
     ::mdef/labels ["name"]
     ::mdef/type :gauge}
 
-   :rpc-semaphore-used-permits
+   :semaphore-used-permits
-   {::mdef/name "penpot_rpc_semaphore_used_permits"
+   {::mdef/name "penpot_semaphore_used_permits"
-    ::mdef/help "Current number of used permits on RPC-SEMAPHORE."
+    ::mdef/help "Current number of used permits on SEMAPHORE."
     ::mdef/labels ["name"]
     ::mdef/type :gauge}
 
-   :rpc-semaphore-acquires-total
+   :semaphore-timing
-   {::mdef/name "penpot_rpc_semaphore_acquires_total"
+   {::mdef/name "penpot_semaphore_timing"
-    ::mdef/help "Total number of acquire operations on RPC-SEMAPHORE."
+    ::mdef/help "Total timing of SEMAPHORE."
     ::mdef/labels ["name"]
-    ::mdef/type :counter}
+    ::mdef/type :summary}
 
    :executors-active-threads
    {::mdef/name "penpot_executors_active_threads"

backend/src/app/migrations.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.migrations
   (:require

backend/src/app/migrations/clj/migration_0023.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.migrations.clj.migration-0023
   (:require

backend/src/app/msgbus.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.msgbus
   "The msgbus abstraction implemented using redis as underlying backend."

backend/src/app/redis.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.redis
   "The msgbus abstraction implemented using redis as underlying backend."

backend/src/app/rpc.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc
   (:require
@@ -16,10 +16,9 @@
    [app.msgbus :as-alias mbus]
    [app.rpc.retry :as retry]
    [app.rpc.rlimit :as rlimit]
-   [app.rpc.semaphore :as rsem]
+   [app.rpc.semaphore :as-alias rsem]
-   [app.util.async :as async]
    [app.util.services :as sv]
-   [app.worker :as wrk]
+   [app.util.time :as ts]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.core :as p]
@@ -107,38 +106,25 @@
   "Wrap service method with metrics measurement."
   [{:keys [metrics ::metrics-id]} f mdata]
   (let [labels (into-array String [(::sv/name mdata)])]
-
     (fn [cfg params]
-      (let [start (System/nanoTime)]
+      (let [tp (ts/tpoint)]
         (p/finally
           (f cfg params)
           (fn [_ _]
             (mtx/run! metrics
-                      {:id metrics-id
+                      :id metrics-id
-                       :val (/ (- (System/nanoTime) start) 1000000)
+                      :val (inst-ms (tp))
-                       :labels labels})))))))
+                      :labels labels)))))))
 
 (defn- wrap-dispatch
   "Wraps service method into async flow, with the ability to dispatching
   it to a preconfigured executor service."
-  [{:keys [executors] :as cfg} f mdata]
+  [{:keys [executor] :as cfg} f mdata]
-  (let [dname (::async/dispatch mdata :default)]
-    (if (= :none dname)
-      (with-meta
-        (fn [cfg params]
-          (p/do (f cfg params)))
-        mdata)
-
-      (let [executor (get executors dname)]
-        (when-not executor
-          (ex/raise :type :internal
-                    :code :executor-not-configured
-                    :hint (format "executor %s not configured" dname)))
   (with-meta
     (fn [cfg params]
       (-> (px/submit! executor #(f cfg params))
           (p/bind p/wrap)))
-          mdata)))))
+    mdata))
 
 (defn- wrap-audit
   [{:keys [audit] :as cfg} f mdata]
@@ -171,12 +157,11 @@
   [cfg f mdata]
   (let [f     (as-> f $
                 (wrap-dispatch cfg $ mdata)
+                (wrap-metrics cfg $ mdata)
+                (retry/wrap-retry cfg $ mdata)
                 (rsem/wrap cfg $ mdata)
                 (rlimit/wrap cfg $ mdata)
-                (retry/wrap-retry cfg $ mdata)
+                (wrap-audit cfg $ mdata))
-                (wrap-audit cfg $ mdata)
-                (wrap-metrics cfg $ mdata)
-                )
 
         spec  (or (::sv/spec mdata) (s/spec any?))
         auth? (:auth mdata true)]
@@ -245,8 +230,6 @@
          (into {}))))
 
 (s/def ::audit (s/nilable fn?))
-(s/def ::executors (s/map-of keyword? ::wrk/executor))
-(s/def ::executors map?)
 (s/def ::http-client fn?)
 (s/def ::ldap (s/nilable map?))
 (s/def ::msgbus ::mbus/msgbus)
@@ -260,10 +243,10 @@
                    ::session
                    ::sprops
                    ::audit
-                   ::executors
                    ::public-uri
                    ::msgbus
                    ::http-client
+                   ::rsem/semaphores
                    ::rlimit/rlimit
                    ::mtx/metrics
                    ::db/pool

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.auth
   (:require
@@ -136,7 +136,7 @@
 (sv/defmethod ::login-with-password
   "Performs authentication using penpot password."
   {:auth false
-   ::rsem/permits (cf/get :rpc-semaphore-permits-password)
+   ::rsem/queue :auth
    ::doc/added "1.15"}
   [cfg params]
   (login-with-password cfg params))
@@ -177,7 +177,7 @@
 
 (sv/defmethod ::recover-profile
   {:auth false
-   ::rsem/permits (cf/get :rpc-semaphore-permits-password)
+   ::rsem/queue :auth
    ::doc/added "1.15"}
   [cfg params]
   (recover-profile cfg params))
@@ -297,23 +297,52 @@
         (assoc :default-team-id (:id team))
         (assoc :default-project-id (:default-project-id team)))))
 
+(defn send-email-verification!
+  [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 sprops
+                                {:iss :profile-identity
+                                 :profile-id (:id profile)
+                                 :exp (dt/in-future {:days 30})})]
+    (eml/send! {::eml/conn conn
+                ::eml/factory eml/register
+                :public-uri (cf/get :public-uri)
+                :to (:email profile)
+                :name (:fullname profile)
+                :token vtoken
+                :extra-data ptoken})))
+
 (defn register-profile
   [{:keys [conn sprops session] :as cfg} {:keys [token] :as params}]
   (let [claims    (tokens/verify sprops {:token token :iss :prepared-register})
         params    (merge params claims)]
     (check-profile-existence! conn params)
     (let [is-active  (or (:is-active params)
+                         (not (contains? cf/flags :email-verification))
+
+                         ;; DEPRECATED: v1.15
                          (contains? cf/flags :insecure-register))
+
           profile    (->> (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 sprops {:token token :iss :team-invitation}))]
       (cond
-        ;; If invitation token comes in params, this is because the user comes from team-invitation process;
+        ;; If invitation token comes in params, this is because the
-        ;; in this case, regenerate token and send back to the user a new invitation token (and mark current
+        ;; user comes from team-invitation process; in this case,
-        ;; session as logged). This happens only if the invitation email matches with the register email.
+        ;; regenerate token and send back to the user a new invitation
+        ;; token (and mark current session as logged). This happens
+        ;; only if the invitation email matches with the register
+        ;; email.
         (and (some? invitation) (= (:email profile) (:member-email invitation)))
         (let [claims (assoc invitation :member-id  (:id profile))
               token  (tokens/generate sprops claims)
@@ -342,23 +371,8 @@
 
         ;; In all other cases, send a verification email.
         :else
-        (let [vtoken (tokens/generate sprops
+        (do
-                                      {:iss :verify-email
+          (send-email-verification! conn sprops profile)
-                                       :exp (dt/in-future "48h")
-                                       :profile-id (:id profile)
-                                       :email (:email profile)})
-              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/register
-                      :public-uri (:public-uri cfg)
-                      :to (:email profile)
-                      :name (:fullname profile)
-                      :token vtoken
-                      :extra-data ptoken})
-
           (with-meta profile
             {::audit/replace-props (audit/profile->props profile)
              ::audit/profile-id (:id profile)}))))))
@@ -368,7 +382,7 @@
 
 (sv/defmethod ::register-profile
   {:auth false
-   ::rsem/permits (cf/get :rpc-semaphore-permits-password)
+   ::rsem/queue :auth
    ::doc/added "1.15"}
   [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.binfile
   (:refer-clojure :exclude [assert])

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.comments
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.demo
   "A demo specific mutations."

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.files
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.ldap
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.management
   "A collection of RPC methods for manage the files, projects and team organization."

backend/src/app/rpc/doc.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.doc
   "API autogenerated documentation."

backend/src/app/rpc/helpers.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.helpers
   "General purpose RPC helpers."

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.comments
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.files
   (:require
@@ -315,7 +315,7 @@
          (contains? o :changes-with-metadata)))))
 
 (sv/defmethod ::update-file
-  {::rsem/permits (cf/get :rpc-semaphore-permits-file-update)}
+  {::rsem/queue :update-file}
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (db/xact-lock! conn id)

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.fonts
   (:require
@@ -10,7 +10,6 @@
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
-   [app.config :as cf]
    [app.db :as db]
    [app.media :as media]
    [app.rpc.doc :as-alias doc]
@@ -20,8 +19,7 @@
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
-   [promesa.core :as p]
+   [promesa.core :as p]))
-   [promesa.exec :as px]))
 
 (declare create-font-variant)
 
@@ -42,24 +40,21 @@
                    ::font-id ::font-family ::font-weight ::font-style]))
 
 (sv/defmethod ::create-font-variant
-  {::rsem/permits (cf/get :rpc-semaphore-permits-font)}
   [{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}]
   (let [cfg (update cfg :storage media/configure-assets-storage)]
     (teams/check-edition-permissions! pool profile-id team-id)
     (create-font-variant cfg params)))
 
 (defn create-font-variant
-  [{:keys [storage pool executors] :as cfg} {:keys [data] :as params}]
+  [{:keys [storage pool executor semaphores] :as cfg} {:keys [data] :as params}]
   (letfn [(generate-fonts [data]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-font semaphores)
               (media/run {:cmd :generate-fonts :input data})))
 
           ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data. Even though it uses the hight
+          ;; the provided data.
-          ;; performance BLAKE2b algorithm, we prefer to schedule it
-          ;; to be executed on the blocking executor.
           (calculate-hash [data]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-font semaphores)
               (sto/calculate-hash data)))
 
           (validate-data [data]
@@ -110,8 +105,8 @@
 
     (-> (generate-fonts data)
         (p/then validate-data)
-        (p/then persist-fonts (:default executors))
+        (p/then persist-fonts executor)
-        (p/then insert-into-db (:default executors)))))
+        (p/then insert-into-db executor))))
 
 ;; --- UPDATE FONT FAMILY
 

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.management
   "Move & Duplicate RPC methods for files and projects."

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.media
   (:require
@@ -23,8 +23,7 @@
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.io :as io]
-   [promesa.core :as p]
+   [promesa.core :as p]))
-   [promesa.exec :as px]))
 
 (def default-max-file-size (* 1024 1024 10)) ; 10 MiB
 
@@ -53,7 +52,6 @@
           :opt-un [::id]))
 
 (sv/defmethod ::upload-file-media-object
-  {::rsem/permits (cf/get :rpc-semaphore-permits-image)}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id content] :as params}]
   (let [file (select-file pool file-id)
         cfg  (update cfg :storage media/configure-assets-storage)]
@@ -106,26 +104,25 @@
 ;; inverse, soft referential integrity).
 
 (defn create-file-media-object
-  [{:keys [storage pool executors] :as cfg} {:keys [id file-id is-local name content] :as params}]
+  [{:keys [storage pool semaphores] :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]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (media/run {:cmd :info :input content})))
 
           ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data. Even though it uses the hight
+          ;; the provided data.
-          ;; performance BLAKE2b algorithm, we prefer to schedule it
-          ;; to be executed on the blocking executor.
           (calculate-hash [data]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (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]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (media/run (assoc thumbnail-options
                                 :cmd :generic-thumbnail
                                 :input info))))
@@ -157,7 +154,6 @@
                                 :bucket "file-media-object"})))
 
           (insert-into-database [info image thumb]
-            (px/with-dispatch (:default executors)
             (db/exec-one! pool [sql:create-file-media-object
                                 (or id (uuid/next))
                                 file-id is-local name
@@ -165,7 +161,7 @@
                                 (:id thumb)
                                 (:width info)
                                 (:height info)
-                                  (:mtype info)])))]
+                                (:mtype info)]))]
 
     (p/let [info  (get-info content)
             thumb (create-thumbnail info)
@@ -181,7 +177,6 @@
           :opt-un [::id ::name]))
 
 (sv/defmethod ::create-file-media-object-from-url
-  {::rsem/permits (cf/get :rpc-semaphore-permits-image)}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (let [file (select-file pool file-id)
         cfg  (update cfg :storage media/configure-assets-storage)]

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.profile
   (:require
@@ -15,6 +15,7 @@
    [app.loggers.audit :as audit]
    [app.media :as media]
    [app.rpc.commands.auth :as cmd.auth]
+   [app.rpc.doc :as-alias doc]
    [app.rpc.mutations.teams :as teams]
    [app.rpc.queries.profile :as profile]
    [app.rpc.semaphore :as rsem]
@@ -87,7 +88,7 @@
   (s/keys :req-un [::profile-id ::password ::old-password]))
 
 (sv/defmethod ::update-profile-password
-  {::rsem/permits (cf/get :rpc-semaphore-permits-password)}
+  {::rsem/queue :auth}
   [{:keys [pool] :as cfg} {:keys [password] :as params}]
   (db/with-atomic [conn pool]
     (let [profile    (validate-password! conn params)
@@ -130,7 +131,6 @@
   (s/keys :req-un [::profile-id ::file]))
 
 (sv/defmethod ::update-profile-photo
-  {::rsem/permits (cf/get :rpc-semaphore-permits-image)}
   [cfg {:keys [file] :as params}]
   ;; Validate incoming mime type
   (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
@@ -138,8 +138,8 @@
     (update-profile-photo cfg params)))
 
 (defn update-profile-photo
-  [{:keys [pool storage executors] :as cfg} {:keys [profile-id] :as params}]
+  [{:keys [pool storage executor] :as cfg} {:keys [profile-id] :as params}]
-  (p/let [profile (px/with-dispatch (:default executors)
+  (p/let [profile (px/with-dispatch executor
                     (db/get-by-id pool :profile profile-id))
           photo   (teams/upload-photo cfg params)]
 
@@ -169,8 +169,7 @@
           params  (assoc params
                          :profile profile
                          :email (str/lower email))]
-      (if (or (cf/get :smtp-enabled)
+      (if (contains? cf/flags :smtp)
-              (contains? cf/flags :smtp))
         (request-email-change cfg params)
         (change-email-immediately cfg params)))))
 
@@ -305,7 +304,10 @@
 (s/def ::login ::cmd.auth/login-with-password)
 
 (sv/defmethod ::login
-  {:auth false ::rsem/permits (cf/get :rpc-semaphore-permits-password)}
+  {:auth false
+   ::rsem/queue :auth
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [cfg params]
   (cmd.auth/login-with-password cfg params))
 
@@ -313,7 +315,10 @@
 
 (s/def ::logout ::cmd.auth/logout)
 
-(sv/defmethod ::logout {:auth false}
+(sv/defmethod ::logout
+  {:auth false
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [{:keys [session] :as cfg} _]
   (with-meta {}
     {:transform-response (:delete session)}))
@@ -323,7 +328,8 @@
 (s/def ::recover-profile ::cmd.auth/recover-profile)
 
 (sv/defmethod ::recover-profile
-  {:auth false ::rsem/permits (cf/get :rpc-semaphore-permits-password)}
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [cfg params]
   (cmd.auth/recover-profile cfg params))
 
@@ -331,7 +337,10 @@
 
 (s/def ::prepare-register-profile ::cmd.auth/prepare-register-profile)
 
-(sv/defmethod ::prepare-register-profile {:auth false}
+(sv/defmethod ::prepare-register-profile
+  {:auth false
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [cfg params]
   (cmd.auth/prepare-register cfg params))
 
@@ -340,7 +349,10 @@
 (s/def ::register-profile ::cmd.auth/register-profile)
 
 (sv/defmethod ::register-profile
-  {:auth false ::rsem/permits (cf/get :rpc-semaphore-permits-password)}
+  {:auth false
+   ::rsem/queue :auth
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
     (-> (assoc cfg :conn conn)
@@ -350,6 +362,9 @@
 
 (s/def ::request-profile-recovery ::cmd.auth/request-profile-recovery)
 
-(sv/defmethod ::request-profile-recovery {:auth false}
+(sv/defmethod ::request-profile-recovery
+  {:auth false
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [cfg params]
   (cmd.auth/request-profile-recovery cfg params))

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.projects
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.share-link
   "Share link related rpc mutation methods."

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.teams
   (:require
@@ -290,7 +290,6 @@
   (s/keys :req-un [::profile-id ::team-id ::file]))
 
 (sv/defmethod ::update-team-photo
-  {::rsem/permits (cf/get :rpc-semaphore-permits-image)}
   [cfg {:keys [file] :as params}]
   ;; Validate incoming mime type
   (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
@@ -298,8 +297,8 @@
     (update-team-photo cfg params)))
 
 (defn update-team-photo
-  [{:keys [pool storage executors] :as cfg} {:keys [profile-id team-id] :as params}]
+  [{:keys [pool storage executor] :as cfg} {:keys [profile-id team-id] :as params}]
-  (p/let [team  (px/with-dispatch (:default executors)
+  (p/let [team  (px/with-dispatch executor
                   (teams/retrieve-team pool profile-id team-id))
           photo (upload-photo cfg params)]
 
@@ -316,13 +315,13 @@
     (assoc team :photo-id (:id photo))))
 
 (defn upload-photo
-  [{:keys [storage executors] :as cfg} {:keys [file]}]
+  [{:keys [storage semaphores] :as cfg} {:keys [file]}]
   (letfn [(get-info [content]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (media/run {:cmd :info :input content})))
 
           (generate-thumbnail [info]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (media/run {:cmd :profile-thumbnail
                           :format :jpeg
                           :quality 85
@@ -331,11 +330,9 @@
                           :input info})))
 
           ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data. Even though it uses the hight
+          ;; the provided data.
-          ;; performance BLAKE2b algorithm, we prefer to schedule it
-          ;; to be executed on the blocking executor.
           (calculate-hash [data]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (sto/calculate-hash data)))]
 
     (p/let [info    (get-info file)
@@ -343,11 +340,11 @@
             hash    (calculate-hash (:data thumb))
             content (-> (sto/content (:data thumb) (:size thumb))
                         (sto/wrap-with-hash hash))]
+      (rsem/with-dispatch (:process-image semaphores)
         (sto/put-object! storage {::sto/content content
                                   ::sto/deduplicate? true
                                   :bucket "profile"
-                                :content-type (:mtype thumb)}))))
+                                  :content-type (:mtype thumb)})))))
-
 
 ;; --- Mutation: Invite Member
 
@@ -422,18 +419,43 @@
       (ex/raise :type :validation
                 :code :member-is-muted
                 :email email
-                :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
+                :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 "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
+                :hint "the email you invite has been repeatedly reported as spam or bounce"))
 
+    ;; 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)}))
+
+        (assoc member :is-active true))
+
+      (do
         (db/exec-one! conn [sql:upsert-team-invitation
-                        (:id team) (str/lower email) (name role) token-exp (name role) token-exp])
+                            (: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)
@@ -441,7 +463,7 @@
                     :invited-by (:fullname profile)
                     :team (:name team)
                     :token itoken
-                :extra-data ptoken})))
+                    :extra-data ptoken})))))
 
 ;; --- Mutation: Create Team & Invite Members
 

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.mutations.verify-token
   (:require

backend/src/app/rpc/permissions.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.permissions
   "A permission checking helper factories."

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.queries.comments
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.queries.files
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.queries.fonts
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.queries.profile
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.queries.projects
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.queries.share-link
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.queries.teams
   (:require

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

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.queries.viewer
   (:require

backend/src/app/rpc/retry.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.retry
   "A fault tolerance helpers. Allow retry some operations that we know

backend/src/app/rpc/rlimit.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.rlimit
   "Rate limit strategies implementation for RPC services.

backend/src/app/rpc/semaphore.clj

@@ -2,30 +2,45 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.semaphore
   "Resource usage limits (in other words: semaphores)."
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.config :as cf]
    [app.metrics :as mtx]
+   [app.rpc :as-alias rpc]
    [app.util.locks :as locks]
-   [app.util.services :as-alias sv]
+   [app.util.time :as ts]
+   [app.worker :as-alias wrk]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]
    [promesa.core :as p]))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ASYNC SEMAPHORE IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defprotocol IAsyncSemaphore
   (acquire! [_])
-  (release! [_]))
+  (release! [_ tp]))
 
 (defn create
-  [& {:keys [permits metrics name]}]
+  [& {:keys [permits metrics name executor]}]
-  (let [name   (d/name name)
+  (let [used    (volatile! 0)
-        used   (volatile! 0)
         queue   (volatile! (d/queue))
-        labels (into-array String [name])
+        labels  (into-array String [(d/name name)])
-        lock   (locks/create)]
+        lock    (locks/create)
+        permits (or permits Long/MAX_VALUE)]
 
+    (when (>= permits Long/MAX_VALUE)
+      (l/warn :hint "permits value too hight" :permits permits :semaphore name))
+
+    ^{::wrk/executor executor
+      ::name name}
     (reify IAsyncSemaphore
       (acquire! [_]
         (let [d (p/deferred)]
@@ -36,12 +51,17 @@
                 (p/resolve! d))
               (vswap! queue conj d)))
 
-          (mtx/run! metrics {:id :rpc-semaphore-used-permits :val @used :labels labels })
+          (mtx/run! metrics
-          (mtx/run! metrics {:id :rpc-semaphore-queued-submissions :val (count @queue) :labels labels})
+                    :id :semaphore-used-permits
-          (mtx/run! metrics {:id :rpc-semaphore-acquires-total :inc 1 :labels labels})
+                    :val @used
+                    :labels labels)
+          (mtx/run! metrics
+                    :id :semaphore-queued-submissions
+                    :val (count @queue)
+                    :labels labels)
           d))
 
-      (release! [_]
+      (release! [_ tp]
         (locks/locking lock
           (if-let [item (peek @queue)]
             (do
@@ -50,19 +70,80 @@
             (when (pos? @used)
               (vswap! used dec))))
 
-        (mtx/run! metrics {:id :rpc-semaphore-used-permits :val @used :labels labels})
+        (mtx/run! metrics
-        (mtx/run! metrics {:id :rpc-semaphore-queued-submissions :val (count @queue) :labels labels})))))
+                  :id :semaphore-timing
+                  :val (inst-ms (tp))
+                  :labels labels)
+        (mtx/run! metrics
+                  :id :semaphore-used-permits
+                  :val @used
+                  :labels labels)
+        (mtx/run! metrics
+                  :id :semaphore-queued-submissions
+                  :val (count @queue)
+                  :labels labels)))))
+
+(defn semaphore?
+  [v]
+  (satisfies? IAsyncSemaphore v))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PREDEFINED SEMAPHORES
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(s/def ::semaphore semaphore?)
+(s/def ::semaphores
+  (s/map-of ::us/keyword ::semaphore))
+
+(defmethod ig/pre-init-spec ::rpc/semaphores [_]
+  (s/keys :req-un [::mtx/metrics]))
+
+(defn- create-default-semaphores
+  [metrics executor]
+  [(create :permits (cf/get :semaphore-process-font)
+           :metrics metrics
+           :name :process-font
+           :executor executor)
+   (create :permits (cf/get :semaphore-update-file)
+           :metrics metrics
+           :name :update-file
+           :executor executor)
+   (create :permits (cf/get :semaphore-process-image)
+           :metrics metrics
+           :name :process-image
+           :executor executor)
+   (create :permits (cf/get :semaphore-auth)
+           :metrics metrics
+           :name :auth
+           :executor executor)])
+
+(defmethod ig/init-key ::rpc/semaphores
+  [_ {:keys [metrics executor]}]
+  (->> (create-default-semaphores metrics executor)
+       (d/index-by (comp ::name meta))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PUBLIC API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro with-dispatch
+  [queue & body]
+  `(let [tpoint#   (ts/tpoint)
+         queue#    ~queue
+         executor# (-> queue# meta ::wrk/executor)]
+     (-> (acquire! queue#)
+         (p/then (fn [_#] ~@body) executor#)
+         (p/finally (fn [_# _#]
+                      (release! queue# tpoint#))))))
 
 (defn wrap
-  [{:keys [metrics executors] :as cfg} f mdata]
+  [{:keys [semaphores]} f {:keys [::queue]}]
-  (if-let [permits (::permits mdata)]
+  (let [queue' (get semaphores queue)]
-    (let [sem (create {:permits permits
+    (if (semaphore? queue')
-                       :metrics metrics
-                       :name (::sv/name mdata)})]
-      (l/debug :hint "wrapping semaphore" :handler (::sv/name mdata) :permits permits)
       (fn [cfg params]
-        (-> (acquire! sem)
+        (with-dispatch queue'
-            (p/then (fn [_] (f cfg params)) (:default executors))
+          (f cfg params)))
-            (p/finally (fn [_ _] (release! sem))))))
+      (do
-    f))
+        (when (some? queue)
-
+          (l/warn :hint "undefined semaphore" :name queue))
+        f))))

backend/src/app/setup.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.setup
   "Initial data setup of instance."

backend/src/app/setup/builtin_templates.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.setup.builtin-templates
   "A service/module that is reponsible for download, load & internally

backend/src/app/setup/keys.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.setup.keys
   "Keys derivation service."

backend/src/app/srepl.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.srepl
   "Server Repl."

backend/src/app/srepl/fixes.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.srepl.fixes
   "A collection of adhoc fixes scripts."

backend/src/app/srepl/helpers.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.srepl.helpers
   "A  main namespace for server repl."

backend/src/app/srepl/main.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.srepl.main
   "A collection of adhoc fixes scripts."
@@ -10,18 +10,21 @@
   (:require
    [app.common.logging :as l]
    [app.common.pprint :as p]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.rpc.commands.auth :as cmd.auth]
+   [app.rpc.queries.profile :as profile]
    [app.srepl.fixes :as f]
    [app.srepl.helpers :as h]
-   [clojure.pprint :refer [pprint]]))
+   [app.util.time :as dt]
-
+   [clojure.pprint :refer [pprint]]
-;; Empty namespace as main entry point for Server REPL
+   [cuerdas.core :as str]))
 
 (defn print-available-tasks
   [system]
   (let [tasks (:app.worker/registry system)]
     (p/pprint (keys tasks) :level 200)))
 
-
 (defn run-task!
   ([system name]
    (run-task! system name {}))
@@ -29,4 +32,57 @@
    (let [tasks (:app.worker/registry system)]
      (if-let [task-fn (get tasks name)]
        (task-fn params)
-       (l/warn :hint "no task found" :name name)))))
+       (println (format "no task '%s' found" name))))))
+
+(defn send-test-email!
+  [system destination]
+  (us/verify!
+   :expr (some? system)
+   :hint "system should be provided")
+
+  (us/verify!
+   :expr (string? destination)
+   :hint "destination should be provided")
+
+  (let [handler (:app.emails/sendmail system)]
+    (handler {:body "test email"
+              :subject "test email"
+              :to [destination]})))
+
+(defn resend-email-verification-email!
+  [system email]
+  (us/verify!
+   :expr (some? system)
+   :hint "system should be provided")
+
+  (let [sprops  (:app.setup/props system)
+        pool    (:app.db/pool system)
+        profile (profile/retrieve-profile-data-by-email pool email)]
+
+    (cmd.auth/send-email-verification! pool sprops profile)
+    :email-sent))
+
+(defn update-profile
+  "Update a limited set of profile attrs."
+  [system & {:keys [email id active? deleted?]}]
+
+  (us/verify!
+   :expr (some? system)
+   :hint "system should be provided")
+
+  (us/verify!
+   :expr (or (string? email) (uuid? id))
+   :hint "email or id should be provided")
+
+  (let [pool   (:app.db/pool system)
+        params (cond-> {}
+                 (true? active?) (assoc :is-active true)
+                 (false? active?) (assoc :is-active false)
+                 (true? deleted?) (assoc :deleted-at (dt/now)))
+        opts   (cond-> {}
+                 (some? email) (assoc :email (str/lower email))
+                 (some? id)    (assoc :id id))]
+
+    (some-> (db/update! pool :profile params opts)
+            (profile/decode-profile-row))))
+

backend/src/app/storage.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.storage
   "Objects storage abstraction layer."

backend/src/app/storage/fs.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.storage.fs
   (:require

backend/src/app/storage/impl.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.storage.impl
   "Storage backends abstraction layer."

backend/src/app/storage/s3.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.storage.s3
   "S3 Storage backend implementation."

backend/src/app/storage/tmp.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.storage.tmp
   "Temporal files service all created files will be tried to clean after

backend/src/app/tasks/file_gc.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.tasks.file-gc
   "A maintenance task that is responsible of: purge unused file media,

backend/src/app/tasks/file_xlog_gc.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.tasks.file-xlog-gc
   "A maintenance task that performs a garbage collection of the file

backend/src/app/tasks/objects_gc.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.tasks.objects-gc
   "A maintenance task that performs a general purpose garbage collection

backend/src/app/tasks/tasks_gc.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.tasks.tasks-gc
   "A maintenance task that performs a cleanup of already executed tasks

backend/src/app/tasks/telemetry.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.tasks.telemetry
   "A task that is responsible to collect anonymous statistical

backend/src/app/tokens.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.tokens
   "Tokens generation API."

backend/src/app/util/async.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.async
   (:require

backend/src/app/util/blob.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.blob
   "A generic blob storage encoding. Mainly used for page data, page

backend/src/app/util/closeable.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.closeable
   "A closeable abstraction. A drop in replacement for

backend/src/app/util/emails.clj

@@ -1,252 +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) UXBOX Labs SL
-
-(ns app.util.emails
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.util.template :as tmpl]
-   [clojure.java.io :as io]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str])
-  (:import
-   java.util.Properties
-   jakarta.mail.Message$RecipientType
-   jakarta.mail.Session
-   jakarta.mail.Transport
-   jakarta.mail.internet.InternetAddress
-   jakarta.mail.internet.MimeBodyPart
-   jakarta.mail.internet.MimeMessage
-   jakarta.mail.internet.MimeMultipart))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Email Building
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- parse-address
-  [v]
-  (InternetAddress/parse ^String v))
-
-(defn- resolve-recipient-type
-  ^Message$RecipientType
-  [type]
-  (case type
-    :to  Message$RecipientType/TO
-    :cc  Message$RecipientType/CC
-    :bcc Message$RecipientType/BCC))
-
-(defn- assign-recipient
-  [^MimeMessage mmsg type address]
-  (if (sequential? address)
-    (reduce #(assign-recipient %1 type %2) mmsg address)
-    (let [address (parse-address address)
-          type    (resolve-recipient-type type)]
-      (.addRecipients mmsg type address)
-      mmsg)))
-
-(defn- assign-recipients
-  [mmsg {:keys [to cc bcc] :as params}]
-  (cond-> mmsg
-    (some? to)  (assign-recipient :to to)
-    (some? cc)  (assign-recipient :cc cc)
-    (some? bcc) (assign-recipient :bcc bcc)))
-
-(defn- assign-from
-  [mmsg {:keys [default-from]} {:keys [from] :as props}]
-  (let [from (or from default-from)]
-    (when from
-      (let [from (parse-address from)]
-        (.addFrom ^MimeMessage mmsg from)))))
-
-(defn- assign-reply-to
-  [mmsg {:keys [default-reply-to] :as cfg} {:keys [reply-to] :as params}]
-  (let [reply-to (or reply-to default-reply-to)]
-    (when reply-to
-      (let [reply-to (parse-address reply-to)]
-        (.setReplyTo ^MimeMessage mmsg reply-to)))))
-
-(defn- assign-subject
-  [mmsg {:keys [subject charset] :or {charset "utf-8"}}]
-  (assert (string? subject) "subject is mandatory")
-  (.setSubject ^MimeMessage mmsg
-               ^String subject
-               ^String charset))
-
-(defn- assign-extra-headers
-  [^MimeMessage mmsg {:keys [headers extra-data] :as params}]
-  (let [headers (assoc headers "X-Penpot-Data" extra-data)]
-    (reduce-kv (fn [^MimeMessage mmsg k v]
-                 (doto mmsg
-                   (.addHeader (name k) (str v))))
-               mmsg
-               headers)))
-
-(defn- assign-body
-  [^MimeMessage mmsg {:keys [body charset] :or {charset "utf-8"}}]
-  (let [mpart (MimeMultipart. "mixed")]
-    (cond
-      (string? body)
-      (let [bpart (MimeBodyPart.)]
-        (.setContent bpart ^String body (str "text/plain; charset=" charset))
-        (.addBodyPart mpart bpart))
-
-      (vector? body)
-      (let [mmp (MimeMultipart. "alternative")
-            mbp (MimeBodyPart.)]
-        (.addBodyPart mpart mbp)
-        (.setContent mbp mmp)
-        (doseq [item body]
-          (let [mbp (MimeBodyPart.)]
-            (.setContent mbp
-                         ^String (:content item)
-                         ^String (str (:type item "text/plain") "; charset=" charset))
-            (.addBodyPart mmp mbp))))
-
-      (map? body)
-      (let [bpart (MimeBodyPart.)]
-        (.setContent bpart
-                     ^String (:content body)
-                     ^String (str (:type body "text/plain") "; charset=" charset))
-        (.addBodyPart mpart bpart))
-
-      :else
-      (throw (ex-info "Unsupported type" {:body body})))
-    (.setContent mmsg mpart)
-    mmsg))
-
-(defn- build-message
-  [cfg session params]
-  (let [mmsg (MimeMessage. ^Session session)]
-    (assign-recipients mmsg params)
-    (assign-from mmsg cfg params)
-    (assign-reply-to mmsg cfg params)
-    (assign-subject mmsg params)
-    (assign-extra-headers mmsg params)
-    (assign-body mmsg params)
-    (.saveChanges mmsg)
-    mmsg))
-
-(defn- opts->props
-  [{:keys [username tls host port timeout default-from]
-    :or {timeout 30000}
-    :as opts}]
-  (reduce-kv
-   (fn [^Properties props k v]
-     (if (nil? v)
-       props
-       (doto props (.put ^String k  ^String (str v)))))
-   (Properties.)
-   {"mail.user" username
-    "mail.host" host
-    "mail.from" default-from
-    "mail.smtp.auth" (boolean username)
-    "mail.smtp.starttls.enable" tls
-    "mail.smtp.starttls.required" tls
-    "mail.smtp.host" host
-    "mail.smtp.port" port
-    "mail.smtp.user" username
-    "mail.smtp.timeout" timeout
-    "mail.smtp.connectiontimeout" timeout}))
-
-(defn smtp-session
-  [{:keys [debug] :or {debug false} :as opts}]
-  (let [props   (opts->props opts)
-        session (Session/getInstance props)]
-    (.setDebug session debug)
-    session))
-
-(defn smtp-message
-  ^MimeMessage
-  [cfg message]
-  (let [^Session session (smtp-session cfg)]
-    (build-message cfg session message)))
-
-;; TODO: specs for smtp config
-
-(defn send!
-  [cfg message]
-  (let [^MimeMessage message (smtp-message cfg message)]
-    (Transport/send message
-                    (:username cfg)
-                    (:password cfg))
-    nil))
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Template Email Building
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:private email-path "app/emails/%(id)s/%(lang)s.%(type)s")
-
-(defn- render-email-template-part
-  [type id context]
-  (let [lang (:lang context :en)
-        path (str/format email-path {:id (name id)
-                                     :lang (name lang)
-                                     :type (name type)})]
-    (some-> (io/resource path)
-            (tmpl/render context))))
-
-(defn- build-email-template
-  [id context]
-  (let [subj (render-email-template-part :subj id context)
-        text (render-email-template-part :txt id context)
-        html (render-email-template-part :html id context)]
-    (when (or (not subj)
-              (and (not text)
-                   (not html)))
-      (ex/raise :type :internal
-                :code :missing-email-templates))
-    {:subject subj
-     :body (into
-            [{:type "text/plain"
-              :content text}]
-            (when html
-              [{:type "text/html"
-                :content html}]))}))
-
-(s/def ::priority #{:high :low})
-(s/def ::to (s/or :single ::us/email
-                  :multi (s/coll-of ::us/email)))
-(s/def ::from ::us/email)
-(s/def ::reply-to ::us/email)
-(s/def ::lang string?)
-(s/def ::extra-data ::us/string)
-
-(s/def ::context
-  (s/keys :req-un [::to]
-          :opt-un [::reply-to ::from ::lang ::priority ::extra-data]))
-
-(defn template-factory
-  ([id] (template-factory id {}))
-  ([id extra-context]
-   (s/assert keyword? id)
-   (fn [context]
-     (us/verify ::context context)
-     (when-let [spec (s/get-spec id)]
-       (s/assert spec context))
-
-     (let [context (merge (if (fn? extra-context)
-                            (extra-context)
-                            extra-context)
-                          context)
-           email   (build-email-template id context)]
-       (when-not email
-         (ex/raise :type :internal
-                   :code :email-template-does-not-exists
-                   :hint "seems like the template is wrong or does not exists."
-                   :context {:id id}))
-       (cond-> (assoc email :id (name id))
-         (:extra-data context)
-         (assoc :extra-data (:extra-data context))
-
-         (:from context)
-         (assoc :from (:from context))
-
-         (:reply-to context)
-         (assoc :reply-to (:reply-to context))
-
-         (:to context)
-         (assoc :to (:to context)))))))

backend/src/app/util/fressian.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.fressian
   (:require

backend/src/app/util/json.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.json
   (:refer-clojure :exclude [read])

backend/src/app/util/locks.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.locks
   "A syntactic helpers for using locks."

backend/src/app/util/migrations.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.migrations
   (:require

backend/src/app/util/services.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.services
   "A helpers and macros for define rpc like registry based services."

backend/src/app/util/svg.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.svg
   (:require

backend/src/app/util/template.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.template
   (:require

backend/src/app/util/time.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.time
   (:require

backend/src/app/util/transit.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.transit
   (:require

backend/src/app/util/websocket.clj

@@ -2,7 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.util.websocket
   "A general protocol implementation on top of websockets."