{-|
Module: IHP.Mail
Description: Send Emails
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.Mail
( MailServer (..)
, BuildMail (..)
, SMTPEncryption ( ..)
, sendMail
, sendWithMailServer
)
where

import IHP.Prelude
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 -> Mail
buildMail mail =
    let ?mail = mail in
    let mail' = simpleMailInMemory (to mail) from subject (cs $ text mail) (html mail |> Blaze.renderHtml) attachments' in
    mail' { mailCc      = cc mail
          , mailBcc     = bcc mail
          , mailHeaders = ("Subject", subject) : h
          }
    where
        h = case replyTo mail of
            Nothing      -> headers mail
            Just replyTo -> ("Reply-To", renderAddress replyTo) : (headers mail)

        attachments' = mail
                |> attachments
                |> map (\MailAttachment { name, content, contentType } -> (contentType, name, content))

-- | 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 = sendWithMailServer ?context.frameworkConfig.mailServer (buildMail mail)

sendWithMailServer :: MailServer -> Mail -> IO ()
sendWithMailServer SES { .. } mail = do
    manager <- Network.HTTP.Client.newManager Network.HTTP.Client.TLS.tlsManagerSettings
    let ses = Mailer.SES {
            Mailer.sesFrom = cs $ addressEmail (mailFrom mail),
            Mailer.sesTo = map (cs . addressEmail) ((mailTo mail) <> (mailCc mail) <> (mailBcc mail)),
            Mailer.sesAccessKey = accessKey,
            Mailer.sesSecretKey = secretKey,
            Mailer.sesSessionToken = Nothing,
            Mailer.sesRegion = region
        }
    Mailer.renderSendMailSES manager ses mail

sendWithMailServer SendGrid { .. } mail = do
    let mail' = if isJust category then mail {mailHeaders = ("X-SMTPAPI","{\"category\": \"" ++ (fromJust category) ++ "\"}") : headers} else mail
    SMTP.sendMailWithLoginSTARTTLS' "smtp.sendgrid.net" 587 "apikey" (Text.unpack apiKey) mail'
    where headers = mailHeaders mail

sendWithMailServer IHP.Mail.Types.SMTP { .. } mail
    | isNothing credentials =
          case encryption of
              Unencrypted -> SMTP.sendMail' host port mail
              TLS -> SMTP.sendMailTLS' host port mail
              STARTTLS -> SMTP.sendMailSTARTTLS' host port mail
    | otherwise =
          case encryption of
              Unencrypted -> SMTP.sendMailWithLogin' host port (fst creds) (snd creds) mail
              TLS -> SMTP.sendMailWithLoginTLS' host port (fst creds) (snd creds) mail
              STARTTLS -> SMTP.sendMailWithLoginSTARTTLS' host port (fst creds) (snd creds) mail
    where creds = fromJust credentials

sendWithMailServer Sendmail mail = do
    message <- renderMail' mail
    sendmail 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 (user.name), addressEmail = user.email }
    --
    -- __Example:__ Send all emails to a fixed email address while in development mode
    --
    -- > to CreateAccountMail { .. } = Address
    -- >     { addressName = Just (fullName admin)
    -- >     , addressEmail =
    -- >         if isDevelopment then
    -- >             "staging@example.com"
    -- >         else
    -- >             admin.email
    -- >     }
    --
    to :: (?context :: context, ConfigProvider context) => mail -> Address

    -- | Sets an optional reply-to address
    replyTo :: (?context :: context, ConfigProvider context) => mail -> Maybe Address
    replyTo mail = Nothing

    -- | Public list of addresses to receive a copy of the mail (CC)
    cc :: (?context :: context, ConfigProvider context) => mail -> [Address]
    cc mail = []

    -- | Hidden list of addresses to receive a copy of the mail (BCC)
    bcc :: (?context :: context, ConfigProvider context) => mail -> [Address]
    bcc mail = []

    -- | Custom headers, excluding @from@, @to@, @cc@, @bcc@, @subject@, and @reply-to@
    --
    -- __Example:__ Add a custom X-Mailer header
    --
    -- > headers CreateAccountMail { .. } = [("X-Mailer", "mail4j 2.17.0")]
    --
    headers :: (?context :: context, ConfigProvider context) => mail -> Headers
    headers mail = []

    -- | Your sender address
    --
    -- __Example:__
    --
    -- > from = Address { addressName = "Acme Inc.", addressEmail = "hi@example.com" }
    --
    from :: (?mail :: mail, ?context :: context, ConfigProvider context) => 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 = stripTags (cs $ Blaze.renderHtml (html mail))

    -- | Optional, mail attachments
    --
    -- __Example:__
    --
    -- > attachments = [ MailAttachment { name = "attached_file.xml", contentType = "application/xml", content = "<xml><hello/></xml>" } ]
    --
    attachments :: (?context :: context, ConfigProvider context) => mail -> [MailAttachment]
    attachments mail = []