Files
PrayerTracker/src/PrayerTracker/Email.fs
Daniel J. Summers 39af0fb9a5 Implement e-mail changes
- Add canonical domain handling
- Bump version
2023-07-12 20:46:01 -04:00

119 lines
3.9 KiB
Forth

/// Methods for sending e-mails
module PrayerTracker.Email
open MailKit.Net.Smtp
open Microsoft.Extensions.Localization
open MimeKit
open PrayerTracker.Entities
/// Parameters required to send an e-mail
type EmailOptions =
{ /// The SMTP client
Client : SmtpClient
/// The people who should receive the e-mail
Recipients : Member list
/// The small group for which this e-mail is being sent
Group : SmallGroup
/// The subject of the e-mail
Subject : string
/// The body of the e-mail in HTML
HtmlBody : string
/// The body of the e-mail in plain text
PlainTextBody : string
/// Use the current user's preferred language
Strings : IStringLocalizer
}
/// Options to use when sending e-mail
type SmtpServerOptions() =
/// The hostname of the SMTP server
member val SmtpHost : string = "localhost" with get, set
/// The port over which SMTP communication should occur
member val Port : int = 25 with get, set
/// Whether to use SSL when communicating with the SMTP server
member val UseSsl : bool = false with get, set
/// The authentication to use with the SMTP server
member val Authentication : string = "" with get, set
/// The e-mail address from which messages should be sent
member val FromAddress : string = "prayer@bitbadger.solutions" with get, set
/// The options for the SMTP server
let smtpOptions = SmtpServerOptions ()
/// Get an SMTP client connection
let getConnection () = task {
let client = new SmtpClient ()
do! client.ConnectAsync (smtpOptions.SmtpHost, smtpOptions.Port, smtpOptions.UseSsl)
do! client.AuthenticateAsync (smtpOptions.FromAddress, smtpOptions.Authentication)
return client
}
/// Create a mail message object, filled with everything but the body content
let createMessage opts =
let msg = new MimeMessage ()
msg.From.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, smtpOptions.FromAddress))
msg.Subject <- opts.Subject
msg.ReplyTo.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, opts.Group.Preferences.EmailFromAddress))
msg
open MimeKit.Text
/// Create an HTML-format e-mail message
let createHtmlMessage opts =
let bodyText =
[ """<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title></title></head><body>"""
opts.HtmlBody
"""<hr><div style="text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;">"""
opts.Strings["Generated by P R A Y E R T R A C K E R"].Value
"<br><small>"
opts.Strings["from Bit Badger Solutions"].Value
"</small></div></body></html>"
]
|> String.concat ""
let msg = createMessage opts
msg.Body <- new TextPart (TextFormat.Html, Text = bodyText)
msg
/// Create a plain-text-format e-mail message
let createTextMessage opts =
let bodyText =
[ opts.PlainTextBody
"\n\n--\n"
opts.Strings["Generated by P R A Y E R T R A C K E R"].Value
"\n"
opts.Strings["from Bit Badger Solutions"].Value
]
|> String.concat ""
let msg = createMessage opts
msg.Body <- new TextPart (TextFormat.Plain, Text = bodyText)
msg
/// Send e-mails to a class
let sendEmails opts = task {
use htmlMsg = createHtmlMessage opts
use plainTextMsg = createTextMessage opts
for mbr in opts.Recipients do
let emailTo = MailboxAddress (mbr.Name, mbr.Email)
match defaultArg mbr.Format opts.Group.Preferences.DefaultEmailType with
| HtmlFormat ->
htmlMsg.To.Add emailTo
let! _ = opts.Client.SendAsync htmlMsg
htmlMsg.To.Clear ()
| PlainTextFormat ->
plainTextMsg.To.Add emailTo
let! _ = opts.Client.SendAsync plainTextMsg
plainTextMsg.To.Clear ()
}