Allow add attachements on emails

This commit is contained in:
Andrey Antukh 2025-10-16 13:46:07 +02:00
parent e8e27c25c0
commit 95f58ffda5

View File

@ -7,6 +7,7 @@
(ns app.email (ns app.email
"Main api for send emails." "Main api for send emails."
(:require (:require
[app.common.data :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
@ -93,36 +94,44 @@
headers))) headers)))
(defn- assign-body (defn- assign-body
[^MimeMessage mmsg {:keys [body charset] :or {charset "utf-8"}}] [^MimeMessage mmsg {:keys [body charset attachments] :or {charset "utf-8"}}]
(let [mpart (MimeMultipart. "mixed")] (let [mixed-mpart (MimeMultipart. "mixed")]
(cond (cond
(string? body) (string? body)
(let [bpart (MimeBodyPart.)] (let [text-part (MimeBodyPart.)]
(.setContent bpart ^String body (str "text/plain; charset=" charset)) (.setText text-part ^String body ^String charset)
(.addBodyPart mpart bpart)) (.addBodyPart mixed-mpart text-part))
(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) (map? body)
(let [bpart (MimeBodyPart.)] (let [content-part (MimeBodyPart.)
(.setContent bpart alternative-mpart (MimeMultipart. "alternative")]
^String (:content body)
^String (str (:type body "text/plain") "; charset=" charset)) (when-let [content (get body "text/html")]
(.addBodyPart mpart bpart)) (let [html-part (MimeBodyPart.)]
(.setContent html-part ^String content
(str "text/html; charset=" charset))
(.addBodyPart alternative-mpart html-part)))
(when-let [content (get body "text/plain")]
(let [text-part (MimeBodyPart.)]
(.setText text-part ^String content ^String charset)
(.addBodyPart alternative-mpart text-part)))
(.setContent content-part alternative-mpart)
(.addBodyPart mixed-mpart content-part))
:else :else
(throw (ex-info "Unsupported type" {:body body}))) (throw (IllegalArgumentException. "invalid email body provided")))
(.setContent mmsg mpart)
(doseq [[name content] attachments]
(prn "attachment" name)
(let [attachment-part (MimeBodyPart.)]
(.setFileName attachment-part ^String name)
(.setContent attachment-part ^String content (str "text/plain; charset=" charset))
(.addBodyPart mixed-mpart attachment-part)))
(.setContent mmsg mixed-mpart)
mmsg)) mmsg))
(defn- opts->props (defn- opts->props
@ -210,24 +219,26 @@
(ex/raise :type :internal (ex/raise :type :internal
:code :missing-email-templates)) :code :missing-email-templates))
{:subject subj {:subject subj
:body (into :body (d/without-nils
[{:type "text/plain" {"text/plain" text
:content text}] "text/html" html})}))
(when html
[{:type "text/html"
:content html}]))}))
(def ^:private schema:context (def ^:private schema:params
[:map [:map {:title "Email Params"}
[:to [:or ::sm/email [::sm/vec ::sm/email]]] [:to [:or ::sm/email [::sm/vec ::sm/email]]]
[:reply-to {:optional true} ::sm/email] [:reply-to {:optional true} ::sm/email]
[:from {:optional true} ::sm/email] [:from {:optional true} ::sm/email]
[:lang {:optional true} ::sm/text] [:lang {:optional true} ::sm/text]
[:subject {:optional true} ::sm/text]
[:priority {:optional true} [:enum :high :low]] [:priority {:optional true} [:enum :high :low]]
[:extra-data {:optional true} ::sm/text]]) [:extra-data {:optional true} ::sm/text]
[:body {:optional true}
[:or :string [:map-of :string :string]]]
[:attachments {:optional true}
[:map-of :string :string]]])
(def ^:private check-context (def ^:private check-params
(sm/check-fn schema:context)) (sm/check-fn schema:params))
(defn template-factory (defn template-factory
[& {:keys [id schema]}] [& {:keys [id schema]}]
@ -235,9 +246,9 @@
(let [check-fn (if schema (let [check-fn (if schema
(sm/check-fn schema) (sm/check-fn schema)
(constantly nil))] (constantly nil))]
(fn [context] (fn [params]
(let [context (-> context check-context check-fn) (let [params (-> params check-params check-fn)
email (build-email-template id context)] email (build-email-template id params)]
(when-not email (when-not email
(ex/raise :type :internal (ex/raise :type :internal
:code :email-template-does-not-exists :code :email-template-does-not-exists
@ -245,35 +256,40 @@
:template-id id)) :template-id id))
(cond-> (assoc email :id (name id)) (cond-> (assoc email :id (name id))
(:extra-data context) (:extra-data params)
(assoc :extra-data (:extra-data context)) (assoc :extra-data (:extra-data params))
(:from context) (seq (:attachments params))
(assoc :from (:from context)) (assoc :attachments (:attachments params))
(:reply-to context) (:from params)
(assoc :reply-to (:reply-to context)) (assoc :from (:from params))
(:to context) (:reply-to params)
(assoc :to (:to context))))))) (assoc :reply-to (:reply-to params))
(:to params)
(assoc :to (:to params)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC HIGH-LEVEL API ;; PUBLIC HIGH-LEVEL API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn render (defn render
[email-factory context] [email-factory params]
(email-factory context)) (email-factory params))
(defn send! (defn send!
"Schedule an already defined email to be sent using asynchronously "Schedule an already defined email to be sent using asynchronously
using worker task." using worker task."
[{:keys [::conn ::factory] :as context}] [{:keys [::conn ::factory] :as params}]
(assert (db/connectable? conn) "expected a valid database connection or pool") (assert (db/connectable? conn) "expected a valid database connection or pool")
(let [email (if factory (let [email (if factory
(factory context) (factory params)
(dissoc context ::conn))] (-> params
(dissoc params)
(check-params)))]
(wrk/submit! {::wrk/task :sendmail (wrk/submit! {::wrk/task :sendmail
::wrk/delay 0 ::wrk/delay 0
::wrk/max-retries 4 ::wrk/max-retries 4