♻️ Refactor email sending subsystem.

backend/src/app/config.clj

@@ -37,9 +37,9 @@
 
    :image-process-max-threads 2
 
-   :sendmail-backend "console"
+   :smtp-enable false
-   :sendmail-reply-to "no-reply@example.com"
+   :smtp-default-reply-to "no-reply@example.com"
-   :sendmail-from "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 ::smtp-enable ::us/boolean)
-(s/def ::sendmail-backend-apikey ::us/string)
+(s/def ::smtp-default-reply-to ::us/email)
-(s/def ::sendmail-reply-to ::us/email)
+(s/def ::smtp-default-from ::us/email)
-(s/def ::sendmail-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
+                   ::smtp-default-from
-                   ::sendmail-from
+                   ::smtp-default-reply-to
-                   ::sendmail-backend
+                   ::smtp-enable
-                   ::sendmail-backend-apikey
                    ::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)})
+

backend/src/app/emails.clj

@@ -29,25 +29,20 @@
 ;; --- Public API
 
 (defn render
-  [email context]
+  [email-factory context]
-  (let [defaults {:from (:sendmail-from cfg/config)
+  (email-factory context))
-                  :reply-to (:sendmail-reply-to cfg/config)}]
-    (email (merge defaults context))))
 
 (defn send!
   "Schedule the email for sending."
-  ([email context] (send! db/pool email context))
+  [conn email-factory context]
-  ([conn email-factory context]
+  (us/verify fn? email-factory)
-   (us/verify fn? email-factory)
+  (us/verify map? context)
-   (us/verify map? context)
+  (let [email (email-factory context)]
-   (let [defaults {:from (:sendmail-from cfg/config)
+    (tasks/submit! conn {:name "sendmail"
-                   :reply-to (:sendmail-reply-to cfg/config)}
+                         :delay 0
-         data (merge defaults context)
+                         :max-retries 1
-         email (email-factory data)]
+                         :priority 200
-     (tasks/submit! conn {:name "sendmail"
+                         :props email})))
-                          :delay 0
-                          :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))

backend/src/app/tasks/sendmail.clj

@@ -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.metrics :as mtx]))
-   [app.util.http :as http]))
 
-(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"
+(defn adapt-config
-  [config email]
+  [cfg]
-  (let [out (with-out-str
+  {:host (:smtp-host cfg "localhost")
-              (println "email console dump:")
+   :port (:smtp-port cfg 25)
-              (println "******** start email" (:id email) "**********")
+   :default-reply-to (:smtp-default-reply-to cfg)
-              (println " from: " (:from email))
+   :default-from (:smtp-default-from cfg)
-              (println " to: " (:to email "---"))
+   :tls (:smtp-tls cfg)
-              (println " reply-to: " (:reply-to email))
+   :username (:smtp-username cfg)
-              (println " subject: " (:subject email))
+   :password (:smtp-password cfg)})
-              (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 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

backend/src/app/util/emails.clj

@@ -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
+(defn- render-email-template-part
-  [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
   [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)
+        subj (render-email-template-part :subj id context)
-        html (render-email-part :html id context)
+        text (render-email-template-part :txt id context)
-        text (render-email-part :txt id context)]
+        html (render-email-template-part :html id context)]
-
     {:subject subj
-     :content (cond-> []
+     :body [{:type "text/html"
-                text (conj {:type "text/plain"
+             :content html}
-                             :value text})
+            {:type "text/plain"
-                html (conj {:type "text/html"
+             :content text}]}))
-                            :value html}))}))
-
-;; --- Public API
 
 (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
+(defn template-factory
-  ([id] (build id {}))
+  ([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)])
+         (:custom-data context)
-         (:from context) (assoc :from (:from context))
+         (assoc :custom-data (:custom-data context))
-         (:reply-to context) (assoc :reply-to (:reply-to context)))))))
+
+         (:from context)
+         (assoc :from (:from context))
+
+         (:reply-to context)
+         (assoc :reply-to (:reply-to context))
+
+         (:to context)
+         (assoc :to (:to context)))))))

docker/devenv/docker-compose.yaml

@@ -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