module Rackspace.MailGun
( Message (..)
, sendMessage
, sendWith
) where
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Text
import Data.Text.Encoding
import Network.HTTP.Client.MultipartFormData
import Network.HTTP.Conduit
baseUrl :: String
baseUrl = "https://api.mailgun.net/v2"
data Message = TextMessage
{ from :: Text
, to :: Text
, cc :: Maybe Text
, bcc :: Maybe Text
, subject :: Maybe Text
, text :: Text }
| HtmlMessage
{ from :: Text
, to :: Text
, cc :: Maybe Text
, bcc :: Maybe Text
, subject :: Maybe Text
, html :: Text }
deriving (Eq, Show)
partText :: Text -> Text -> [Part]
partText name value = [ partBS name (encodeUtf8 value) ]
partMaybeText :: Text -> Maybe Text -> [Part]
partMaybeText name value = case value of
Just val -> [ partBS name (encodeUtf8 val) ]
Nothing -> []
buildTail :: Message -> [Part]
buildTail TextMessage{..} = partText "text" text
buildTail HtmlMessage{..} = partText "html" html
buildBase :: Message -> [Part]
buildBase msg = partText "from" (from msg)
++ partText "to" (to msg)
++ partMaybeText "cc" (cc msg)
++ partMaybeText "bcc" (bcc msg)
++ partMaybeText "subject" (subject msg)
++ buildTail msg
sendMessage :: (MonadIO m, MonadBaseControl IO m, MonadThrow m) =>
String -> String -> Message -> m (Response LBS.ByteString)
sendMessage domain apiKey message = do
withManager $ \manager -> do
sendWith manager domain apiKey message
sendWith :: (MonadIO m, MonadBaseControl IO m, MonadThrow m) =>
Manager -> String -> String -> Message -> m (Response LBS.ByteString)
sendWith manager domain apiKey message = do
initReq <- parseUrl $ baseUrl ++ "/" ++ domain ++ "/messages"
let authReq = applyBasicAuth "api" (BS.pack apiKey) initReq
postReq = authReq { method = "POST" }
res <- flip httpLbs manager =<<
(formDataBody (buildBase message) postReq)
return res