mirror of
https://github.com/penpot/penpot.git
synced 2025-05-21 01:26:10 +02:00
♻️ Refactor email namespaces
This commit is contained in:
Andrey Antukh
parent
87691499d7
commit
58319d84ad
3 changed files with 363 additions and 363 deletions
|
|
@ -7,25 +7,258 @@
|
||||||
(ns app.emails
|
(ns app.emails
|
||||||
"Main api for send emails."
|
"Main api for send emails."
|
||||||
(:require
|
(:require
|
||||||
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.pprint :as pp]
|
[app.common.pprint :as pp]
|
||||||
[app.common.spec :as us]
|
[app.common.spec :as us]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.db.sql :as sql]
|
[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]
|
[app.worker :as wrk]
|
||||||
|
[clojure.java.io :as io]
|
||||||
[clojure.spec.alpha :as s]
|
[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
|
(defn render
|
||||||
[email-factory context]
|
[email-factory context]
|
||||||
(email-factory context))
|
(email-factory context))
|
||||||
|
|
||||||
(defn send!
|
(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}]
|
[{:keys [::conn ::factory] :as context}]
|
||||||
(us/verify fn? factory)
|
(us/verify fn? factory)
|
||||||
(us/verify some? conn)
|
(us/verify some? conn)
|
||||||
|
|
@ -37,8 +270,126 @@
|
||||||
::wrk/priority 200
|
::wrk/priority 200
|
||||||
::wrk/conn conn))))
|
::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
|
(def sql:profile-complaint-report
|
||||||
"select (select count(*)
|
"select (select count(*)
|
||||||
|
|
@ -85,106 +436,3 @@
|
||||||
{:email email :type "bounce"}
|
{:email email :type "bounce"}
|
||||||
{:limit 10}))]
|
{:limit 10}))]
|
||||||
(>= (count reports) threshold))))
|
(>= (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)))
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -242,7 +242,7 @@
|
||||||
:app.worker/registry
|
:app.worker/registry
|
||||||
{:metrics (ig/ref :app.metrics/metrics)
|
{:metrics (ig/ref :app.metrics/metrics)
|
||||||
:tasks
|
:tasks
|
||||||
{:sendmail (ig/ref :app.emails/sendmail-handler)
|
{:sendmail (ig/ref :app.emails/handler)
|
||||||
:objects-gc (ig/ref :app.tasks.objects-gc/handler)
|
:objects-gc (ig/ref :app.tasks.objects-gc/handler)
|
||||||
:file-gc (ig/ref :app.tasks.file-gc/handler)
|
:file-gc (ig/ref :app.tasks.file-gc/handler)
|
||||||
:file-xlog-gc (ig/ref :app.tasks.file-xlog-gc/handler)
|
:file-xlog-gc (ig/ref :app.tasks.file-xlog-gc/handler)
|
||||||
|
|
@ -254,17 +254,21 @@
|
||||||
:audit-log-archive (ig/ref :app.loggers.audit/archive-task)
|
:audit-log-archive (ig/ref :app.loggers.audit/archive-task)
|
||||||
:audit-log-gc (ig/ref :app.loggers.audit/gc-task)}}
|
:audit-log-gc (ig/ref :app.loggers.audit/gc-task)}}
|
||||||
|
|
||||||
:app.emails/sendmail-handler
|
|
||||||
|
:app.emails/sendmail
|
||||||
{:host (cf/get :smtp-host)
|
{:host (cf/get :smtp-host)
|
||||||
:port (cf/get :smtp-port)
|
:port (cf/get :smtp-port)
|
||||||
:ssl (cf/get :smtp-ssl)
|
:ssl (cf/get :smtp-ssl)
|
||||||
:tls (cf/get :smtp-tls)
|
:tls (cf/get :smtp-tls)
|
||||||
:username (cf/get :smtp-username)
|
:username (cf/get :smtp-username)
|
||||||
:password (cf/get :smtp-password)
|
:password (cf/get :smtp-password)
|
||||||
:metrics (ig/ref :app.metrics/metrics)
|
|
||||||
:default-reply-to (cf/get :smtp-default-reply-to)
|
:default-reply-to (cf/get :smtp-default-reply-to)
|
||||||
:default-from (cf/get :smtp-default-from)}
|
: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
|
:app.tasks.tasks-gc/handler
|
||||||
{:pool (ig/ref :app.db/pool)
|
{:pool (ig/ref :app.db/pool)
|
||||||
:max-age cf/deletion-delay}
|
:max-age cf/deletion-delay}
|
||||||
|
|
|
||||||
|
|
@ -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)))))))
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue