hailgun 0.2.1.0 → 0.3.0.0

raw patch · 14 files changed

+651/−338 lines, 14 filesdep +filepathdep +tagsoupPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, tagsoup

API changes (from Hackage documentation)

Files

• Mail/Hailgun.hs +21/−337
• Mail/Hailgun/Attachment.hs +29/−0
• Mail/Hailgun/Attachment/Internal.hs +17/−0
• Mail/Hailgun/AttachmentsSearch.hs +38/−0
• Mail/Hailgun/Communication.hs +66/−0
• Mail/Hailgun/Domains.hs +61/−0
• Mail/Hailgun/Errors.hs +43/−0
• Mail/Hailgun/Internal/Data.hs +151/−0
• Mail/Hailgun/MailgunApi.hs +12/−0
• Mail/Hailgun/Message.hs +72/−0
• Mail/Hailgun/Pagination.hs +20/−0
• Mail/Hailgun/PartUtil.hs +30/−0
• Mail/Hailgun/SendEmail.hs +73/−0
• hailgun.cabal +18/−1

@@ -1,13 +1,14 @@-{-# LANGUAGE CPP, FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts #-} -- | Hailgun is a Haskell wrapper around the <http://documentation.mailgun.com/api_reference.html Mailgun api's> that use -- type safety to ensure that you are sending a valid request to the Mailgun API's. Mailgun is a -- service that lets you send emails. It also contains a number of other email handling API's that -- will be implimented in the future.-module Mail.Hailgun +module Mail.Hailgun    ( sendEmail    , hailgunMessage-   , HailgunMessage+   , addAttachment    , HailgunContext(..)+   , HailgunMessage    , MessageSubject    , MessageContent(..)    , MessageRecipients(..)@@ -22,341 +23,24 @@    , HailgunDomainResponse(..)    , HailgunTime(..)    , toProxy+   , Attachment(..)+   , AttachmentBody(..)    ) where -import            Control.Applicative ((<$>), (<*>), pure)-import            Control.Arrow (second)-import            Control.Monad (mzero)-import            Control.Monad.IO.Class-import            Control.Monad.Catch (MonadThrow(..))-import            Data.Aeson-import qualified  Data.ByteString as B-import qualified  Data.ByteString.Char8 as BC-import qualified  Data.ByteString.Lazy.Char8 as BCL-import qualified  Data.Text as T-import            Data.Time.Clock (UTCTime(..))-import            Data.Time.LocalTime (zonedTimeToUTC)-import            Text.Email.Validate-import            Network.HTTP.Client (Request(..), Response(..), parseUrl, httpLbs, withManager, responseStatus, responseBody, applyBasicAuth, setQueryString, Proxy(..))-import            Network.HTTP.Client.Internal (addProxy)-import            Network.HTTP.Client.MultipartFormData (Part(..), formDataBody, partBS)-import            Network.HTTP.Client.TLS (tlsManagerSettings)-import qualified  Network.HTTP.Types.Status as NT-import qualified  Network.HTTP.Types.Method as NM--import Data.Time.Format (ParseTime(..), parseTime)-#if MIN_VERSION_time(1,5,0)-import Data.Time.Format(defaultTimeLocale)-#else-import System.Locale (defaultTimeLocale)-#endif--{- - - The basic rest API's look like this when used in curl:- -- - curl -s --user 'api:key-3ax6xnjp29jd6fds4gc373sgvjxteol0' \- -     https://api.mailgun.net/v2/samples.mailgun.org/messages \- -     -F from='Excited User <me@samples.mailgun.org>' \- -     -F to=baz@example.com \- -     -F to=bar@example.com \- -     -F subject='Hello' \- -     -F text='Testing some Mailgun awesomness!'- -- - This is what we need to emulate with this library.- -}--type UnverifiedEmailAddress = B.ByteString -- ^ Represents an email address that is not yet verified.-type MessageSubject = String -- ^ Represents a message subject.---- | Any email content that you wish to send should be encoded into these types before it is sent.--- Currently, according to the API, you should always send a Text Only part in the email and you can--- optionally add a nicely formatted HTML version of that email to the sent message. --- --- @--- It is best to send multi-part emails using both text and HTML or text only. Sending HTML only--- email is not well received by ESPs.--- @--- (<http://documentation.mailgun.com/best_practices.html#email-content Source>)------ This API mirrors that advice so that you can always get it right.-data MessageContent-   -- | The Text only version of the message content.-   = TextOnly-      { textContent :: B.ByteString -      }-   -- | A message that contains both a Text version of the email content and a HTML version of the email content.-   | TextAndHTML-      { textContent :: B.ByteString -- ^ The text content that you wish to send (please note that many clients will take the HTML version first if it is present but that the text version is a great fallback).-      , htmlContent :: B.ByteString -- ^ The HTML content that you wish to send.-      }---- | A Hailgun Email message that may be sent. It contains important information such as the address--- that the email is from, the addresses that it should be going to, the subject of the message and--- the content of the message. Any email that you wish to send via this api must be converted into--- this structure first. To create a message then please use the hailgunMessage interface.-data HailgunMessage = HailgunMessage-   { messageSubject  :: MessageSubject-   , messageContent  :: MessageContent-   , messageFrom     :: EmailAddress-   , messageTo       :: [EmailAddress]-   , messageCC       :: [EmailAddress]-   , messageBCC      :: [EmailAddress]-   }-   -- TODO support sending attachments in the future-   -- TODO inline image support for the future-   -- TODO o:tag support-   -- TODO o:campaign support-   -- messageDKIMSupport :: Bool TODO o:dkim support-   -- TODO o:deliverytime support for up to three days in the future-   -- TODO o:testmode support-   -- TODO o:tracking support-   -- TODO o:tracking-clicks support-   -- TODO o:tracking-opens support-   -- TODO custom mime header support-   -- TODO custome message data support---- | No recipients for your email. Useful singleton instance to avoid boilerplate in your code. For--- example: ------ @--- toBob = emptyMessageRecipients { recipientsTo = [\"bob\@bob.test\"] }--- @-emptyMessageRecipients :: MessageRecipients-emptyMessageRecipients = MessageRecipients [] [] []---- | A collection of unverified email recipients separated into the To, CC and BCC groupings that--- email supports.-data MessageRecipients = MessageRecipients -   { recipientsTo    :: [UnverifiedEmailAddress] -- ^ The people to email directly.-   , recipientsCC    :: [UnverifiedEmailAddress] -- ^ The people to \"Carbon Copy\" into the email. Honestly, why is that term not deprecated yet?-   , recipientsBCC   :: [UnverifiedEmailAddress] -- ^ The people to \"Blind Carbon Copy\" into the email. There really needs to be a better name for this too.-   }---- | A generic error message that is returned by the Hailgun library.-type HailgunErrorMessage = String---- | A method to construct a HailgunMessage. You require a subject, content, From address and people--- to send the email to and it will give you back a valid Hailgun email message. Or it will error--- out while trying.-hailgunMessage -   :: MessageSubject -- ^ The purpose of the email surmised.-   -> MessageContent -- ^ The full body of the email.-   -> UnverifiedEmailAddress -- ^ The email account that the recipients should respond to in order to get back to us.-   -> MessageRecipients -- ^ The people that should recieve this email.-   -> Either HailgunErrorMessage HailgunMessage -- ^ Either an error while trying to create a valid message or a valid message.-hailgunMessage subject content sender recipients = do-   from  <- validate sender-   to    <- mapM validate (recipientsTo recipients)-   cc    <- mapM validate (recipientsCC recipients)-   bcc   <- mapM validate (recipientsBCC recipients)-   return HailgunMessage -      { messageSubject = subject-      , messageContent = content-      , messageFrom = from-      , messageTo = to-      , messageCC = cc-      , messageBCC = bcc-      }--toPostVars :: HailgunMessage -> [(BC.ByteString, BC.ByteString)]-toPostVars message = -   [ (BC.pack "from", toByteString . messageFrom $ message)-   , (BC.pack "subject", BC.pack $ 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)---- | When comunnicating to the Mailgun service you need to have some common pieces of information to--- authenticate successfully. This context encapsulates that required information.-data HailgunContext = HailgunContext-   -- TODO better way to represent a domain-   { hailgunDomain :: String -- ^ The domain of the mailgun account that you wish to send the emails through.-   , hailgunApiKey :: String -- ^ The API key for the mailgun account so that you can successfully make requests. Please note that it should include the 'key' prefix.-   , hailgunProxy  :: Maybe Proxy-   }---- TODO replace with MailgunSendResponse--- | The response to an email being accepted by the Mailgun API.-data HailgunSendResponse = HailgunSendResponse-   { hsrMessage :: String -- ^ The freeform message from the mailgun API.-   , hsrId      :: String -- ^ The ID of the message that has been accepted by the Mailgun api.-   }---- TODO make this Hailgun specific and different for the Mailgun api. That way there is the correct--- separation of concerns.--- | An error that comes from Mailgun or the Hailgun API.-data HailgunErrorResponse = HailgunErrorResponse-   { herMessage :: String -- ^ A generic message describing the error.-   }--toHailgunError :: String -> HailgunErrorResponse-toHailgunError = HailgunErrorResponse--instance FromJSON HailgunSendResponse where-   parseJSON (Object v) = HailgunSendResponse-      <$> v .: T.pack "message"-      <*> v .: T.pack "id"-   parseJSON _ = mzero--instance FromJSON HailgunErrorResponse where-   parseJSON (Object v) = HailgunErrorResponse-      <$> v .: T.pack "message"-   parseJSON _ = mzero--encodeFormData :: MonadIO m => [(BC.ByteString, BC.ByteString)] -> Request -> m Request-encodeFormData fields = formDataBody (map toPart fields)-   where-      toPart :: (BC.ByteString, BC.ByteString) -> Part-      toPart (name, content) = partBS (T.pack . BC.unpack $ name) content---- | Send an email using the Mailgun API's. This method is capable of sending a message over the--- Mailgun service. All it needs is the appropriate context.-sendEmail -   :: HailgunContext -- ^ The Mailgun context to operate in.-   -> HailgunMessage -- ^ The Hailgun message to be sent.-   -> IO (Either HailgunErrorResponse HailgunSendResponse) -- ^ The result of the sent email. Either a sent email or a successful send.-sendEmail context message = do-   request <- postRequest url context (toPostVars message)-   response <- withManager tlsManagerSettings (httpLbs request)-   return $ parseResponse response-   where-      url = mailgunApiPrefixContext context ++ "/messages"--parseResponse :: (FromJSON a) => Response BCL.ByteString -> Either HailgunErrorResponse a-parseResponse response = statusToResponse . NT.statusCode . responseStatus $ response-   where-      statusToResponse s-         | s == 200                      = responseDecode response-         | s `elem` [400, 401, 402, 404] = gatherErrors . responseDecode $ response-         | s `elem` [500, 502, 503, 504] = serverError-         | otherwise                     = unexpectedError s--responseDecode :: (FromJSON a) => Response BCL.ByteString -> Either HailgunErrorResponse a-responseDecode = mapError . eitherDecode . responseBody--retError :: String -> Either HailgunErrorResponse a-retError = Left . toHailgunError--serverError :: Either HailgunErrorResponse a-serverError = retError "Server Errors - something is wrong on Mailgun’s end"--unexpectedError :: Int -> Either HailgunErrorResponse a-unexpectedError x = retError $ "Unexpected Non-Standard Mailgun Error: " ++ show x--mapError :: Either String a -> Either HailgunErrorResponse a-mapError = either (Left . toHailgunError) Right--gatherErrors :: Either HailgunErrorResponse HailgunErrorResponse -> Either HailgunErrorResponse a-gatherErrors = either Left Left--mailgunApiPrefix :: String-mailgunApiPrefix = "https://api.mailgun.net/v2" --mailgunApiPrefixContext :: HailgunContext -> String-mailgunApiPrefixContext context = mailgunApiPrefix ++ "/" ++ hailgunDomain context--ignoreStatus :: a -> b -> c -> Maybe d-ignoreStatus _ _ _ = Nothing--data Page = Page-   { pageStart  :: Integer-   , pageLength :: Integer-   }--pageToParams :: Page -> [(BC.ByteString, BC.ByteString)]-pageToParams page = -   [ (BC.pack "skip",   BC.pack . show . pageStart $ page)-   , (BC.pack "limit",  BC.pack . show . pageLength $ page)-   ]--toQueryParams :: [(BC.ByteString, BC.ByteString)] -> [(BC.ByteString, Maybe BC.ByteString)]-toQueryParams = fmap (second Just)--getDomains :: HailgunContext -> Page -> IO (Either HailgunErrorResponse HailgunDomainResponse)-getDomains context page = do-   request <- getRequest url context (toQueryParams . pageToParams $ page)-   response <- withManager tlsManagerSettings (httpLbs request)-   return $ parseResponse response-   where-      url = mailgunApiPrefix ++ "/domains"--getRequest :: (MonadThrow m) => String -> HailgunContext -> [(BC.ByteString, Maybe BC.ByteString)] -> m Request-getRequest url context queryParams = do-   initRequest <- parseUrl url-   let request = applyHailgunAuth context $ initRequest { method = NM.methodGet, checkStatus = ignoreStatus }-   return $ setQueryString queryParams request--postRequest :: (MonadThrow m, MonadIO m) => String -> HailgunContext -> [(BC.ByteString, BC.ByteString)] -> m Request-postRequest url context formParams = do-   initRequest <- parseUrl url-   let request = initRequest { method = NM.methodPost, checkStatus = ignoreStatus }-   requestWithBody <- encodeFormData formParams request-   return $ applyHailgunAuth context requestWithBody--applyHailgunAuth :: HailgunContext -> Request -> Request-applyHailgunAuth context = addRequestProxy (hailgunProxy context) . authRequest-   where -      addRequestProxy :: Maybe Proxy -> Request -> Request-      addRequestProxy (Just proxy) = addProxy (proxyHost proxy) (proxyPort proxy)-      addRequestProxy _ = id--      authRequest = applyBasicAuth (BC.pack "api") (BC.pack . hailgunApiKey $ context)--data HailgunDomainResponse = HailgunDomainResponse-   { hdrTotalCount :: Integer-   , hdrItems :: [HailgunDomain]-   }--instance FromJSON HailgunDomainResponse where-   parseJSON (Object v) = HailgunDomainResponse-      <$> v .: T.pack "total_count"-      <*> v .: T.pack "items"-   parseJSON _ = mzero--data HailgunDomain = HailgunDomain-   { domainName         :: T.Text-   , domainSmtpLogin    :: String-   , domainSmtpPassword :: String-   , domainCreatedAt    :: HailgunTime-   , domainWildcard     :: Bool-   , domainSpamAction   :: String -- TODO the domain spam action is probably better specified-   }-   deriving(Show)--instance FromJSON HailgunDomain where-   parseJSON (Object v) = HailgunDomain-      <$> v .: T.pack "name"-      <*> v .: T.pack "smtp_login"-      <*> v .: T.pack "smtp_password"-      <*> v .: T.pack "created_at"-      <*> v .: T.pack "wildcard"-      <*> v .: T.pack "spam_action"-   parseJSON _ = mzero--newtype HailgunTime = HailgunTime UTCTime-   deriving (Eq, Ord, Show)---- Example Input: 'Thu, 13 Oct 2011 18:02:00 GMT'-instance FromJSON HailgunTime where-   parseJSON = withText "HailgunTime" $ \t ->-      case parseTime defaultTimeLocale "%a, %d %b %Y %T %Z" (T.unpack t) of-         Just d -> pure d-         _      -> fail "could not parse Mailgun Style date"+import           Mail.Hailgun.Attachment+import           Mail.Hailgun.Domains+import           Mail.Hailgun.Errors+import           Mail.Hailgun.Internal.Data+import           Mail.Hailgun.Message+import           Mail.Hailgun.Pagination+import           Mail.Hailgun.SendEmail -instance ParseTime HailgunTime where-   buildTime l = HailgunTime . zonedTimeToUTC . buildTime l+import qualified Data.ByteString.Char8      as BC+import           Network.HTTP.Client        (Proxy (..)) -toProxy :: String -> Int -> Proxy-toProxy host port = Proxy (BC.pack host) port+-- | A convinience method to create a proxy for the HailgunContext.+toProxy+   :: String -- ^ The proxy host+   -> Int -- ^ The proxy port+   -> Proxy -- ^ The proxy configuration.+toProxy host = Proxy (BC.pack host)

@@ -0,0 +1,29 @@+module Mail.Hailgun.Attachment+    ( createAttachment+    , createAttachmentLazy+    , addAttachment+    )+    where++import qualified Data.ByteString                  as B+import qualified Data.ByteString.Lazy             as BL+import           Data.Monoid+import           Mail.Hailgun.Attachment.Internal+import           Mail.Hailgun.Internal.Data++-- | Creates an attachment from a filepath and strict ByteString.+createAttachment :: FilePath -> B.ByteString -> Attachment+createAttachment filename body = Attachment filename (AttachmentBS body)++-- | Creates an attachment from a filepath and lazy ByteString.+createAttachmentLazy :: FilePath -> BL.ByteString -> Attachment+createAttachmentLazy filename body = Attachment filename (AttachmentLBS body)++-- | Allows you to add an attachment to an already created HailgunMessage. But please note that it will only+-- add your attachment as a standard attachment. Inline attachments must be added at the time that the+-- HailgunMessage was created.+addAttachment :: Attachment -> Endo HailgunMessage+addAttachment attachment = Endo $ \message -> message+    { messageAttachments = (toStandardAttachment . cleanAttachmentFilePath $ attachment) : messageAttachments message+    }+

@@ -0,0 +1,17 @@+module Mail.Hailgun.Attachment.Internal+    ( toStandardAttachment+    , toInlineAttachment+    , cleanAttachmentFilePath+    ) where++import           Mail.Hailgun.Internal.Data+import           System.FilePath            (takeFileName)++toStandardAttachment :: Attachment -> SpecificAttachment+toStandardAttachment (Attachment filepath body) = SpecificAttachment Attached filepath body++toInlineAttachment :: Attachment -> SpecificAttachment+toInlineAttachment (Attachment filepath body) = SpecificAttachment Inline filepath body++cleanAttachmentFilePath :: Attachment -> Attachment+cleanAttachmentFilePath (Attachment filepath body) = Attachment (takeFileName filepath) body

@@ -0,0 +1,38 @@+module Mail.Hailgun.AttachmentsSearch+   ( findInlineImagesInHtmlEmail+   , InlineImage(..)+   ) where++import           Control.Monad         (guard)+import qualified Data.ByteString       as B+import qualified Data.ByteString.Char8 as BC+import           Data.List             (find, nub)+import           Data.Maybe            (catMaybes)+import qualified Text.HTML.TagSoup     as TS++-- Finds the unique inline images in the email+findInlineImagesInHtmlEmail :: B.ByteString -> [InlineImage]+findInlineImagesInHtmlEmail = nub . catMaybes . fmap tagToInlineImage . TS.parseTags++data InlineImage = InlineImage+   { imageSrc :: B.ByteString+   } deriving (Eq, Show)++imgTagName :: B.ByteString+imgTagName = BC.pack "img"++srcTagName :: B.ByteString+srcTagName = BC.pack "src"++inlineImageUrlPrefix :: B.ByteString+inlineImageUrlPrefix = BC.pack "cid:"++tagToInlineImage :: TS.Tag B.ByteString -> Maybe InlineImage+tagToInlineImage (TS.TagOpen name attrs) =+   if name == imgTagName+      then do+         srcAttr <- find ((==) srcTagName . fst) attrs+         guard (inlineImageUrlPrefix `B.isPrefixOf` snd srcAttr)+         return . InlineImage . B.drop (B.length inlineImageUrlPrefix) . snd $ srcAttr+      else Nothing+tagToInlineImage _ = Nothing

@@ -0,0 +1,66 @@+module Mail.Hailgun.Communication+    ( getRequest+    , postRequest+    , toQueryParams+    , parseResponse+    ) where++import           Control.Arrow                         (second)+import           Control.Monad.Catch                   (MonadThrow (..))+import           Control.Monad.IO.Class                (MonadIO (..))+import           Data.Aeson+import qualified Data.ByteString.Char8                 as BC+import qualified Data.ByteString.Lazy.Char8            as BLC+import           Data.Foldable                         (foldMap)+import           Data.Monoid+import           Mail.Hailgun.Errors+import           Mail.Hailgun.Internal.Data+import qualified Network.HTTP.Client                   as NC+import           Network.HTTP.Client.Internal          (addProxy)+import           Network.HTTP.Client.MultipartFormData (Part (..), formDataBody)+import qualified Network.HTTP.Types.Method             as NM+import qualified Network.HTTP.Types.Status             as NT++toQueryParams :: [(BC.ByteString, BC.ByteString)] -> [(BC.ByteString, Maybe BC.ByteString)]+toQueryParams = fmap (second Just)++getRequest :: (MonadThrow m) => String -> HailgunContext -> [(BC.ByteString, Maybe BC.ByteString)] -> m NC.Request+getRequest url context queryParams = do+   initRequest <- NC.parseUrl url+   let request = appEndo (applyHailgunAuth context) $ initRequest { NC.method = NM.methodGet, NC.checkStatus = ignoreStatus }+   return $ NC.setQueryString queryParams request++postRequest :: (MonadThrow m, MonadIO m) => String -> HailgunContext -> [Part] -> m NC.Request+postRequest url context parts = do+   initRequest <- NC.parseUrl url+   let request = initRequest { NC.method = NM.methodPost, NC.checkStatus = ignoreStatus }+   requestWithBody <- formDataBody parts request+   --requestWithBody <- encodeFormData formParams request+   return $ appEndo (applyHailgunAuth context) requestWithBody++applyHailgunAuth :: HailgunContext -> Endo NC.Request+applyHailgunAuth context = addRequestProxy (hailgunProxy context) <> authRequest context++addRequestProxy :: Maybe NC.Proxy -> Endo NC.Request+addRequestProxy = foldMap addProxy'++authRequest :: HailgunContext -> Endo NC.Request+authRequest context = Endo $ NC.applyBasicAuth (BC.pack "api") (BC.pack . hailgunApiKey $ context)++addProxy' :: NC.Proxy -> Endo NC.Request+addProxy' proxy = Endo $ addProxy (NC.proxyHost proxy) (NC.proxyPort proxy)++parseResponse :: (FromJSON a) => NC.Response BLC.ByteString -> Either HailgunErrorResponse a+parseResponse response = statusToResponse . NT.statusCode . NC.responseStatus $ response+   where+      statusToResponse s+         | s == 200                      = responseDecode response+         | s `elem` [400, 401, 402, 404] = gatherErrors . responseDecode $ response+         | s `elem` [500, 502, 503, 504] = serverError+         | otherwise                     = unexpectedError s++responseDecode :: (FromJSON a) => NC.Response BLC.ByteString -> Either HailgunErrorResponse a+responseDecode = mapError . eitherDecode . NC.responseBody++ignoreStatus :: a -> b -> c -> Maybe d+ignoreStatus _ _ _ = Nothing

@@ -0,0 +1,61 @@+module Mail.Hailgun.Domains+    ( getDomains+    , HailgunDomainResponse(..)+    , HailgunDomain(..)+    ) where++import           Control.Applicative+import           Control.Monad              (mzero)+import           Data.Aeson+import qualified Data.Text                  as T+import           Mail.Hailgun.Communication+import           Mail.Hailgun.Errors+import           Mail.Hailgun.Internal.Data+import           Mail.Hailgun.MailgunApi+import           Mail.Hailgun.Pagination+import           Network.HTTP.Client        (httpLbs, withManager)+import           Network.HTTP.Client.TLS    (tlsManagerSettings)++-- | Make a request to Mailgun for the domains against your account. This is a paginated request so you must specify+-- the pages of results that you wish to get back.+getDomains+   :: HailgunContext -- ^ The context to operate in which specifies which account to get the domains from.+   -> Page -- ^ The page of results that you wish to see returned.+   -> IO (Either HailgunErrorResponse HailgunDomainResponse) -- ^ The IO response which is either an error or the list of domains.+getDomains context page = do+   request <- getRequest url context (toQueryParams . pageToParams $ page)+   response <- withManager tlsManagerSettings (httpLbs request)+   return $ parseResponse response+   where+      url = mailgunApiPrefix ++ "/domains"++data HailgunDomainResponse = HailgunDomainResponse+   { hdrTotalCount :: Integer+   , hdrItems      :: [HailgunDomain]+   }++instance FromJSON HailgunDomainResponse where+   parseJSON (Object v) = HailgunDomainResponse+      <$> v .: T.pack "total_count"+      <*> v .: T.pack "items"+   parseJSON _ = mzero++data HailgunDomain = HailgunDomain+   { domainName         :: T.Text+   , domainSmtpLogin    :: String+   , domainSmtpPassword :: String+   , domainCreatedAt    :: HailgunTime+   , domainWildcard     :: Bool+   , domainSpamAction   :: String -- TODO the domain spam action is probably better specified+   }+   deriving(Show)++instance FromJSON HailgunDomain where+   parseJSON (Object v) = HailgunDomain+      <$> v .: T.pack "name"+      <*> v .: T.pack "smtp_login"+      <*> v .: T.pack "smtp_password"+      <*> v .: T.pack "created_at"+      <*> v .: T.pack "wildcard"+      <*> v .: T.pack "spam_action"+   parseJSON _ = mzero

@@ -0,0 +1,43 @@+module Mail.Hailgun.Errors+    ( HailgunErrorResponse(..) -- TODO Make it so that herMessage is a hidden detail in the next version+    , toHailgunError+    , serverError+    , unexpectedError+    , gatherErrors+    , mapError+    ) where++import           Control.Applicative+import           Control.Monad       (mzero)+import           Data.Aeson+import qualified Data.Text           as T++-- TODO make this Hailgun specific and different for the Mailgun api. That way there is the correct+-- separation of concerns.+-- | An error that comes from Mailgun or the Hailgun API.+data HailgunErrorResponse = HailgunErrorResponse+   { herMessage :: String -- ^ A generic message describing the error.+   }++toHailgunError :: String -> HailgunErrorResponse+toHailgunError = HailgunErrorResponse++instance FromJSON HailgunErrorResponse where+   parseJSON (Object v) = HailgunErrorResponse+      <$> v .: T.pack "message"+   parseJSON _ = mzero++serverError :: Either HailgunErrorResponse a+serverError = retError "Server Errors - something is wrong on Mailgun’s end"++unexpectedError :: Int -> Either HailgunErrorResponse a+unexpectedError x = retError $ "Unexpected Non-Standard Mailgun Error: " ++ show x++retError :: String -> Either HailgunErrorResponse a+retError = Left . toHailgunError++mapError :: Either String a -> Either HailgunErrorResponse a+mapError = either retError Right++gatherErrors :: Either HailgunErrorResponse HailgunErrorResponse -> Either HailgunErrorResponse a+gatherErrors = either Left Left

@@ -0,0 +1,151 @@+{-# LANGUAGE CPP #-}+module Mail.Hailgun.Internal.Data+    ( HailgunContext(..)+    , HailgunMessage(..)+    , MessageSubject+    , MessageContent(..)+    , UnverifiedEmailAddress+    , MessageRecipients(..)+    , emptyMessageRecipients+    , HailgunErrorMessage+    , HailgunTime(..)+    , Attachment(..)+    , SpecificAttachment(..)+    , AttachmentBody(..)+    , AttachmentType(..)+    ) where++import           Control.Applicative+import           Data.Aeson+import qualified Data.ByteString      as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text            as T+import           Data.Time.Clock      (UTCTime (..))+import           Data.Time.Format     (ParseTime (..), parseTime)+import           Data.Time.LocalTime  (zonedTimeToUTC)+import qualified Network.HTTP.Client  as NHC+import qualified Text.Email.Validate  as TEV++#if MIN_VERSION_time(1,5,0)+import           Data.Time.Format     (defaultTimeLocale)+#else+import           System.Locale        (defaultTimeLocale)+#endif++type UnverifiedEmailAddress = B.ByteString -- ^ Represents an email address that is not yet verified.+type MessageSubject = String -- ^ Represents a message subject.++-- | A generic error message that is returned by the Hailgun library.+type HailgunErrorMessage = String++-- | When comunnicating to the Mailgun service you need to have some common pieces of information to+-- authenticate successfully. This context encapsulates that required information.+data HailgunContext = HailgunContext+   -- TODO better way to represent a domain+   { hailgunDomain :: String -- ^ The domain of the mailgun account that you wish to send the emails through.+   , hailgunApiKey :: String -- ^ The API key for the mailgun account so that you can successfully make requests. Please note that it should include the 'key' prefix.+   , hailgunProxy  :: Maybe NHC.Proxy+   }++-- | Any email content that you wish to send should be encoded into these types before it is sent.+-- Currently, according to the API, you should always send a Text Only part in the email and you can+-- optionally add a nicely formatted HTML version of that email to the sent message.+--+-- @+-- It is best to send multi-part emails using both text and HTML or text only. Sending HTML only+-- email is not well received by ESPs.+-- @+-- (<http://documentation.mailgun.com/best_practices.html#email-content Source>)+--+-- This API mirrors that advice so that you can always get it right.+data MessageContent+   -- | The Text only version of the message content.+   = TextOnly+      { textContent :: B.ByteString+      }+   -- | A message that contains both a Text version of the email content and a HTML version of the email content.+   | TextAndHTML+      { textContent :: B.ByteString -- ^ The text content that you wish to send (please note that many clients will take the HTML version first if it is present but that the text version is a great fallback).+      , htmlContent :: B.ByteString -- ^ The HTML content that you wish to send.+      }++-- | A Hailgun Email message that may be sent. It contains important information such as the address+-- that the email is from, the addresses that it should be going to, the subject of the message and+-- the content of the message. Any email that you wish to send via this api must be converted into+-- this structure first. To create a message then please use the hailgunMessage interface.+data HailgunMessage = HailgunMessage+   { messageSubject     :: MessageSubject+   , messageContent     :: MessageContent+   , messageFrom        :: TEV.EmailAddress+   , messageTo          :: [TEV.EmailAddress]+   , messageCC          :: [TEV.EmailAddress]+   , messageBCC         :: [TEV.EmailAddress]+   , messageAttachments :: [SpecificAttachment]+   }+   -- TODO o:tag support+   -- TODO o:campaign support+   -- messageDKIMSupport :: Bool TODO o:dkim support+   -- TODO o:deliverytime support for up to three days in the future+   -- TODO o:testmode support+   -- TODO o:tracking support+   -- TODO o:tracking-clicks support+   -- TODO o:tracking-opens support+   -- TODO custom mime header support+   -- TODO custom message data support++-- | An Attachment that may be sent. It contains the file path of the attachment and the data that you wish to send in+-- the attachment body. It is important to note that this data type makes no distinction between standard attachments+-- and HTML inline attachments. See sendEmail for more details on how to make your attachments behave like inline+-- attachments.+data Attachment = Attachment+    { attachmentFilePath :: FilePath+    , attachmentBody     :: AttachmentBody+    }++-- | An Attachment body is the raw data that you want to send with your attachment.+data AttachmentBody+   = AttachmentBS B.ByteString   -- ^ A strict ByteString representation of your data.+   | AttachmentLBS BL.ByteString -- ^ A lazy ByteString representation of your data.++data SpecificAttachment = SpecificAttachment+    { saType     :: AttachmentType+    , saFilePath :: FilePath+    , saBody     :: AttachmentBody+    }++data AttachmentType = Attached | Inline deriving (Eq, Show)++-- | No recipients for your email. Useful singleton instance to avoid boilerplate in your code. For+-- example:+--+-- @+-- toBob = emptyMessageRecipients { recipientsTo = [\"bob\@bob.test\"] }+-- @+emptyMessageRecipients :: MessageRecipients+emptyMessageRecipients = MessageRecipients [] [] []++-- | A collection of unverified email recipients separated into the To, CC and BCC groupings that+-- email supports.+data MessageRecipients = MessageRecipients+   { recipientsTo  :: [UnverifiedEmailAddress] -- ^ The people to email directly.+   , recipientsCC  :: [UnverifiedEmailAddress] -- ^ The people to \"Carbon Copy\" into the email. Honestly, why is that term not deprecated yet?+   , recipientsBCC :: [UnverifiedEmailAddress] -- ^ The people to \"Blind Carbon Copy\" into the email. There really needs to be a better name for this too.+   }++-- The user should just give us a list of attachments and we should automatically make them inline or not+-- We should consider sending the HTML message as a quoted-string: http://hackage.haskell.org/package/dataenc-0.14.0.5/docs/Codec-Binary-QuotedPrintable.html+-- We should use TagSoup to parse the constructed HTML message so that we can see if any inline images are expected:++-- | A wrapper for UTCTime so that we can always pass correctly formatted times to Mailgun.+newtype HailgunTime = HailgunTime UTCTime+   deriving (Eq, Ord, Show)++-- Example Input: 'Thu, 13 Oct 2011 18:02:00 GMT'+instance FromJSON HailgunTime where+   parseJSON = withText "HailgunTime" $ \t ->+      case parseTime defaultTimeLocale "%a, %d %b %Y %T %Z" (T.unpack t) of+         Just d -> pure d+         _      -> fail "could not parse Mailgun Style date"++instance ParseTime HailgunTime where+   buildTime l = HailgunTime . zonedTimeToUTC . buildTime l

@@ -0,0 +1,12 @@+module Mail.Hailgun.MailgunApi+    ( mailgunApiPrefix+    , mailgunApiPrefixContext+    ) where++import           Mail.Hailgun.Internal.Data++mailgunApiPrefix :: String+mailgunApiPrefix = "https://api.mailgun.net/v2"++mailgunApiPrefixContext :: HailgunContext -> String+mailgunApiPrefixContext context = mailgunApiPrefix ++ "/" ++ hailgunDomain context

@@ -0,0 +1,72 @@+module Mail.Hailgun.Message+    ( hailgunMessage+    ) where++import           Control.Applicative+import qualified Data.ByteString.Char8            as BC+import           Data.List                        (find)+import           Mail.Hailgun.Attachment.Internal+import           Mail.Hailgun.AttachmentsSearch+import           Mail.Hailgun.Internal.Data+import           Text.Email.Validate++-- | A method to construct a HailgunMessage. You require a subject, content, From address and people+-- to send the email to and it will give you back a valid Hailgun email message. Or it will error+-- out while trying.+hailgunMessage+   :: MessageSubject -- ^ The purpose of the email surmised.+   -> MessageContent -- ^ The full body of the email.+   -> UnverifiedEmailAddress -- ^ The email account that the recipients should respond to in order to get back to us.+   -> MessageRecipients -- ^ The people that should recieve this email.+   -> [Attachment] -- ^ The attachments that you want to attach to the email; standard or inline.+   -> Either HailgunErrorMessage HailgunMessage -- ^ Either an error while trying to create a valid message or a valid message.+hailgunMessage subject content sender recipients simpleAttachments = do+   from  <- validate sender+   to    <- mapM validate (recipientsTo recipients)+   cc    <- mapM validate (recipientsCC recipients)+   bcc   <- mapM validate (recipientsBCC recipients)+   attachments <- attachmentsInferredFromMessage content cleanAttachments+   return HailgunMessage+      { messageSubject = subject+      , messageContent = content+      , messageFrom = from+      , messageTo = to+      , messageCC = cc+      , messageBCC = bcc+      , messageAttachments = attachments+      }+   where+      cleanAttachments = fmap cleanAttachmentFilePath simpleAttachments++attachmentsInferredFromMessage :: MessageContent -> [Attachment] -> Either String [SpecificAttachment]+attachmentsInferredFromMessage mContent simpleAttachments =+   case mContent of+      (TextOnly _) -> return . fmap toStandardAttachment $ simpleAttachments+      th@(TextAndHTML {}) -> convertAttachments simpleAttachments (findInlineImagesInHtmlEmail . htmlContent $ th)++convertAttachments :: [Attachment] -> [InlineImage] -> Either String [SpecificAttachment]+convertAttachments attachments images = do+   inlineAttachments <- sequence (fmap (findAttachmentForImage attachments) images)+   let standardAttachments = toStandardAttachment <$> attachments `notInSpecific` inlineAttachments+   return $ inlineAttachments ++ standardAttachments++notInSpecific :: [Attachment] -> [SpecificAttachment] -> [Attachment]+notInSpecific simpleAttachments specificAttachments =+   filter (\sa -> attachmentFilePath sa `notElem` specificFilePaths) simpleAttachments+   where+      specificFilePaths = fmap saFilePath specificAttachments++findAttachmentForImage :: [Attachment] -> InlineImage -> Either String SpecificAttachment+findAttachmentForImage attachments image =+   case find (`attachmentForInlineImage` image) attachments of+      Nothing -> Left . missingInlineImageErrorMessage $ image+      Just attachment -> Right . toInlineAttachment $ attachment++missingInlineImageErrorMessage :: InlineImage -> String+missingInlineImageErrorMessage image =+   "Could not find an attachment for the inline image: "+   ++ (show . imageSrc $ image)+   ++ ". Either provide the attachment or remove the inline image from the HTML email."++attachmentForInlineImage :: Attachment -> InlineImage -> Bool+attachmentForInlineImage attachment image = (BC.pack . attachmentFilePath $ attachment) == imageSrc image

@@ -0,0 +1,20 @@+module Mail.Hailgun.Pagination+    ( Page(..)+    , pageToParams+    ) where++import qualified Data.ByteString.Char8 as BC++-- | Represents a single page of results. You specify a page of results when you wish to to make a request to a+-- paginated resource.+data Page = Page+   { pageStart  :: Integer+   , pageLength :: Integer+   }++pageToParams :: Page -> [(BC.ByteString, BC.ByteString)]+pageToParams page =+   [ (BC.pack "skip",   BC.pack . show . pageStart $ page)+   , (BC.pack "limit",  BC.pack . show . pageLength $ page)+   ]+

@@ -0,0 +1,30 @@+module Mail.Hailgun.PartUtil+    ( paramsToPart+    , attachmentToPart+    ) where++import qualified Data.ByteString.Char8                 as BC+import qualified Data.Text                             as T+import           Data.Text.Encoding                    (decodeUtf8)+import           Mail.Hailgun.Internal.Data+import qualified Network.HTTP.Client                   as NC+import qualified Network.HTTP.Client.MultipartFormData as NCM++paramsToPart :: (BC.ByteString, BC.ByteString) -> NCM.Part+paramsToPart (name, content) = NCM.partBS (decodeUtf8 name) content++attachmentToPart :: SpecificAttachment -> NCM.Part+attachmentToPart (SpecificAttachment attachmentType filename body) =+    NCM.partFileRequestBody partName filename requestBody+    where+        partName = attachmentTypeToName attachmentType+        requestBody = attachmentBodyToRequestBody body++attachmentBodyToRequestBody :: AttachmentBody -> NC.RequestBody+attachmentBodyToRequestBody (AttachmentBS body) = NC.RequestBodyBS body+attachmentBodyToRequestBody (AttachmentLBS body) = NC.RequestBodyLBS body++attachmentTypeToName :: AttachmentType -> T.Text+attachmentTypeToName Attached = T.pack "attachment"+attachmentTypeToName Inline = T.pack "inline"+

@@ -0,0 +1,73 @@+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           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)++-- | Send an email using the Mailgun API's. This method is capable of sending a message over the+-- Mailgun service. All it needs is the appropriate context.+sendEmail+   :: HailgunContext -- ^ The Mailgun context to operate in.+   -> HailgunMessage -- ^ The Hailgun message to be sent.+   -> IO (Either HailgunErrorResponse HailgunSendResponse) -- ^ The result of the sent email. Either a sent email or a successful send.+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", BC.pack $ 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)++-- TODO replace with MailgunSendResponse+-- | The response to an email being accepted by the Mailgun API.+data HailgunSendResponse = HailgunSendResponse+   { hsrMessage :: String -- ^ The freeform message from the mailgun API.+   , hsrId      :: String -- ^ The ID of the message that has been accepted by the Mailgun api.+   }++instance FromJSON HailgunSendResponse where+   parseJSON (Object v) = HailgunSendResponse+      <$> v .: T.pack "message"+      <*> v .: T.pack "id"+   parseJSON _ = mzero+

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.2.1.0+version:             0.3.0.0  -- A short (one-line) description of the package. synopsis:            Mailgun REST api interface for Haskell.@@ -55,6 +55,20 @@  library    exposed-modules:     Mail.Hailgun+                        , Mail.Hailgun.Attachment++   other-modules:       Mail.Hailgun.Internal.Data+                        , Mail.Hailgun.Attachment.Internal+                        , Mail.Hailgun.AttachmentsSearch+                        , Mail.Hailgun.Communication+                        , Mail.Hailgun.Domains+                        , Mail.Hailgun.Errors+                        , Mail.Hailgun.MailgunApi+                        , Mail.Hailgun.Message+                        , Mail.Hailgun.Pagination+                        , Mail.Hailgun.PartUtil+                        , Mail.Hailgun.SendEmail+    build-depends:         base               >= 4.6 && < 5                         , bytestring         >= 0.10.4 && <= 0.11                         , aeson              == 0.7.*@@ -65,6 +79,9 @@                         , email-validate     == 2.0.*                         , http-types         == 0.8.*                         , exceptions         >= 0.4+                        , tagsoup            == 0.13.*+                        , filepath           >= 1 && < 2+    if flag(newtime)       Build-Depends:    time == 1.5.*    else