mandrill 0.1.1.0 → 0.5.8.0
raw patch · 16 files changed
Files
- mandrill.cabal +11/−7
- src/Network/API/Mandrill.hs +47/−23
- src/Network/API/Mandrill/HTTP.hs +10/−10
- src/Network/API/Mandrill/Inbound.hs +78/−0
- src/Network/API/Mandrill/Messages.hs +23/−4
- src/Network/API/Mandrill/Messages/Types.hs +14/−1
- src/Network/API/Mandrill/Orphans.hs +0/−17
- src/Network/API/Mandrill/Senders.hs +45/−0
- src/Network/API/Mandrill/Settings.hs +17/−7
- src/Network/API/Mandrill/Types.hs +137/−77
- src/Network/API/Mandrill/Users/Types.hs +1/−1
- src/Network/API/Mandrill/Webhooks.hs +70/−0
- test/Main.hs +14/−7
- test/Online.hs +25/−7
- test/RawData.hs +59/−4
- test/Tests.hs +54/−8
mandrill.cabal view
@@ -1,5 +1,5 @@ name: mandrill-version: 0.1.1.0+version: 0.5.8.0 synopsis: Library for interfacing with the Mandrill JSON API description: Pure Haskell client for the Mandrill JSON API license: MIT@@ -8,7 +8,7 @@ maintainer: alfredo.dinapoli@gmail.com category: Network build-type: Simple-tested-with: GHC == 7.4, GHC == 7.6, GHC == 7.8+tested-with: GHC == 7.4, GHC == 7.6, GHC == 7.8, GHC == 7.10.2 cabal-version: >=1.10 source-repository head@@ -25,32 +25,36 @@ Network.API.Mandrill.Users.Types Network.API.Mandrill.Messages Network.API.Mandrill.Messages.Types+ Network.API.Mandrill.Inbound+ Network.API.Mandrill.Webhooks+ Network.API.Mandrill.Senders other-modules: Network.API.Mandrill.Utils Network.API.Mandrill.HTTP- Network.API.Mandrill.Orphans -- other-extensions: build-depends: base >=4.6 && < 5 , containers >= 0.5.0.0 , bytestring >= 0.9.0 , base64-bytestring >= 1.0.0.1- , text >= 1.0.0.0 && < 1.3+ , text >= 1.0.0.0 && < 2.2 , http-types >= 0.8.0 , http-client >= 0.3.0 , http-client-tls >= 0.2.0.0- , aeson >= 0.7.0.3 && < 0.9- , lens >= 4.0+ , aeson >= 0.7.0.3 && < 3+ , microlens-th >= 0.4.0.0 , blaze-html >= 0.5.0.0- , QuickCheck >= 2.6 && < 2.8+ , QuickCheck >= 2.6 && < 3.0 , mtl < 3.0 , time , email-validate >= 1.0.0 , old-locale+ , unordered-containers hs-source-dirs: src default-language: Haskell2010+ ghc-options: -funbox-strict-fields
src/Network/API/Mandrill.hs view
@@ -9,27 +9,30 @@ module Network.API.Mandrill ( module M , sendEmail+ , sendTextEmail , emptyMessage , newTextMessage , newHtmlMessage+ , newTemplateMessage+ , newTemplateMessage' , liftIO -- * Appendix: Example Usage -- $exampleusage ) where -import Control.Monad.Reader-import Control.Lens-import Data.Time-import Text.Blaze.Html-import Network.API.Mandrill.Types as M-import Network.API.Mandrill.Messages as M-import Network.API.Mandrill.Messages.Types as M-import Network.API.Mandrill.Trans as M-import Data.Monoid-import Text.Email.Validate-import qualified Data.Text as T-import qualified Data.Aeson as JSON+import Control.Monad.Reader+import qualified Data.Aeson as JSON+import qualified Data.HashMap.Strict as H+import Data.Monoid+import qualified Data.Text as T+import Data.Time+import Network.API.Mandrill.Messages as M+import Network.API.Mandrill.Messages.Types as M+import Network.API.Mandrill.Trans as M+import Network.API.Mandrill.Types as M+import Text.Blaze.Html+import Text.Email.Validate {- $exampleusage @@ -38,7 +41,7 @@ > {-# LANGUAGE OverloadedStrings #-} > import Text.Email.Validate > import Network.API.Mandrill-> +> > main :: IO () > main = do > case validate "foo@example.com" of@@ -56,15 +59,15 @@ -- | Builds an empty message, given only the email of the sender and -- the emails of the receiver. Please note that the "Subject" will be empty, -- so you need to use either @newTextMessage@ or @newHtmlMessage@ to populate it.-emptyMessage :: EmailAddress -> [EmailAddress] -> MandrillMessage+emptyMessage :: Maybe EmailAddress -> [EmailAddress] -> MandrillMessage emptyMessage f t = MandrillMessage { _mmsg_html = mempty , _mmsg_text = Nothing- , _mmsg_subject = T.empty- , _mmsg_from_email = f+ , _mmsg_subject = Nothing+ , _mmsg_from_email = MandrillEmail <$> f , _mmsg_from_name = Nothing , _mmsg_to = map newRecipient t- , _mmsg_headers = JSON.Null+ , _mmsg_headers = mempty , _mmsg_important = Nothing , _mmsg_track_opens = Nothing , _mmsg_track_clicks = Nothing@@ -85,7 +88,7 @@ , _mmsg_subaccount = Nothing , _mmsg_google_analytics_domains = [] , _mmsg_google_analytics_campaign = Nothing- , _mmsg_metadata = JSON.Null+ , _mmsg_metadata = mempty , _mmsg_recipient_metadata = [] , _mmsg_attachments = [] , _mmsg_images = []@@ -104,10 +107,29 @@ -- ^ The HTML body -> MandrillMessage newHtmlMessage f t subj html = let body = mkMandrillHtml html in- ((mmsg_html .~ body) . (mmsg_subject .~ subj)) $ (emptyMessage f t)+ (emptyMessage (Just f) t) { _mmsg_html = body, _mmsg_subject = Just subj } +--------------------------------------------------------------------------------+-- | Create a new template message (no HTML).+newTemplateMessage :: EmailAddress+ -- ^ Sender email+ -> [EmailAddress]+ -- ^ Receivers email+ -> T.Text+ -- ^ Subject+ -> MandrillMessage+newTemplateMessage f t subj = (emptyMessage (Just f) t) { _mmsg_subject = Just subj } --------------------------------------------------------------------------------+-- | Create a new template message (no HTML) with recipient addresses only.+-- This function is preferred when the template being used has the sender +-- address and subject already configured in the Mandrill server.+newTemplateMessage' :: [EmailAddress]+ -- ^ Receivers email+ -> MandrillMessage+newTemplateMessage' = emptyMessage Nothing++-------------------------------------------------------------------------------- -- | Create a new textual message. By default Mandrill doesn't require you -- to specify the @mmsg_text@ when sending out the JSON Payload, and this -- function ensure it will be present.@@ -121,9 +143,11 @@ -- ^ The body, as normal text. -> MandrillMessage newTextMessage f t subj txt = let body = unsafeMkMandrillHtml txt in- ((mmsg_html .~ body) .- (mmsg_text .~ Just txt) .- (mmsg_subject .~ subj)) (emptyMessage f t)+ (emptyMessage (Just f) t) {+ _mmsg_html = body+ , _mmsg_text = Just txt+ , _mmsg_subject = Just subj+ } --------------------------------------------------------------------------------@@ -131,7 +155,7 @@ -- 'MandrillMessage' and this function will send an email inside a -- 'MandrillT' transformer. You are not forced to use the 'MandrillT' context -- though. Have a look at "Network.API.Mandrill.Messages" for an IO-based,--- low lever function for sending email.+-- low level function for sending email. sendEmail :: MonadIO m => MandrillMessage -> MandrillT m (MandrillResponse [MessagesResponse])
src/Network/API/Mandrill/HTTP.hs view
@@ -1,15 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} module Network.API.Mandrill.HTTP where -import Network.API.Mandrill.Settings-import Network.API.Mandrill.Types-import qualified Data.Text as T-import Data.Monoid-import Data.Aeson-import Control.Applicative-import Network.HTTP.Types-import Network.HTTP.Client-import Network.HTTP.Client.TLS+import Control.Applicative+import Data.Aeson+import Data.Monoid+import qualified Data.Text as T+import Network.API.Mandrill.Settings+import Network.API.Mandrill.Types+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.HTTP.Types toMandrillResponse :: (MandrillEndpoint ep, FromJSON a, ToJSON rq) => ep@@ -18,7 +18,7 @@ -> IO (MandrillResponse a) toMandrillResponse ep rq mbMgr = do let fullUrl = mandrillUrl <> toUrl ep- rq' <- parseUrl (T.unpack fullUrl)+ rq' <- parseRequest (T.unpack fullUrl) let headers = [(hContentType, "application/json")] let jsonBody = encode rq let req = rq' {
+ src/Network/API/Mandrill/Inbound.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE TemplateHaskell #-}+module Network.API.Mandrill.Inbound where+import Data.Aeson (FromJSON, ToJSON, parseJSON,+ toJSON)+import Data.Aeson.TH (defaultOptions, deriveJSON)+import Data.Aeson.Types (fieldLabelModifier)+import Data.Text (Text)+import Lens.Micro.TH (makeLenses)+import Network.API.Mandrill.HTTP (toMandrillResponse)+import Network.API.Mandrill.Settings+import Network.API.Mandrill.Types+import Network.HTTP.Client (Manager)++data DomainAddRq =+ DomainAddRq+ { _darq_key :: MandrillKey+ , _darq_domain :: Text+ } deriving Show++makeLenses ''DomainAddRq+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''DomainAddRq++data DomainAddResponse =+ DomainAddResponse+ { _dares_domain :: Text+ , _dares_created_at :: MandrillDate+ , _dares_valid_mx :: Bool+ } deriving Show++++makeLenses ''DomainAddResponse+deriveJSON defaultOptions { fieldLabelModifier = drop 7 } ''DomainAddResponse++data RouteAddResponse =+ RouteAddResponse+ { _rares_id :: Text+ , _rares_pattern :: Text+ , _rares_url :: Text+ } deriving Show++++makeLenses ''RouteAddResponse+deriveJSON defaultOptions { fieldLabelModifier = drop 7 } ''RouteAddResponse++data RouteAddRq =+ RouteAddRq+ { _rarq_key :: Text+ , _rarq_domain :: Text+ , _rarq_pattern :: Text+ , _rarq_url :: Text+ } deriving Show++makeLenses ''RouteAddRq+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''RouteAddRq++addDomain :: MandrillKey+ -- ^ The API key+ -> Text+ -- ^ The domain to add+ -> Maybe Manager+ -> IO (MandrillResponse DomainAddResponse)+addDomain k dom = toMandrillResponse DomainsAdd (DomainAddRq k dom)++++addRoute :: MandrillKey+ -- ^ The API key+ -> Text+ -- ^ The domain to add+ -> Text+ -- ^ the pattern including wildcards+ -> Text+ -- ^ URL to forward to+ -> Maybe Manager+ -> IO (MandrillResponse RouteAddResponse)+addRoute k dom pattern forward = toMandrillResponse RoutesAdd (RouteAddRq k dom pattern forward)
src/Network/API/Mandrill/Messages.hs view
@@ -1,13 +1,13 @@ module Network.API.Mandrill.Messages where -import Network.API.Mandrill.Types+import qualified Data.Text as T+import Data.Time+import Network.API.Mandrill.HTTP import Network.API.Mandrill.Messages.Types import Network.API.Mandrill.Settings-import Network.API.Mandrill.HTTP+import Network.API.Mandrill.Types import Network.HTTP.Client-import Data.Time-import qualified Data.Text as T -------------------------------------------------------------------------------- -- | Send a new transactional message through Mandrill@@ -24,3 +24,22 @@ -> Maybe Manager -> IO (MandrillResponse [MessagesResponse]) send k msg async ip_pool send_at = toMandrillResponse MessagesSend (MessagesSendRq k msg async ip_pool send_at)++-- | Send a new transactional message through Mandrill using a template+sendTemplate :: MandrillKey+ -- ^ The API key+ -> MandrillTemplate+ -- ^ The template name+ -> [MandrillTemplateContent]+ -- ^ Template content for 'editable regions'+ -> MandrillMessage+ -- ^ The email message+ -> Maybe Bool+ -- ^ Enable a background sending mode that is optimized for bulk sending+ -> Maybe T.Text+ -- ^ ip_pool+ -> Maybe UTCTime+ -- ^ send_at+ -> Maybe Manager+ -> IO (MandrillResponse [MessagesResponse])+sendTemplate k template content msg async ip_pool send_at = toMandrillResponse MessagesSendTemplate (MessagesSendTemplateRq k template content msg async ip_pool send_at)
src/Network/API/Mandrill/Messages/Types.hs view
@@ -5,12 +5,12 @@ import Data.Char import Data.Time import qualified Data.Text as T-import Control.Lens import Control.Monad import Data.Monoid import Data.Aeson import Data.Aeson.Types import Data.Aeson.TH+import Lens.Micro.TH (makeLenses) import Network.API.Mandrill.Types @@ -27,6 +27,19 @@ makeLenses ''MessagesSendRq deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MessagesSendRq +--------------------------------------------------------------------------------+data MessagesSendTemplateRq = MessagesSendTemplateRq {+ _mstrq_key :: MandrillKey+ , _mstrq_template_name :: T.Text+ , _mstrq_template_content :: [MandrillTemplateContent]+ , _mstrq_message :: MandrillMessage+ , _mstrq_async :: Maybe Bool+ , _mstrq_ip_pool :: Maybe T.Text+ , _mstrq_send_at :: Maybe UTCTime+ } deriving Show++makeLenses ''MessagesSendTemplateRq+deriveJSON defaultOptions { fieldLabelModifier = drop 7 } ''MessagesSendTemplateRq -------------------------------------------------------------------------------- data MessagesResponse = MessagesResponse {
− src/Network/API/Mandrill/Orphans.hs
@@ -1,17 +0,0 @@--module Network.API.Mandrill.Orphans where--import Data.Aeson-import Data.Aeson.Types-import Text.Email.Validate-import qualified Data.Text.Encoding as TE---instance ToJSON EmailAddress where- toJSON = String . TE.decodeUtf8 . toByteString--instance FromJSON EmailAddress where- parseJSON (String s) = case validate (TE.encodeUtf8 s) of- Left err -> fail err- Right v -> return v- parseJSON o = typeMismatch "Expecting a String for EmailAddress." o
+ src/Network/API/Mandrill/Senders.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE TemplateHaskell #-}+module Network.API.Mandrill.Senders where+import Data.Aeson (FromJSON, ToJSON, parseJSON,+ toJSON)+import Data.Aeson.TH (defaultOptions, deriveJSON)+import Data.Aeson.Types (Value (..), fieldLabelModifier)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Lens.Micro.TH (makeLenses)+import Network.API.Mandrill.HTTP (toMandrillResponse)+import Network.API.Mandrill.Settings+import Network.API.Mandrill.Types+import Network.HTTP.Client (Manager)+import qualified Text.Email.Validate as TEV++data VerifyDomainRq =+ VerifyDomainRq+ { _vdrq_key :: MandrillKey+ , _vdrq_domain :: Text+ , _vdrq_mailbox :: Text+ } deriving Show++makeLenses ''VerifyDomainRq+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''VerifyDomainRq++data VerifyDomainResponse =+ VerifyDomainResponse+ { _vdres_status :: Text+ , _vdres_domain :: Text+ , _vdres_email :: MandrillEmail+ } deriving Show++makeLenses ''VerifyDomainResponse+deriveJSON defaultOptions { fieldLabelModifier = drop 7 } ''VerifyDomainResponse+++verifyDomain :: MandrillKey+ -- ^ The API key+ -> TEV.EmailAddress+ -- ^ Email address to use for verification+ -> Maybe Manager+ -> IO (MandrillResponse VerifyDomainResponse)+verifyDomain k email =+ toMandrillResponse VerifyDomain+ (VerifyDomainRq k (decodeUtf8 $ TEV.domainPart email) (decodeUtf8 $ TEV.localPart email))
src/Network/API/Mandrill/Settings.hs view
@@ -15,16 +15,26 @@ -- Messages API | MessagesSend | MessagesSendTemplate- | MessagesSearch deriving Show+ | MessagesSearch+ -- Inbound API+ | RoutesAdd+ | DomainsAdd+ -- Senders API+ | VerifyDomain + deriving Show+ class MandrillEndpoint ep where toUrl :: ep -> T.Text instance MandrillEndpoint MandrillCalls where- toUrl UsersInfo = "users/info.json"- toUrl UsersPing = "users/ping.json"- toUrl UsersPing2 = "users/ping2.json"- toUrl UsersSenders = "users/senders.json"- toUrl MessagesSend = "messages/send.json"+ toUrl UsersInfo = "users/info.json"+ toUrl UsersPing = "users/ping.json"+ toUrl UsersPing2 = "users/ping2.json"+ toUrl UsersSenders = "users/senders.json"+ toUrl MessagesSend = "messages/send.json" toUrl MessagesSendTemplate = "messages/send-template.json"- toUrl MessagesSearch = "messages/search.json"+ toUrl MessagesSearch = "messages/search.json"+ toUrl DomainsAdd = "inbound/add-domain.json"+ toUrl RoutesAdd = "inbound/add-route.json"+ toUrl VerifyDomain = "senders/verify-domain.json"
src/Network/API/Mandrill/Types.hs view
@@ -1,39 +1,59 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module Network.API.Mandrill.Types where -import Network.API.Mandrill.Utils-import Network.API.Mandrill.Orphans()-import Test.QuickCheck-import Text.Email.Validate+import Control.Applicative+import Control.Monad (mzero) import Data.Char import Data.Maybe import Data.Time-import Control.Applicative-import System.Locale (defaultTimeLocale)-import qualified Data.ByteString as B-import qualified Data.ByteString.Base64 as Base64-import qualified Data.Text as T-import qualified Data.Text.Encoding as TL-import qualified Data.Text.Lazy as TL-import Control.Lens-import Data.Monoid+import Lens.Micro.TH (makeLenses)+import Network.API.Mandrill.Utils+import Test.QuickCheck+import Text.Email.Validate+#if MIN_VERSION_time(1,5,0)+import Data.Time.Format (TimeLocale, defaultTimeLocale)+#else+import System.Locale (TimeLocale, defaultTimeLocale)+#endif import Data.Aeson-import Data.Aeson.Types import Data.Aeson.TH-import qualified Text.Blaze.Html as Blaze+import Data.Aeson.Types+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64 as Base64+#if !MIN_VERSION_base(4,8,0)+import Data.Foldable+import Data.Traversable+#endif+import qualified Data.HashMap.Strict as H+import Data.Monoid+import qualified Data.Text as T+import qualified Data.Text.Encoding as TL+import qualified Data.Text.Lazy as TL+import qualified Text.Blaze.Html as Blaze import qualified Text.Blaze.Html.Renderer.Text as Blaze+import qualified Text.Email.Validate as TEV +timeParse :: ParseTime t => TimeLocale -> String -> String -> Maybe t+#if MIN_VERSION_time(1,5,0)+timeParse = parseTimeM True+#else+timeParse = parseTime+#endif -------------------------------------------------------------------------------- data MandrillError = MandrillError {- _merr_status :: !T.Text- , _merr_code :: !Int- , _merr_name :: !T.Text+ _merr_status :: !T.Text+ , _merr_code :: !Int+ , _merr_name :: !T.Text , _merr_message :: !T.Text- } deriving Show+ } deriving (Show, Eq) makeLenses ''MandrillError deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillError@@ -58,6 +78,7 @@ | RR_InvalidSender | RR_Invalid | RR_TestModeLimit+ | RR_Unsigned | RR_Rule deriving Show deriveJSON defaultOptions {@@ -70,7 +91,7 @@ -- which can be either a success or a failure. data MandrillResponse k = MandrillSuccess k- | MandrillFailure MandrillError deriving Show+ | MandrillFailure MandrillError deriving (Show, Eq, Functor, Foldable, Traversable) instance FromJSON k => FromJSON (MandrillResponse k) where parseJSON v = case (parseMaybe parseJSON v) :: Maybe k of@@ -89,13 +110,26 @@ --------------------------------------------------------------------------------+newtype MandrillEmail = MandrillEmail EmailAddress deriving Show++instance ToJSON MandrillEmail where+ toJSON (MandrillEmail e) = String . TL.decodeUtf8 . toByteString $ e++instance FromJSON MandrillEmail where+ parseJSON (String s) = case validate (TL.encodeUtf8 s) of+ Left err -> fail err+ Right v -> return . MandrillEmail $ v+ parseJSON o = typeMismatch "Expecting a String for MandrillEmail." o+++-------------------------------------------------------------------------------- -- | An array of recipient information. data MandrillRecipient = MandrillRecipient {- _mrec_email :: EmailAddress+ _mrec_email :: MandrillEmail -- ^ The email address of the recipient- , _mrec_name :: Maybe T.Text+ , _mrec_name :: Maybe T.Text -- ^ The optional display name to use for the recipient- , _mrec_type :: Maybe MandrillRecipientTag+ , _mrec_type :: Maybe MandrillRecipientTag -- ^ The header type to use for the recipient. -- defaults to "to" if not provided } deriving Show@@ -104,11 +138,11 @@ deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillRecipient newRecipient :: EmailAddress -> MandrillRecipient-newRecipient email = MandrillRecipient email Nothing Nothing+newRecipient email = MandrillRecipient (MandrillEmail email) Nothing Nothing instance Arbitrary MandrillRecipient where arbitrary = pure MandrillRecipient {- _mrec_email = fromJust (emailAddress "test@example.com")+ _mrec_email = MandrillEmail $ fromJust (emailAddress "test@example.com") , _mrec_name = Nothing , _mrec_type = Nothing }@@ -124,6 +158,11 @@ mkMandrillHtml :: Blaze.Html -> MandrillHtml mkMandrillHtml = MandrillHtml +#if MIN_VERSION_base(4,11,0)+instance Semigroup MandrillHtml where+ MandrillHtml m1 <> MandrillHtml m2 = MandrillHtml (m1 <> m2)+#endif+ instance Monoid MandrillHtml where mempty = MandrillHtml mempty mappend (MandrillHtml m1) (MandrillHtml m2) = MandrillHtml (m1 <> m2)@@ -135,7 +174,7 @@ toJSON (MandrillHtml h) = String . TL.toStrict . Blaze.renderHtml $ h instance FromJSON MandrillHtml where- parseJSON (String h) = return $ MandrillHtml (Blaze.toHtml h)+ parseJSON (String h) = return $ MandrillHtml (Blaze.preEscapedToHtml h) parseJSON v = typeMismatch "Expecting a String for MandrillHtml" v instance Arbitrary MandrillHtml where@@ -146,17 +185,23 @@ ---------------------------------------------------------------------------------type MandrillHeaders = Value+type MandrillHeaders = Object ---------------------------------------------------------------------------------type MandrillVars = Value +data MergeVar = MergeVar {+ _mv_name :: !T.Text+ , _mv_content :: Value+ } deriving Show +makeLenses ''MergeVar+deriveJSON defaultOptions { fieldLabelModifier = drop 4 } ''MergeVar+ -------------------------------------------------------------------------------- data MandrillMergeVars = MandrillMergeVars { _mmvr_rcpt :: !T.Text- , _mmvr_vars :: [MandrillVars]+ , _mmvr_vars :: [MergeVar] } deriving Show makeLenses ''MandrillMergeVars@@ -164,29 +209,33 @@ -------------------------------------------------------------------------------- data MandrillMetadata = MandrillMetadata {- _mmdt_rcpt :: !T.Text- , _mmdt_values :: MandrillVars+ _mmdt_rcpt :: !T.Text+ , _mmdt_values :: Object } deriving Show makeLenses ''MandrillMetadata deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillMetadata -newtype Base64ByteString = B64BS B.ByteString deriving Show+data Base64ByteString =+ EncodedB64BS B.ByteString+ -- ^ An already-encoded Base64 ByteString.+ | PlainBS B.ByteString+ -- ^ A plain Base64 ByteString which requires encoding.+ deriving Show instance ToJSON Base64ByteString where- toJSON (B64BS bs) = String . TL.decodeUtf8 . Base64.encode $ bs+ toJSON (PlainBS bs) = String . TL.decodeUtf8 . Base64.encode $ bs+ toJSON (EncodedB64BS bs) = String . TL.decodeUtf8 $ bs instance FromJSON Base64ByteString where- parseJSON (String v) = case Base64.decode (TL.encodeUtf8 v) of- Left err -> fail err- Right rs -> return $ B64BS rs+ parseJSON (String v) = pure $ EncodedB64BS (TL.encodeUtf8 v) parseJSON rest = typeMismatch "Base64ByteString must be a String." rest -------------------------------------------------------------------------------- data MandrillWebContent = MandrillWebContent {- _mwct_type :: !T.Text- , _mwct_name :: !T.Text+ _mwct_type :: !T.Text+ , _mwct_name :: !T.Text -- ^ [for images] the Content ID of the image -- - use <img src="cid:THIS_VALUE"> to reference the image -- in your HTML content@@ -199,67 +248,67 @@ -------------------------------------------------------------------------------- -- | The information on the message to send data MandrillMessage = MandrillMessage {- _mmsg_html :: MandrillHtml+ _mmsg_html :: MandrillHtml -- ^ The full HTML content to be sent- , _mmsg_text :: Maybe T.Text+ , _mmsg_text :: Maybe T.Text -- ^ Optional full text content to be sent- , _mmsg_subject :: !T.Text+ , _mmsg_subject :: !(Maybe T.Text) -- ^ The message subject- , _mmsg_from_email :: EmailAddress+ , _mmsg_from_email :: Maybe MandrillEmail -- ^ The sender email address- , _mmsg_from_name :: Maybe T.Text+ , _mmsg_from_name :: Maybe T.Text -- ^ Optional from name to be used- , _mmsg_to :: [MandrillRecipient]+ , _mmsg_to :: [MandrillRecipient] -- ^ A list of recipient information- , _mmsg_headers :: MandrillHeaders+ , _mmsg_headers :: MandrillHeaders -- ^ optional extra headers to add to the message (most headers are allowed)- , _mmsg_important :: Maybe Bool+ , _mmsg_important :: Maybe Bool -- ^ whether or not this message is important, and should be delivered ahead -- of non-important messages- , _mmsg_track_opens :: Maybe Bool+ , _mmsg_track_opens :: Maybe Bool -- ^ whether or not to turn on open tracking for the message- , _mmsg_track_clicks :: Maybe Bool+ , _mmsg_track_clicks :: Maybe Bool -- ^ whether or not to turn on click tracking for the message- , _mmsg_auto_text :: Maybe Bool+ , _mmsg_auto_text :: Maybe Bool -- ^ whether or not to automatically generate a text part for messages that are not given text- , _mmsg_auto_html :: Maybe Bool+ , _mmsg_auto_html :: Maybe Bool -- ^ whether or not to automatically generate an HTML part for messages that are not given HTML- , _mmsg_inline_css :: Maybe Bool+ , _mmsg_inline_css :: Maybe Bool -- ^ whether or not to automatically inline all CSS styles provided in the message HTML -- - only for HTML documents less than 256KB in size- , _mmsg_url_strip_qs :: Maybe Bool+ , _mmsg_url_strip_qs :: Maybe Bool -- ^ whether or not to strip the query string from URLs when aggregating tracked URL data- , _mmsg_preserve_recipients :: Maybe Bool+ , _mmsg_preserve_recipients :: Maybe Bool -- ^ whether or not to expose all recipients in to "To" header for each email- , _mmsg_view_content_link :: Maybe Bool+ , _mmsg_view_content_link :: Maybe Bool -- ^ set to false to remove content logging for sensitive emails- , _mmsg_bcc_address :: Maybe T.Text+ , _mmsg_bcc_address :: Maybe T.Text -- ^ an optional address to receive an exact copy of each recipient's email- , _mmsg_tracking_domain :: Maybe T.Text+ , _mmsg_tracking_domain :: Maybe T.Text -- ^ a custom domain to use for tracking opens and clicks instead of mandrillapp.com- , _mmsg_signing_domain :: Maybe Bool- -- ^ a custom domain to use for SPF/DKIM signing instead of mandrill + , _mmsg_signing_domain :: Maybe Bool+ -- ^ a custom domain to use for SPF/DKIM signing instead of mandrill -- (for "via" or "on behalf of" in email clients)- , _mmsg_return_path_domain :: Maybe Bool+ , _mmsg_return_path_domain :: Maybe Bool -- ^ a custom domain to use for the messages's return-path- , _mmsg_merge :: Maybe Bool+ , _mmsg_merge :: Maybe Bool -- ^ whether to evaluate merge tags in the message. -- Will automatically be set to true if either merge_vars -- or global_merge_vars are provided.- , _mmsg_global_merge_vars :: [MandrillVars]+ , _mmsg_global_merge_vars :: [MergeVar] -- ^ global merge variables to use for all recipients. You can override these per recipient.- , _mmsg_merge_vars :: [MandrillMergeVars]+ , _mmsg_merge_vars :: [MandrillMergeVars] -- ^ per-recipient merge variables, which override global merge variables with the same name.- , _mmsg_tags :: [MandrillTags]+ , _mmsg_tags :: [MandrillTags] -- ^ an array of string to tag the message with. Stats are accumulated using tags, -- though we only store the first 100 we see, so this should not be unique -- or change frequently. Tags should be 50 characters or less. -- Any tags starting with an underscore are reserved for internal use -- and will cause errors.- , _mmsg_subaccount :: Maybe T.Text+ , _mmsg_subaccount :: Maybe T.Text -- ^ the unique id of a subaccount for this message -- - must already exist or will fail with an error- , _mmsg_google_analytics_domains :: [T.Text]+ , _mmsg_google_analytics_domains :: [T.Text] -- ^ an array of strings indicating for which any matching URLs -- will automatically have Google Analytics parameters appended -- to their query string automatically.@@ -267,17 +316,17 @@ -- ^ optional string indicating the value to set for the utm_campaign -- tracking parameter. If this isn't provided the email's from address -- will be used instead.- , _mmsg_metadata :: MandrillVars+ , _mmsg_metadata :: Object -- ^ metadata an associative array of user metadata. Mandrill will store -- this metadata and make it available for retrieval. -- In addition, you can select up to 10 metadata fields to index -- and make searchable using the Mandrill search api.- , _mmsg_recipient_metadata :: [MandrillMetadata]+ , _mmsg_recipient_metadata :: [MandrillMetadata] -- ^ Per-recipient metadata that will override the global values -- specified in the metadata parameter.- , _mmsg_attachments :: [MandrillWebContent]+ , _mmsg_attachments :: [MandrillWebContent] -- ^ an array of supported attachments to add to the message- , _mmsg_images :: [MandrillWebContent]+ , _mmsg_images :: [MandrillWebContent] -- ^ an array of embedded images to add to the message } deriving Show @@ -287,11 +336,11 @@ instance Arbitrary MandrillMessage where arbitrary = MandrillMessage <$> arbitrary <*> pure Nothing- <*> pure "Test Subject"- <*> pure (fromJust $ emailAddress "sender@example.com")+ <*> pure (Just "Test Subject")+ <*> pure (MandrillEmail <$> emailAddress "sender@example.com") <*> pure Nothing <*> resize 2 arbitrary- <*> pure emptyObject+ <*> pure mempty <*> pure Nothing <*> pure Nothing <*> pure Nothing@@ -312,13 +361,24 @@ <*> pure Nothing <*> pure [] <*> pure Nothing- <*> pure emptyObject+ <*> pure mempty <*> pure [] <*> pure [] <*> pure [] --------------------------------------------------------------------------------+-- | Key value pair for replacing content in templates via 'Editable Regions'+data MandrillTemplateContent = MandrillTemplateContent {+ _mtc_name :: T.Text+ , _mtc_content :: T.Text+ } deriving Show++makeLenses ''MandrillTemplateContent+deriveJSON defaultOptions { fieldLabelModifier = drop 5 } ''MandrillTemplateContent++-------------------------------------------------------------------------------- type MandrillKey = T.Text+type MandrillTemplate = T.Text newtype MandrillDate = MandrillDate { fromMandrillDate :: UTCTime@@ -329,6 +389,6 @@ instance FromJSON MandrillDate where parseJSON = withText "MandrillDate" $ \t ->- case parseTime defaultTimeLocale "%Y-%m-%d %I:%M:%S%Q" (T.unpack t) of+ case timeParse defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q" (T.unpack t) of Just d -> pure $ MandrillDate d _ -> fail "could not parse Mandrill date"
src/Network/API/Mandrill/Users/Types.hs view
@@ -5,12 +5,12 @@ import Data.Char import Data.Time import qualified Data.Text as T-import Control.Lens import Control.Monad import Data.Monoid import Data.Aeson import Data.Aeson.Types import Data.Aeson.TH+import Lens.Micro.TH (makeLenses) import Network.API.Mandrill.Types
+ src/Network/API/Mandrill/Webhooks.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Network.API.Mandrill.Webhooks where+import Control.Applicative (pure)+import Control.Monad (mzero)+import Data.Aeson (FromJSON, ToJSON, parseJSON,+ toJSON)+import Data.Aeson (Value (String))+import Data.Aeson.TH (defaultOptions, deriveJSON)+import Data.Aeson.Types (fieldLabelModifier)+import Data.Set (Set)+import Data.Text (Text)+import qualified Data.Text as T+import Lens.Micro.TH (makeLenses)+import Network.API.Mandrill.HTTP (toMandrillResponse)+import Network.API.Mandrill.Settings+import Network.API.Mandrill.Types+import Network.HTTP.Client (Manager)++data EventHook+ = EventSent+ | EventDeferred+ | EventHardBounced+ | EventSoftBounced+ | EventOpened+ | EventClicked+ | EventMarkedAsSpam+ | EventUnsubscribed+ | EventRejected+ deriving (Ord,Eq)++instance Show EventHook where+ show e = case e of+ EventSent -> "send"+ EventDeferred -> "deferral"+ EventSoftBounced -> "soft_bounce"+ EventHardBounced -> "hard_bounce"+ EventOpened -> "open"+ EventClicked -> "click"+ EventMarkedAsSpam -> "spam"+ EventUnsubscribed -> "unsub"+ EventRejected -> "reject"+instance FromJSON EventHook where+ parseJSON (String s) =+ case s of+ "send" -> pure EventSent+ "deferral" -> pure EventDeferred+ "soft_bounce" -> pure EventSoftBounced+ "hard_bounce" -> pure EventHardBounced+ "open" -> pure EventOpened+ "click" -> pure EventClicked+ "spam" -> pure EventMarkedAsSpam+ "reject" -> pure EventRejected+ "unsub" -> pure EventUnsubscribed+ x -> fail ("can't parse " ++ show x)+++instance ToJSON EventHook where+ toJSON e = String (T.pack $ show e)++data WebhookAddRq =+ WebhookAddRq+ { _warq_key :: MandrillKey+ , _warq_url :: Text+ , _warq_description :: Text+ , _warq_events :: Set EventHook+ } deriving Show++makeLenses ''WebhookAddRq+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''WebhookAddRq
test/Main.hs view
@@ -1,14 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import System.Environment import Data.Monoid-import Tests+import qualified Data.Text as T import Online+import System.Environment import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck-import qualified Data.Text as T+import Tests ---------------------------------------------------------------------- withQuickCheckDepth :: TestName -> Int -> [TestTree] -> TestTree@@ -23,10 +23,12 @@ Nothing -> return [] Just k -> return [ testGroup "Mandrill online tests" [- testCase "users/info.json" (testOnlineUsersInfo k)- , testCase "users/ping2.json" (testOnlineUsersPing2 k)- , testCase "users/senders.json" (testOnlineUsersSenders k)- , testCase "messages/send.json" (testOnlineMessagesSend k)+ testCase "users/info.json" (testOnlineUsersInfo k)+ , testCase "users/ping2.json" (testOnlineUsersPing2 k)+ , testCase "users/senders.json" (testOnlineUsersSenders k)+ , testCase "messages/send.json" (testOnlineMessagesSend k)+ , testCase "inbound/addDomain.json" (testOnlineDomainAdd k)+ , testCase "inbound/addRoute.json" (testOnlineRouteAdd k) ]] ----------------------------------------------------------------------@@ -39,5 +41,10 @@ testCase "users/info.json API parsing" testUsersInfo , testCase "users/senders.json API parsing" testUsersSenders , testCase "messages/send.json API parsing" testMessagesSend+ , testCase "messages/send.json API response parsing" testMessagesResponseRejected+ , testCase "inbound/add-route.json API response parsing" testRouteAdd+ , testCase "inbound/add-domain.json API response parsing" testDomainAdd+ , testCase "senders/verify-domain.json API response parsing" testVerifyDomain+ , testCase "webhooks/add.json API response parsing" testWebhookAdd ] ]
test/Online.hs view
@@ -1,19 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} module Online where -import Test.QuickCheck-import Test.Tasty.HUnit-import Text.RawString.QQ-import Data.Either import Data.Aeson+import qualified Data.ByteString.Char8 as C8+import Data.Either import Network.API.Mandrill.Messages.Types import Network.API.Mandrill.Users.Types-import qualified Data.ByteString.Char8 as C8 import RawData+import Test.QuickCheck+import Test.Tasty.HUnit+import Text.RawString.QQ +import qualified Network.API.Mandrill.Inbound as API+import qualified Network.API.Mandrill.Messages as API import Network.API.Mandrill.Types-import qualified Network.API.Mandrill.Messages as API-import qualified Network.API.Mandrill.Users as API+import qualified Network.API.Mandrill.Users as API -- -- Users calls@@ -50,3 +51,20 @@ case res of MandrillSuccess _ -> return () MandrillFailure e -> fail $ "messages/send.json " ++ show e++--+-- Inbound calls+--+testOnlineDomainAdd :: MandrillKey -> Assertion+testOnlineDomainAdd k = do+ res <- API.addDomain k "foobar.com" Nothing+ case res of+ MandrillSuccess a -> print a+ MandrillFailure e -> fail $ "inbound/add-domain.json " ++ show e++testOnlineRouteAdd :: MandrillKey -> Assertion+testOnlineRouteAdd k = do+ res <- API.addRoute k "foobar.com" "mail-*" "http://requestb.in/19a4frw1" Nothing+ case res of+ MandrillSuccess a -> print a+ MandrillFailure e -> fail $ "inbound/add-domain.json " ++ show e
test/RawData.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE QuasiQuotes #-} module RawData where -import Test.QuickCheck-import Test.Tasty.HUnit-import Text.RawString.QQ-import Data.Either+import Data.Either+import Test.QuickCheck+import Test.Tasty.HUnit+import Text.RawString.QQ usersInfoData :: String usersInfoData = [r|@@ -198,5 +198,60 @@ "async": false, "ip_pool": "Main Pool", "send_at": "2014-08-17T14:23:02.954Z"+}+|]+++messagesResponseRejected = [r|+[ { "email" : "foo@bar.com",+ "status" : "rejected",+ "_id" : "abc123",+ "reject_reason": "unsigned"+ }+]+|]+++domainAdd = [r|+{+ "domain": "inbound.example.com",+ "created_at": "2013-01-01 15:30:27",+ "valid_mx": true+}+|]+++routeAdd= [r|+{+ "id": "7.23",+ "pattern": "mailbox-*",+ "url": "http://example.com/webhook-url"+}+|]++domainVerify = [r|+{+ "status": "example status",+ "domain": "example domain",+ "email": "email@domain.com"+}+|]++webhookAdd = [r|+{+ "key": "example key",+ "url": "http://example/webhook-url",+ "description": "My Example Webhook",+ "events": [+ "send",+ "deferral",+ "hard_bounce",+ "soft_bounce",+ "open",+ "click",+ "spam",+ "unsub",+ "reject"+ ] } |]
test/Tests.hs view
@@ -1,13 +1,17 @@ {-# LANGUAGE CPP #-} module Tests where -import Test.Tasty.HUnit-import Data.Either-import Data.Aeson-import Network.API.Mandrill.Messages.Types-import Network.API.Mandrill.Users.Types-import qualified Data.ByteString.Char8 as C8-import RawData+import Data.Aeson+import qualified Data.ByteString.Char8 as C8+import Data.Either+import Network.API.Mandrill.Inbound+import Network.API.Mandrill.Messages.Types+import Network.API.Mandrill.Senders+import Network.API.Mandrill.Types+import Network.API.Mandrill.Users.Types+import Network.API.Mandrill.Webhooks+import RawData+import Test.Tasty.HUnit #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 706 isRight :: Either a b -> Bool@@ -16,7 +20,7 @@ #endif testMessagesSend :: Assertion-testMessagesSend = +testMessagesSend = assertBool ("send.json: Parsing failed! " ++ show parsePayload) (isRight parsePayload) where@@ -40,3 +44,45 @@ where parsePayload :: Either String UsersSendersResponse parsePayload = eitherDecodeStrict . C8.pack $ usersSendersData++testMessagesResponseRejected :: Assertion+testMessagesResponseRejected = do+ assertBool ("send.json response: Parsing failed" ++ show parsePayload)+ (isRight parsePayload)+ where+ parsePayload :: Either String (MandrillResponse [MessagesResponse])+ parsePayload = eitherDecodeStrict . C8.pack $ messagesResponseRejected++testDomainAdd :: Assertion+testDomainAdd =+ assertBool ("inbound/add-domain.json (response): parsing failed" ++ show parsePayload)+ (isRight parsePayload)+ where+ parsePayload :: Either String DomainAddResponse+ parsePayload = eitherDecodeStrict . C8.pack $ domainAdd+++testRouteAdd :: Assertion+testRouteAdd =+ assertBool ("inbound/add-route.json (response): parsing failed" ++ show parsePayload)+ (isRight parsePayload)+ where+ parsePayload :: Either String RouteAddResponse+ parsePayload = eitherDecodeStrict . C8.pack $ routeAdd++testVerifyDomain :: Assertion+testVerifyDomain =+ assertBool ("senders/verify-domain.json" ++ show parsePayload)+ (isRight parsePayload)+ where+ parsePayload :: Either String VerifyDomainResponse+ parsePayload = eitherDecodeStrict . C8.pack $ domainVerify+++testWebhookAdd :: Assertion+testWebhookAdd =+ assertBool ("webhooks/add.json (request): parsing failed" ++ show parsePayload)+ (isRight parsePayload)+ where+ parsePayload :: Either String WebhookAddRq+ parsePayload = eitherDecodeStrict . C8.pack $ webhookAdd