0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-18 10:41:29 -05:00

♻️ Refactor email sending subsystem.

This commit is contained in:
Andrey Antukh 2020-11-10 18:24:02 +01:00 committed by Hirunatan
parent 132e99ab71
commit 5b9c596170
5 changed files with 272 additions and 159 deletions

View file

@ -37,9 +37,9 @@
:image-process-max-threads 2
:sendmail-backend "console"
:sendmail-reply-to "no-reply@example.com"
:sendmail-from "no-reply@example.com"
:smtp-enable false
:smtp-default-reply-to "no-reply@example.com"
:smtp-default-from "no-reply@example.com"
:allow-demo-users true
:registration-enabled true
@ -79,13 +79,12 @@
(s/def ::media-uri ::us/string)
(s/def ::media-directory ::us/string)
(s/def ::secret-key ::us/string)
(s/def ::sendmail-backend ::us/string)
(s/def ::sendmail-backend-apikey ::us/string)
(s/def ::sendmail-reply-to ::us/email)
(s/def ::sendmail-from ::us/email)
(s/def ::smtp-enable ::us/boolean)
(s/def ::smtp-default-reply-to ::us/email)
(s/def ::smtp-default-from ::us/email)
(s/def ::smtp-host ::us/string)
(s/def ::smtp-port ::us/integer)
(s/def ::smtp-user (s/nilable ::us/string))
(s/def ::smtp-username (s/nilable ::us/string))
(s/def ::smtp-password (s/nilable ::us/string))
(s/def ::smtp-tls ::us/boolean)
(s/def ::smtp-ssl ::us/boolean)
@ -136,13 +135,12 @@
::media-directory
::media-uri
::secret-key
::sendmail-reply-to
::sendmail-from
::sendmail-backend
::sendmail-backend-apikey
::smtp-default-from
::smtp-default-reply-to
::smtp-enable
::smtp-host
::smtp-port
::smtp-user
::smtp-username
::smtp-password
::smtp-tls
::smtp-ssl
@ -198,3 +196,14 @@
(def default-deletion-delay
(dt/duration {:hours 48}))
(defn smtp
[cfg]
{:host (:smtp-host cfg "localhost")
:port (:smtp-port cfg 25)
:default-reply-to (:smtp-default-reply-to cfg)
:default-from (:smtp-default-from cfg)
:tls (:smtp-tls cfg)
:username (:smtp-username cfg)
:password (:smtp-password cfg)})

View file

@ -29,25 +29,20 @@
;; --- Public API
(defn render
[email context]
(let [defaults {:from (:sendmail-from cfg/config)
:reply-to (:sendmail-reply-to cfg/config)}]
(email (merge defaults context))))
[email-factory context]
(email-factory context))
(defn send!
"Schedule the email for sending."
([email context] (send! db/pool email context))
([conn email-factory context]
(us/verify fn? email-factory)
(us/verify map? context)
(let [defaults {:from (:sendmail-from cfg/config)
:reply-to (:sendmail-reply-to cfg/config)}
data (merge defaults context)
email (email-factory data)]
(tasks/submit! conn {:name "sendmail"
:delay 0
:priority 200
:props email}))))
[conn email-factory context]
(us/verify fn? email-factory)
(us/verify map? context)
(let [email (email-factory context)]
(tasks/submit! conn {:name "sendmail"
:delay 0
:max-retries 1
:priority 200
:props email})))
;; --- Emails
@ -57,7 +52,7 @@
(def register
"A new profile registration welcome email."
(emails/build ::register default-context))
(emails/template-factory ::register default-context))
(s/def ::token ::us/string)
(s/def ::password-recovery
@ -65,7 +60,7 @@
(def password-recovery
"A password recovery notification email."
(emails/build ::password-recovery default-context))
(emails/template-factory ::password-recovery default-context))
(s/def ::pending-email ::us/email)
(s/def ::change-email
@ -73,7 +68,7 @@
(def change-email
"Password change confirmation email"
(emails/build ::change-email default-context))
(emails/template-factory ::change-email default-context))
(s/def :internal.emails.invite-to-team/invited-by ::us/string)
(s/def :internal.emails.invite-to-team/team ::us/string)
@ -86,4 +81,4 @@
(def invite-to-team
"Teams member invitation email."
(emails/build ::invite-to-team default-context))
(emails/template-factory ::invite-to-team default-context))

View file

@ -9,91 +9,42 @@
(ns app.tasks.sendmail
(:require
[clojure.data.json :as json]
[clojure.tools.logging :as log]
[postal.core :as postal]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.util.emails :as emails]
[app.config :as cfg]
[app.metrics :as mtx]
[app.util.http :as http]))
[app.metrics :as mtx]))
(defmulti sendmail (fn [config email] (:sendmail-backend config)))
(defn- send-console!
[cfg email]
(let [baos (java.io.ByteArrayOutputStream.)
mesg (emails/smtp-message cfg email)]
(.writeTo mesg baos)
(let [out (with-out-str
(println "email console dump:")
(println "******** start email" (:id email) "**********")
(println (.toString baos))
(println "******** end email "(:id email) "**********"))]
(log/info out))))
(defmethod sendmail "console"
[config email]
(let [out (with-out-str
(println "email console dump:")
(println "******** start email" (:id email) "**********")
(println " from: " (:from email))
(println " to: " (:to email "---"))
(println " reply-to: " (:reply-to email))
(println " subject: " (:subject email))
(println " content:")
(doseq [item (:content email)]
(when (= (:type item) "text/plain")
(println (:value item))))
(println "******** end email "(:id email) "**********"))]
(log/info out)))
(defmethod sendmail "sendgrid"
[config email]
(let [apikey (:sendmail-backend-apikey config)
dest (mapv #(array-map :email %) (:to email))
params {:personalizations [{:to dest
:subject (:subject email)}]
:from {:email (:from email)}
:reply_to {:email (:reply-to email)}
:content (:content email)}
headers {"Authorization" (str "Bearer " apikey)
"Content-Type" "application/json"}
body (json/write-str params)]
(try
(let [response (http/send! {:method :post
:headers headers
:uri "https://api.sendgrid.com/v3/mail/send"
:body body})]
(when-not (= 202 (:status response))
(log/error "Unexpected status from sendgrid:" (pr-str response))))
(catch Throwable error
(log/error "Error on sending email to sendgrid:" (pr-str error))))))
(defn- get-smtp-config
[config]
{:host (:smtp-host config)
:port (:smtp-port config)
:user (:smtp-user config)
:pass (:smtp-password config)
:ssl (:smtp-ssl config)
:tls (:smtp-tls config)})
(defn- email->postal
[email]
{:from (:from email)
:to (:to email)
:subject (:subject email)
:body (d/concat [:alternative]
(map (fn [{:keys [type value]}]
{:type (str type "; charset=utf-8")
:content value})
(:content email)))})
(defmethod sendmail "smtp"
[config email]
(let [config (get-smtp-config config)
email (email->postal email)
result (postal/send-message config email)]
(when (not= (:error result) :SUCCESS)
(ex/raise :type :sendmail-error
:code :email-not-sent
:context result))))
(defn adapt-config
[cfg]
{:host (:smtp-host cfg "localhost")
:port (:smtp-port cfg 25)
:default-reply-to (:smtp-default-reply-to cfg)
:default-from (:smtp-default-from cfg)
:tls (:smtp-tls cfg)
:username (:smtp-username cfg)
:password (:smtp-password cfg)})
(defn handler
{:app.tasks/name "sendmail"}
[{:keys [props] :as task}]
(sendmail cfg/config props))
(if (:smtp-enable cfg/config)
(-> (cfg/smtp cfg/config)
(emails/send! props))
(send-console! props)))
(mtx/instrument-with-summary!
{:var #'handler

View file

@ -2,7 +2,10 @@
;; 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) 2019 Andrey Antukh <niwi@niwi.nz>
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns app.util.emails
(:require
@ -11,27 +14,188 @@
[cuerdas.core :as str]
[app.common.spec :as us]
[app.common.exceptions :as ex]
[app.util.template :as tmpl]))
[app.util.template :as tmpl])
(:import
java.util.Properties
javax.mail.Message
javax.mail.Transport
javax.mail.Message$RecipientType
javax.mail.PasswordAuthentication
javax.mail.Session
javax.mail.internet.InternetAddress
javax.mail.internet.MimeMultipart
javax.mail.internet.MimeBodyPart
javax.mail.internet.MimeMessage))
;; --- Impl.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Email Building
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn build-address
[v charset]
(try
(cond
(string? v)
(InternetAddress. v nil charset)
(map? v)
(InternetAddress. (:addr v)
(:name v)
(:charset v charset))
:else
(throw (ex-info "Invalid address" {:data v})))
(catch Exception e
(throw (ex-info "Invalid address" {:data v} e)))))
(defn- resolve-recipient-type
[type]
(case type
:to Message$RecipientType/TO
:cc Message$RecipientType/CC
:bcc Message$RecipientType/BCC))
(defn- assign-recipient
[^MimeMessage mmsg type address charset]
(if (sequential? address)
(reduce #(assign-recipient %1 type %2 charset) mmsg address)
(let [address (build-address address charset)
type (resolve-recipient-type type)]
(.addRecipient mmsg type address)
mmsg)))
(defn- assign-recipients
[mmsg {:keys [to cc bcc charset] :or {charset "utf-8"} :as params}]
(cond-> mmsg
(some? to) (assign-recipient :to to charset)
(some? cc) (assign-recipient :cc cc charset)
(some? bcc) (assign-recipient :bcc bcc charset)))
(defn- assign-from
[mmsg {:keys [from charset] :or {charset "utf-8"}}]
(when from
(let [from (build-address from charset)]
(.setFrom ^MimeMessage mmsg ^InternetAddress from))))
(defn- assign-reply-to
[mmsg {:keys [defaut-reply-to]} {:keys [reply-to charset] :or {charset "utf-8"}}]
(let [reply-to (or reply-to defaut-reply-to)]
(when reply-to
(let [reply-to (build-address reply-to charset)
reply-to (into-array InternetAddress [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 custom-data] :as params}]
(let [headers (assoc headers "X-Sereno-Custom-Data" custom-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 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.smtp.auth" (boolean username)
"mail.smtp.starttls.enable" tls
"mail.smtp.starttls.required" tls
"mail.smtp.host" host
"mail.smtp.port" port
"mail.smtp.from" default-from
"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)]
(prn "kaka" props)
(.setDebug session debug)
session))
(defn smtp-message
[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 "emails/%(id)s/%(lang)s.%(type)s")
(defn- build-base-email
[data context]
(when-not (s/valid? ::parsed-email data)
(ex/raise :type :internal
:code :template-parse-error
:hint "Seems like the email template has invalid data."
:contex data))
{:subject (:subject data)
:content (cond-> []
(:body-text data) (conj {:type "text/plain"
:value (:body-text data)})
(:body-html data) (conj {:type "text/html"
:value (:body-html data)}))})
(defn- render-email-part
(defn- render-email-template-part
[type id context]
(let [lang (:lang context :en)
path (str/format email-path {:id (name id)
@ -40,34 +204,32 @@
(some-> (io/resource path)
(tmpl/render context))))
(defn- impl-build-email
(defn- build-email-template
[id context]
(let [lang (:lang context :en)
subj (render-email-part :subj id context)
html (render-email-part :html id context)
text (render-email-part :txt id context)]
subj (render-email-template-part :subj id context)
text (render-email-template-part :txt id context)
html (render-email-template-part :html id context)]
{:subject subj
:content (cond-> []
text (conj {:type "text/plain"
:value text})
html (conj {:type "text/html"
:value html}))}))
;; --- Public API
:body [{:type "text/html"
:content html}
{:type "text/plain"
:content text}]}))
(s/def ::priority #{:high :low})
(s/def ::to ::us/email)
(s/def ::to (s/or :sigle ::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 ::custom-data ::us/string)
(s/def ::context
(s/keys :req-un [::to]
:opt-un [::reply-to ::from ::lang ::priority]))
:opt-un [::reply-to ::from ::lang ::priority ::custom-data]))
(defn build
([id] (build id {}))
(defn template-factory
([id] (template-factory id {}))
([id extra-context]
(s/assert keyword? id)
(fn [context]
@ -79,13 +241,21 @@
(extra-context)
extra-context)
context)
email (impl-build-email id 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."
::id id))
:context {:id id}))
(cond-> (assoc email :id (name id))
(:to context) (assoc :to [(:to context)])
(:from context) (assoc :from (:from context))
(:reply-to context) (assoc :reply-to (:reply-to context)))))))
(:custom-data context)
(assoc :custom-data (:custom-data context))
(:from context)
(assoc :from (:from context))
(:reply-to context)
(assoc :reply-to (:reply-to context))
(:to context)
(assoc :to (:to context)))))))

View file

@ -22,7 +22,6 @@ services:
depends_on:
- postgres
- smtp
- redis
volumes:
@ -42,17 +41,6 @@ services:
- APP_DATABASE_URI=postgresql://postgres/penpot
- APP_DATABASE_USERNAME=penpot
- APP_DATABASE_PASSWORD=penpot
- APP_SENDMAIL_BACKEND=console
- APP_SMTP_HOST=smtp
- APP_SMTP_PORT=25
smtp:
container_name: "penpot-devenv-smtp"
image: mwader/postfix-relay:latest
restart: always
environment:
- POSTFIX_myhostname=smtp.penpot.io
- OPENDKIM_DOMAINS=smtp.penpot.io
postgres:
image: postgres:13