module IHP.Mail
( MailServer (..)
, BuildMail (..)
, sendMail
, sendWithMailServer
)
where
import IHP.Prelude
import IHP.Controller.RequestContext
import IHP.ControllerSupport
import IHP.Mail.Types
import IHP.FrameworkConfig
import Network.Mail.Mime
import qualified Network.Mail.Mime.SES as Mailer
import qualified Network.Mail.SMTP as SMTP
import qualified Network.HTTP.Client
import qualified Network.HTTP.Client.TLS
import Text.Blaze.Html5 (Html)
import qualified Text.Blaze.Html.Renderer.Text as Blaze
import qualified Data.Text as Text
import Data.Maybe
buildMail :: (BuildMail mail, ?context :: context, ConfigProvider context) => mail -> IO Mail
buildMail :: mail -> IO Mail
buildMail mail
mail = let ?mail = mail in Address
-> Address -> Text -> Text -> Text -> [(Text, FilePath)] -> IO Mail
simpleMail (mail -> Address
forall mail. BuildMail mail => mail -> Address
to mail
mail) Address
forall mail. (BuildMail mail, ?mail::mail) => Address
from Text
forall mail. (BuildMail mail, ?mail::mail) => Text
subject (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ mail -> Text
forall mail context.
(BuildMail mail, ?context::context, ConfigProvider context) =>
mail -> Text
text mail
mail) (mail -> Html
forall mail context.
(BuildMail mail, ?context::context, ConfigProvider context) =>
mail -> Html
html mail
mail Html -> (Html -> Text) -> Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Html -> Text
Blaze.renderHtml) []
sendMail :: (BuildMail mail, ?context :: context, ConfigProvider context) => mail -> IO ()
sendMail :: mail -> IO ()
sendMail mail
mail = mail -> IO Mail
forall mail context.
(BuildMail mail, ?context::context, ConfigProvider context) =>
mail -> IO Mail
buildMail mail
mail IO Mail -> (Mail -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MailServer -> Mail -> IO ()
sendWithMailServer ((FrameworkConfig -> MailServer) -> MailServer
forall context a.
(?context::context, ConfigProvider context) =>
(FrameworkConfig -> a) -> a
fromConfig FrameworkConfig -> MailServer
mailServer)
sendWithMailServer :: MailServer -> Mail -> IO ()
sendWithMailServer :: MailServer -> Mail -> IO ()
sendWithMailServer SES { ByteString
Text
$sel:region:SES :: MailServer -> Text
$sel:secretKey:SES :: MailServer -> ByteString
$sel:accessKey:SES :: MailServer -> ByteString
region :: Text
secretKey :: ByteString
accessKey :: ByteString
.. } Mail
mail = do
Manager
manager <- ManagerSettings -> IO Manager
Network.HTTP.Client.newManager ManagerSettings
Network.HTTP.Client.TLS.tlsManagerSettings
let ses :: SES
ses = SES :: ByteString
-> [ByteString]
-> ByteString
-> ByteString
-> Maybe ByteString
-> Text
-> SES
Mailer.SES {
sesFrom :: ByteString
Mailer.sesFrom = Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Address -> Text
addressEmail (Mail -> Address
mailFrom Mail
mail),
sesTo :: [ByteString]
Mailer.sesTo = (Address -> ByteString) -> [Address] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString) -> (Address -> Text) -> Address -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address -> Text
addressEmail) (Mail -> [Address]
mailTo Mail
mail),
sesAccessKey :: ByteString
Mailer.sesAccessKey = ByteString
accessKey,
sesSecretKey :: ByteString
Mailer.sesSecretKey = ByteString
secretKey,
sesSessionToken :: Maybe ByteString
Mailer.sesSessionToken = Maybe ByteString
forall a. Maybe a
Nothing,
sesRegion :: Text
Mailer.sesRegion = Text
region
}
Manager -> SES -> Mail -> IO ()
forall (m :: * -> *). MonadIO m => Manager -> SES -> Mail -> m ()
Mailer.renderSendMailSES Manager
manager SES
ses Mail
mail
sendWithMailServer SendGrid { Maybe Text
Text
$sel:category:SES :: MailServer -> Maybe Text
$sel:apiKey:SES :: MailServer -> Text
category :: Maybe Text
apiKey :: Text
.. } Mail
mail = do
let mail' :: Mail
mail' = if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
category then Mail
mail {mailHeaders :: Headers
mailHeaders = (ByteString
"X-SMTPAPI",Text
"{\"category\": \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
++ (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
category) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
++ Text
"\"}") (ByteString, Text) -> Headers -> Headers
forall a. a -> [a] -> [a]
: Headers
headers} else Mail
mail
FilePath -> PortNumber -> FilePath -> FilePath -> Mail -> IO ()
SMTP.sendMailWithLoginSTARTTLS' FilePath
"smtp.sendgrid.net" PortNumber
587 FilePath
"apikey" (Text -> FilePath
Text.unpack Text
apiKey) Mail
mail'
where headers :: Headers
headers = Mail -> Headers
mailHeaders Mail
mail
sendWithMailServer IHP.Mail.Types.SMTP { FilePath
Maybe (FilePath, FilePath)
PortNumber
$sel:credentials:SES :: MailServer -> Maybe (FilePath, FilePath)
$sel:port:SES :: MailServer -> PortNumber
$sel:host:SES :: MailServer -> FilePath
credentials :: Maybe (FilePath, FilePath)
port :: PortNumber
host :: FilePath
.. } Mail
mail
| Maybe (FilePath, FilePath) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (FilePath, FilePath)
credentials = FilePath -> PortNumber -> Mail -> IO ()
SMTP.sendMail' FilePath
host PortNumber
port Mail
mail
| Bool
otherwise = FilePath -> PortNumber -> FilePath -> FilePath -> Mail -> IO ()
SMTP.sendMailWithLogin' FilePath
host PortNumber
port ((FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath, FilePath)
creds) ((FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (FilePath, FilePath)
creds) Mail
mail
where creds :: (FilePath, FilePath)
creds = Maybe (FilePath, FilePath) -> (FilePath, FilePath)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (FilePath, FilePath)
credentials
sendWithMailServer MailServer
Sendmail Mail
mail = do
ByteString
message <- Mail -> IO ByteString
renderMail' Mail
mail
ByteString -> IO ()
sendmail ByteString
message
class BuildMail mail where
subject :: (?mail :: mail) => Text
to :: mail -> Address
from :: (?mail :: mail) => Address
html :: (?context :: context, ConfigProvider context) => mail -> Html
text :: (?context :: context, ConfigProvider context) => mail -> Text
text mail
mail = Text -> Text
stripTags (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Html -> Text
Blaze.renderHtml (mail -> Html
forall mail context.
(BuildMail mail, ?context::context, ConfigProvider context) =>
mail -> Html
html mail
mail))