{-|
Module: IHP.Mail
Description: Send Emails
Copyright: (c) digitally induced GmbH, 2020
-}
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) []

-- | Sends an email
--
-- Uses the mail server provided in the controller context, configured in Config/Config.hs
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
    -- | You can use @?mail@ to make this dynamic based on the given entity
    subject :: (?mail :: mail) => Text
    
    -- | The email receiver
    --
    -- __Example:__
    -- > to ConfirmationMail { .. } = Address { addressName = Just (get #name user), addressEmail = get #email user }
    to :: mail -> Address

    -- | Your sender address
    from :: (?mail :: mail) => Address

    -- | Similiar to a normal html view, HSX can be used here
    html :: (?context :: context, ConfigProvider context) => mail -> Html

    -- | When no plain text version of the email is specified it falls back to using the html version but striping out all the html tags
    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))