module Mail.Hailgun.SendEmail
( sendEmail
, HailgunSendResponse(..)
) where
import Control.Applicative
import Control.Monad (mzero)
import Data.Aeson
import qualified Data.ByteString.Char8 as BC
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Mail.Hailgun.Communication
import Mail.Hailgun.Errors
import Mail.Hailgun.Internal.Data
import Mail.Hailgun.MailgunApi
import Mail.Hailgun.PartUtil
import Network.HTTP.Client (httpLbs, withManager)
import qualified Network.HTTP.Client.MultipartFormData as NCM
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Text.Email.Validate (EmailAddress,
toByteString)
sendEmail
:: HailgunContext
-> HailgunMessage
-> IO (Either HailgunErrorResponse HailgunSendResponse)
sendEmail context message = do
request <- postRequest url context (toEmailParts message)
response <- withManager tlsManagerSettings (httpLbs request)
return $ parseResponse response
where
url = mailgunApiPrefixContext context ++ "/messages"
toEmailParts :: HailgunMessage -> [NCM.Part]
toEmailParts message = params ++ attachmentParts
where
params = map paramsToPart . toSimpleEmailParts $ message
attachmentParts = map attachmentToPart . messageAttachments $ message
toSimpleEmailParts :: HailgunMessage -> [(BC.ByteString, BC.ByteString)]
toSimpleEmailParts message =
[ (BC.pack "from", toByteString . messageFrom $ message)
, (BC.pack "subject", T.encodeUtf8 $ messageSubject message)
] ++ to
++ cc
++ bcc
++ fromContent (messageContent message)
where
to = convertEmails (BC.pack "to") . messageTo $ message
cc = convertEmails (BC.pack "cc") . messageCC $ message
bcc = convertEmails (BC.pack "bcc") . messageBCC $ message
fromContent :: MessageContent -> [(BC.ByteString, BC.ByteString)]
fromContent t@(TextOnly _) = [ (BC.pack "text", textContent t) ]
fromContent th@(TextAndHTML {}) = (BC.pack "html", htmlContent th) : fromContent (TextOnly . textContent $ th)
convertEmails :: BC.ByteString -> [EmailAddress] -> [(BC.ByteString, BC.ByteString)]
convertEmails prefix = fmap ((,) prefix . toByteString)
data HailgunSendResponse = HailgunSendResponse
{ hsrMessage :: String
, hsrId :: String
}
deriving (Show)
instance FromJSON HailgunSendResponse where
parseJSON (Object v) = HailgunSendResponse
<$> v .: T.pack "message"
<*> v .: T.pack "id"
parseJSON _ = mzero