mirror of
https://github.com/penpot/penpot.git
synced 2025-03-20 19:51:23 -05:00
Merge pull request #2302 from penpot/niwinz-hot-improvements
Enhancements
This commit is contained in:
commit
cc18f84d62
532 changed files with 1483 additions and 1244 deletions
CHANGES.md
backend
deps.ednsetup.clj
dev
scripts
src/app
auth
cli
config.cljdb.cljdb
emails.cljhttp.cljhttp
loggers
main.cljmedia.cljmetrics.cljmigrations.cljmigrations/clj
msgbus.cljredis.cljrpc.cljrpc
commands
doc.cljhelpers.cljmutations
comments.cljfiles.cljfonts.cljmanagement.cljmedia.cljprofile.cljprojects.cljshare_link.cljteams.cljverify_token.clj
permissions.cljqueries
retry.cljrlimit.cljsemaphore.cljsetup
srepl.cljsrepl
storage.cljstorage
tasks
tokens.cljutil
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
::rpc-semaphore-permits-image
|
||||
::rpc-semaphore-permits-password
|
||||
|
||||
::semaphore-process-font
|
||||
::semaphore-process-image
|
||||
::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
|
||||
(let [flags (parse-flags config)]
|
||||
(l/info :hint "flags initialized" :flags (str/join "," (map name flags)))
|
||||
flags))
|
||||
(defonce ^:dynamic flags (parse-flags config))
|
||||
|
||||
(def deletion-delay
|
||||
(dt/duration {:days 7}))
|
||||
|
|
|
@ -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)
|
||||
(->> (/ data 1000.0)
|
||||
(or (integer? o)
|
||||
(float? o))
|
||||
(->> (/ o 1000.0)
|
||||
(format "%s seconds")
|
||||
(pginterval))
|
||||
|
||||
(string? data)
|
||||
(pginterval data)
|
||||
(string? o)
|
||||
(pginterval o)
|
||||
|
||||
(dt/duration? data)
|
||||
(->> (/ (.toMillis ^java.time.Duration data) 1000.0)
|
||||
(format "%s seconds")
|
||||
(pginterval))
|
||||
(dt/duration? o)
|
||||
(interval (inst-ms o))
|
||||
|
||||
:else
|
||||
(ex/raise :type :not-implemented)))
|
||||
(ex/raise :type :not-implemented
|
||||
:hint (format "no implementation found for value %s" (pr-str o)))))
|
||||
|
||||
(defn decode-json-pgobject
|
||||
[^PGobject o]
|
||||
|
|
|
@ -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])
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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])
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
and archived_at < now() - ?::interval")
|
||||
where archived_at is not null")
|
||||
|
||||
(defn- clean-archived
|
||||
[{:keys [pool max-age]}]
|
||||
(let [interval (db/interval max-age)
|
||||
result (db/exec-one! pool [sql:clean-archived interval])
|
||||
result (:next.jdbc/update-count result)]
|
||||
(l/debug :action "clean archived audit log" :removed result)
|
||||
[{:keys [pool]}]
|
||||
(let [result (db/exec-one! pool [sql:clean-archived])
|
||||
result (:next.jdbc/update-count result)]
|
||||
(l/debug :hint "delete archived audit log entries" :deleted result)
|
||||
result))
|
||||
|
||||
(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 [_]
|
||||
(clean-archived cfg)))
|
||||
(partial clean-archived cfg))
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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,36 +24,26 @@
|
|||
: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)
|
||||
: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}
|
||||
{:parallelism (cf/get :default-executor-parallelism 70)}
|
||||
|
||||
;; Dedicated thread pool for backround tasks execution.
|
||||
[::worker :app.worker/executor]
|
||||
{:parallelism (cf/get :worker-executor-parallelism 10)
|
||||
:prefix :worker}
|
||||
{:parallelism (cf/get :worker-executor-parallelism 20)}
|
||||
|
||||
:app.worker/scheduler
|
||||
{:parallelism 1
|
||||
:prefix :scheduler}
|
||||
|
||||
:app.worker/executors
|
||||
{:default (ig/ref [::default :app.worker/executor])
|
||||
:worker (ig/ref [::worker :app.worker/executor])
|
||||
:blocking (ig/ref [::blocking :app.worker/executor])}
|
||||
{:default (ig/ref [::default :app.worker/executor])
|
||||
:worker (ig/ref [::worker :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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
{::mdef/name "penpot_rpc_semaphore_queued_submissions"
|
||||
::mdef/help "Current number of queued submissions on RPC-SEMAPHORE."
|
||||
:semaphore-queued-submissions
|
||||
{::mdef/name "penpot_semaphore_queued_submissions"
|
||||
::mdef/help "Current number of queued submissions on SEMAPHORE."
|
||||
::mdef/labels ["name"]
|
||||
::mdef/type :gauge}
|
||||
|
||||
:rpc-semaphore-used-permits
|
||||
{::mdef/name "penpot_rpc_semaphore_used_permits"
|
||||
::mdef/help "Current number of used permits on RPC-SEMAPHORE."
|
||||
:semaphore-used-permits
|
||||
{::mdef/name "penpot_semaphore_used_permits"
|
||||
::mdef/help "Current number of used permits on SEMAPHORE."
|
||||
::mdef/labels ["name"]
|
||||
::mdef/type :gauge}
|
||||
|
||||
:rpc-semaphore-acquires-total
|
||||
{::mdef/name "penpot_rpc_semaphore_acquires_total"
|
||||
::mdef/help "Total number of acquire operations on RPC-SEMAPHORE."
|
||||
:semaphore-timing
|
||||
{::mdef/name "penpot_semaphore_timing"
|
||||
::mdef/help "Total timing of SEMAPHORE."
|
||||
::mdef/labels ["name"]
|
||||
::mdef/type :counter}
|
||||
::mdef/type :summary}
|
||||
|
||||
:executors-active-threads
|
||||
{::mdef/name "penpot_executors_active_threads"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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.util.async :as async]
|
||||
[app.rpc.semaphore :as-alias rsem]
|
||||
[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
|
||||
:val (/ (- (System/nanoTime) start) 1000000)
|
||||
:labels labels})))))))
|
||||
:id metrics-id
|
||||
:val (inst-ms (tp))
|
||||
:labels labels)))))))
|
||||
|
||||
(defn- wrap-dispatch
|
||||
"Wraps service method into async flow, with the ability to dispatching
|
||||
it to a preconfigured executor service."
|
||||
[{:keys [executors] :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)))))
|
||||
[{:keys [executor] :as cfg} f mdata]
|
||||
(with-meta
|
||||
(fn [cfg params]
|
||||
(-> (px/submit! executor #(f cfg params))
|
||||
(p/bind p/wrap)))
|
||||
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-metrics cfg $ mdata)
|
||||
)
|
||||
(wrap-audit 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
|
||||
|
|
|
@ -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;
|
||||
;; in this case, 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.
|
||||
;; If invitation token comes in params, this is because the
|
||||
;; user comes from team-invitation process; in this case,
|
||||
;; regenerate token and send back to the user a new invitation
|
||||
;; token (and mark current session as logged). 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
|
||||
{:iss :verify-email
|
||||
: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})
|
||||
|
||||
(do
|
||||
(send-email-verification! conn sprops profile)
|
||||
(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]
|
||||
|
|
|
@ -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])
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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.exec :as px]))
|
||||
[promesa.core :as p]))
|
||||
|
||||
(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
|
||||
;; performance BLAKE2b algorithm, we prefer to schedule it
|
||||
;; to be executed on the blocking executor.
|
||||
;; the provided data.
|
||||
(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 insert-into-db (:default executors)))))
|
||||
(p/then persist-fonts executor)
|
||||
(p/then insert-into-db executor))))
|
||||
|
||||
;; --- UPDATE FONT FAMILY
|
||||
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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.exec :as px]))
|
||||
[promesa.core :as p]))
|
||||
|
||||
(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
|
||||
;; performance BLAKE2b algorithm, we prefer to schedule it
|
||||
;; to be executed on the blocking executor.
|
||||
;; the provided data.
|
||||
(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,15 +154,14 @@
|
|||
: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
|
||||
(:id image)
|
||||
(:id thumb)
|
||||
(:width info)
|
||||
(:height info)
|
||||
(:mtype info)])))]
|
||||
(db/exec-one! pool [sql:create-file-media-object
|
||||
(or id (uuid/next))
|
||||
file-id is-local name
|
||||
(:id image)
|
||||
(:id thumb)
|
||||
(:width info)
|
||||
(:height info)
|
||||
(:mtype info)]))]
|
||||
|
||||
(p/let [info (get-info content)
|
||||
thumb (create-thumbnail info)
|
||||
|
@ -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)]
|
||||
|
|
|
@ -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}]
|
||||
(p/let [profile (px/with-dispatch (:default executors)
|
||||
[{:keys [pool storage executor] :as cfg} {:keys [profile-id] :as params}]
|
||||
(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)
|
||||
(contains? cf/flags :smtp))
|
||||
(if (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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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}]
|
||||
(p/let [team (px/with-dispatch (:default executors)
|
||||
[{:keys [pool storage executor] :as cfg} {:keys [profile-id team-id] :as params}]
|
||||
(p/let [team (px/with-dispatch executor
|
||||
(teams/retrieve-team pool profile-id team-id))
|
||||
photo (upload-photo cfg params)]
|
||||
|
||||
|
@ -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
|
||||
;; performance BLAKE2b algorithm, we prefer to schedule it
|
||||
;; to be executed on the blocking executor.
|
||||
;; the provided data.
|
||||
(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))]
|
||||
(sto/put-object! storage {::sto/content content
|
||||
::sto/deduplicate? true
|
||||
:bucket "profile"
|
||||
:content-type (:mtype thumb)}))))
|
||||
|
||||
(rsem/with-dispatch (:process-image semaphores)
|
||||
(sto/put-object! storage {::sto/content content
|
||||
::sto/deduplicate? true
|
||||
:bucket "profile"
|
||||
:content-type (:mtype thumb)})))))
|
||||
|
||||
;; --- Mutation: Invite Member
|
||||
|
||||
|
@ -422,26 +419,51 @@
|
|||
(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"))
|
||||
|
||||
(db/exec-one! conn [sql:upsert-team-invitation
|
||||
(:id team) (str/lower email) (name role) token-exp (name role) token-exp])
|
||||
;; 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.
|
||||
|
||||
(eml/send! {::eml/conn conn
|
||||
::eml/factory eml/invite-to-team
|
||||
:public-uri (:public-uri cfg)
|
||||
:to email
|
||||
:invited-by (:fullname profile)
|
||||
:team (:name team)
|
||||
:token itoken
|
||||
:extra-data ptoken})))
|
||||
;; 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])
|
||||
(eml/send! {::eml/conn conn
|
||||
::eml/factory eml/invite-to-team
|
||||
:public-uri (:public-uri cfg)
|
||||
:to email
|
||||
:invited-by (:fullname profile)
|
||||
:team (:name team)
|
||||
:token itoken
|
||||
:extra-data ptoken})))))
|
||||
|
||||
;; --- Mutation: Create Team & Invite Members
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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]}]
|
||||
(let [name (d/name name)
|
||||
used (volatile! 0)
|
||||
queue (volatile! (d/queue))
|
||||
labels (into-array String [name])
|
||||
lock (locks/create)]
|
||||
[& {:keys [permits metrics name executor]}]
|
||||
(let [used (volatile! 0)
|
||||
queue (volatile! (d/queue))
|
||||
labels (into-array String [(d/name name)])
|
||||
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 {:id :rpc-semaphore-queued-submissions :val (count @queue) :labels labels})
|
||||
(mtx/run! metrics {:id :rpc-semaphore-acquires-total :inc 1 :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)
|
||||
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 {:id :rpc-semaphore-queued-submissions :val (count @queue) :labels labels})))))
|
||||
(mtx/run! metrics
|
||||
: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]
|
||||
(if-let [permits (::permits mdata)]
|
||||
(let [sem (create {:permits permits
|
||||
:metrics metrics
|
||||
:name (::sv/name mdata)})]
|
||||
(l/debug :hint "wrapping semaphore" :handler (::sv/name mdata) :permits permits)
|
||||
[{:keys [semaphores]} f {:keys [::queue]}]
|
||||
(let [queue' (get semaphores queue)]
|
||||
(if (semaphore? queue')
|
||||
(fn [cfg params]
|
||||
(-> (acquire! sem)
|
||||
(p/then (fn [_] (f cfg params)) (:default executors))
|
||||
(p/finally (fn [_ _] (release! sem))))))
|
||||
f))
|
||||
|
||||
(with-dispatch queue'
|
||||
(f cfg params)))
|
||||
(do
|
||||
(when (some? queue)
|
||||
(l/warn :hint "undefined semaphore" :name queue))
|
||||
f))))
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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]]))
|
||||
|
||||
;; Empty namespace as main entry point for Server REPL
|
||||
[app.util.time :as dt]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[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))))
|
||||
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))))))
|
|
@ -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
|
||||
|
|
|
@ -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])
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Reference in a new issue