mandrill (empty) → 0.1.0.0

raw patch · 18 files changed

+1205/−0 lines, 18 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, base64-bytestring, blaze-html, bytestring, containers, email-validate, lens, mandrill, mtl, old-locale, raw-strings-qq, tasty, tasty-hunit, tasty-quickcheck, text, time, wreq

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• mandrill.cabal +78/−0
• src/Network/API/Mandrill.hs +101/−0
• src/Network/API/Mandrill/HTTP.hs +19/−0
• src/Network/API/Mandrill/Messages.hs +25/−0
• src/Network/API/Mandrill/Messages/Types.hs +44/−0
• src/Network/API/Mandrill/Orphans.hs +17/−0
• src/Network/API/Mandrill/Settings.hs +30/−0
• src/Network/API/Mandrill/Trans.hs +25/−0
• src/Network/API/Mandrill/Types.hs +334/−0
• src/Network/API/Mandrill/Users.hs +32/−0
• src/Network/API/Mandrill/Users/Types.hs +122/−0
• src/Network/API/Mandrill/Utils.hs +17/−0
• test/Main.hs +43/−0
• test/Online.hs +52/−0
• test/RawData.hs +202/−0
• test/Tests.hs +42/−0

@@ -0,0 +1,20 @@+Copyright (c) 2014 Alfredo Di Napoli++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,78 @@+name:                mandrill+version:             0.1.0.0+synopsis:            Library for interfacing with the Mandrill JSON API+description:         Pure Haskell client for the Mandrill JSON API+license:             MIT+license-file:        LICENSE+author:              Alfredo Di Napoli+maintainer:          alfredo.dinapoli@gmail.com+category:            Network+build-type:          Simple+tested-with:         GHC == 7.4, GHC == 7.6, GHC == 7.8+cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/adinapoli/mandrill++library+  exposed-modules:+    Network.API.Mandrill+    Network.API.Mandrill.Settings+    Network.API.Mandrill.Types+    Network.API.Mandrill.Trans+    Network.API.Mandrill.Users+    Network.API.Mandrill.Users.Types+    Network.API.Mandrill.Messages+    Network.API.Mandrill.Messages.Types+  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.2+    , wreq >= 0.1.0.1+    , aeson >= 0.7.0.3 && < 0.8+    , lens >= 4.1 && < 4.6+    , blaze-html >= 0.5.0.0+    , QuickCheck >= 2.6 && < 2.8+    , mtl < 3.0+    , time+    , email-validate >= 1.0.0+    , old-locale+  hs-source-dirs:+    src+  default-language:+    Haskell2010+  ghc-options:+    -funbox-strict-fields++test-suite mandrill-tests+  type:+    exitcode-stdio-1.0+  main-is:+    Main.hs+  other-modules:+    Tests+    RawData+    Online+  hs-source-dirs:+    test+  default-language:+    Haskell2010+  build-depends:+      mandrill -any+    , base+    , aeson+    , bytestring+    , QuickCheck+    , tasty >= 0.9.0.1+    , tasty-quickcheck+    , tasty-hunit+    , raw-strings-qq < 1.2+    , text

@@ -0,0 +1,101 @@++module Network.API.Mandrill (+    module M+  , sendEmail+  , emptyMessage+  , newTextMessage+  , newHtmlMessage+  , liftIO+  ) 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+++--------------------------------------------------------------------------------+emptyMessage :: EmailAddress -> EmailAddress -> MandrillMessage+emptyMessage f t = MandrillMessage {+   _mmsg_html = mempty+ , _mmsg_text = Nothing+ , _mmsg_subject = T.empty+ , _mmsg_from_email = f+ , _mmsg_from_name = Nothing+ , _mmsg_to = [newRecipient t]+ , _mmsg_headers = JSON.Null+ , _mmsg_important = Nothing+ , _mmsg_track_opens = Nothing+ , _mmsg_track_clicks = Nothing+ , _mmsg_auto_text = Nothing+ , _mmsg_auto_html = Nothing+ , _mmsg_inline_css = Nothing+ , _mmsg_url_strip_qs = Nothing+ , _mmsg_preserve_recipients = Nothing+ , _mmsg_view_content_link = Nothing+ , _mmsg_bcc_address = Nothing+ , _mmsg_tracking_domain = Nothing+ , _mmsg_signing_domain = Nothing+ , _mmsg_return_path_domain = Nothing+ , _mmsg_merge = Nothing+ , _mmsg_global_merge_vars = []+ , _mmsg_merge_vars = []+ , _mmsg_tags = []+ , _mmsg_subaccount = Nothing+ , _mmsg_google_analytics_domains = []+ , _mmsg_google_analytics_campaign = Nothing+ , _mmsg_metadata = JSON.Null+ , _mmsg_recipient_metadata = []+ , _mmsg_attachments = []+ , _mmsg_images = []+  }++++--------------------------------------------------------------------------------+newHtmlMessage :: EmailAddress+               -> EmailAddress+               -> T.Text+               -> Html+               -> MandrillMessage+newHtmlMessage f t subj html = let body = mkMandrillHtml html in+  ((mmsg_html .~ body) . (mmsg_subject .~ subj)) $ (emptyMessage f t)+++--------------------------------------------------------------------------------+newTextMessage :: EmailAddress+               -> EmailAddress+               -> T.Text+               -> T.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)+++--------------------------------------------------------------------------------+sendEmail :: MonadIO m+          => MandrillMessage+          -> MandrillT m (MandrillResponse [MessagesResponse])+sendEmail msg = do+  key <- ask+  liftIO $ send key msg (Just True) Nothing Nothing+++--------------------------------------------------------------------------------+sendTextEmail :: MonadIO m+              => MandrillMessage+              -> MandrillT m (MandrillResponse [MessagesResponse])+sendTextEmail msg = do+  key <- ask+  now <- liftIO getCurrentTime+  liftIO $ send key msg (Just True) Nothing (Just now)

@@ -0,0 +1,19 @@+{-# 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 Network.Wreq+import Control.Lens++toMandrillResponse :: (MandrillEndpoint ep, FromJSON a, ToJSON rq)+                   => ep+                   -> rq+                   -> IO (MandrillResponse a)+toMandrillResponse ep rq = do+  let fullUrl = mandrillUrl <> toUrl ep+  res <- asJSON =<< post (T.unpack fullUrl) (toJSON rq)+  return $ res ^. responseBody

@@ -0,0 +1,25 @@++module Network.API.Mandrill.Messages where++import           Network.API.Mandrill.Types+import           Network.API.Mandrill.Messages.Types+import           Network.API.Mandrill.Settings+import           Network.API.Mandrill.HTTP+import           Data.Time+import qualified Data.Text as T++--------------------------------------------------------------------------------+-- | Send a new transactional message through Mandrill+send :: MandrillKey+     -- ^ The API key+     -> 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+     -> IO (MandrillResponse [MessagesResponse])+send k msg async ip_pool send_at =+  toMandrillResponse MessagesSend (MessagesSendRq k msg async ip_pool send_at)

@@ -0,0 +1,44 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Network.API.Mandrill.Messages.Types where++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           Network.API.Mandrill.Types+++--------------------------------------------------------------------------------+data MessagesSendRq = MessagesSendRq {+    _msrq_key :: MandrillKey+  , _msrq_message :: MandrillMessage+  , _msrq_async :: Maybe Bool+  , _msrq_ip_pool :: Maybe T.Text+  , _msrq_send_at :: Maybe UTCTime+  } deriving Show++makeLenses ''MessagesSendRq+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MessagesSendRq+++--------------------------------------------------------------------------------+data MessagesResponse = MessagesResponse {+    _mres_email :: !T.Text+    -- ^ The email address of the recipient+  , _mres_status :: MandrillEmailStatus+    -- ^ The sending status of the recipient+  , _mres_reject_reason :: Maybe MandrillRejectReason+    -- ^ The reason for the rejection if the recipient status is "rejected"+  , _mres__id    :: !T.Text+    -- ^ The message's unique id+  } deriving Show++makeLenses ''MessagesResponse+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MessagesResponse

@@ -0,0 +1,17 @@++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

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.API.Mandrill.Settings where++import qualified Data.Text as T++mandrillUrl :: T.Text+mandrillUrl = "https://mandrillapp.com/api/1.0/"++data MandrillCalls =+  -- Users API+    UsersInfo+  | UsersPing+  | UsersPing2+  | UsersSenders+  -- Messages API+  | MessagesSend+  | MessagesSendTemplate+  | MessagesSearch 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 MessagesSendTemplate = "messages/send-template.json"+  toUrl MessagesSearch = "messages/search.json"

@@ -0,0 +1,25 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Network.API.Mandrill.Trans where++import Control.Monad.Reader+import Control.Applicative+import Network.API.Mandrill.Types+++--------------------------------------------------------------------------------+newtype MandrillT m a = MandrillT {+  runMandrillT :: ReaderT MandrillKey m a+  } deriving (MonadTrans, MonadReader MandrillKey,+              Functor, Applicative, Monad, MonadIO)+++--------------------------------------------------------------------------------+type Mandrill = MandrillT IO+++--------------------------------------------------------------------------------+runMandrill :: MonadIO m+            => MandrillKey+            -> MandrillT m a+            -> m a+runMandrill key action = runReaderT (runMandrillT action) key

@@ -0,0 +1,334 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+module Network.API.Mandrill.Types where++import           Network.API.Mandrill.Utils+import           Network.API.Mandrill.Orphans()+import           Test.QuickCheck+import           Text.Email.Validate+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           Data.Aeson+import           Data.Aeson.Types+import           Data.Aeson.TH+import qualified Text.Blaze.Html as Blaze+import qualified Text.Blaze.Html.Renderer.Text as Blaze+++--------------------------------------------------------------------------------+data MandrillError = MandrillError {+    _merr_status :: !T.Text+  , _merr_code :: !Int+  , _merr_name :: !T.Text+  , _merr_message :: !T.Text+  } deriving Show++makeLenses ''MandrillError+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillError+++--------------------------------------------------------------------------------+data MandrillEmailStatus = ES_Sent+                         | ES_Queued+                         | ES_Scheduled+                         | ES_Rejected+                         | ES_Invalid deriving Show++deriveJSON defaultOptions { constructorTagModifier = map toLower . drop 3 } ''MandrillEmailStatus+++--------------------------------------------------------------------------------+data MandrillRejectReason = RR_HardBounce+                          | RR_SoftBounce+                          | RR_Spam+                          | RR_Unsub+                          | RR_Custom+                          | RR_InvalidSender+                          | RR_Invalid+                          | RR_TestModeLimit+                          | RR_Rule deriving Show++deriveJSON defaultOptions {+  constructorTagModifier = modRejectReason . drop 3+  } ''MandrillRejectReason+++--------------------------------------------------------------------------------+-- | The main datatypes which models the response from the Mandrill API,+-- which can be either a success or a failure.+data MandrillResponse k =+    MandrillSuccess k+  | MandrillFailure MandrillError deriving Show++instance FromJSON k => FromJSON (MandrillResponse k) where+  parseJSON v = case (parseMaybe parseJSON v) :: Maybe k of+    Just r -> return $ MandrillSuccess r+    Nothing -> do+    -- try to parse it as an error+      case (parseMaybe parseJSON v) :: Maybe MandrillError of+        Just e -> return $ MandrillFailure e+        Nothing -> fail $ show v <> " is neither a MandrillSuccess or a MandrillError."+++--------------------------------------------------------------------------------+data MandrillRecipientTag = To | Cc | Bcc deriving Show++deriveJSON defaultOptions { constructorTagModifier = map toLower } ''MandrillRecipientTag+++--------------------------------------------------------------------------------+-- | An array of recipient information.+data MandrillRecipient = MandrillRecipient {+    _mrec_email :: EmailAddress+    -- ^ The email address of the recipient+  , _mrec_name :: Maybe T.Text+    -- ^ The optional display name to use for the recipient+  , _mrec_type :: Maybe MandrillRecipientTag+    -- ^ The header type to use for the recipient.+    --   defaults to "to" if not provided+  } deriving Show++makeLenses ''MandrillRecipient+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillRecipient++newRecipient :: EmailAddress -> MandrillRecipient+newRecipient email = MandrillRecipient email Nothing Nothing++instance Arbitrary MandrillRecipient where+  arbitrary = pure MandrillRecipient {+      _mrec_email = fromJust (emailAddress "test@example.com")+    , _mrec_name  =  Nothing+    , _mrec_type  =  Nothing+    }++--------------------------------------------------------------------------------+newtype MandrillHtml = MandrillHtml Blaze.Html++unsafeMkMandrillHtml :: T.Text -> MandrillHtml+unsafeMkMandrillHtml = MandrillHtml . Blaze.preEscapedToHtml++-- This might be slightly hairy because it violates+-- the nice encapsulation that newtypes offer.+mkMandrillHtml :: Blaze.Html -> MandrillHtml+mkMandrillHtml = MandrillHtml++instance Monoid MandrillHtml where+  mempty = MandrillHtml mempty+  mappend (MandrillHtml m1) (MandrillHtml m2) = MandrillHtml (m1 <> m2)++instance Show MandrillHtml where+  show (MandrillHtml h) = show $ Blaze.renderHtml h++instance ToJSON MandrillHtml where+  toJSON (MandrillHtml h) = String . TL.toStrict . Blaze.renderHtml $ h++instance FromJSON MandrillHtml where+  parseJSON (String h) = return $ MandrillHtml (Blaze.toHtml h)+  parseJSON v = typeMismatch "Expecting a String for MandrillHtml" v++instance Arbitrary MandrillHtml where+  arbitrary = pure $ mkMandrillHtml "<p><b>FooBar</b></p>"++--------------------------------------------------------------------------------+type MandrillTags = T.Text+++--------------------------------------------------------------------------------+type MandrillHeaders = Value+++--------------------------------------------------------------------------------+type MandrillVars = Value+++--------------------------------------------------------------------------------+data MandrillMergeVars = MandrillMergeVars {+    _mmvr_rcpt :: !T.Text+  , _mmvr_vars :: [MandrillVars]+  } deriving Show++makeLenses ''MandrillMergeVars+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillMergeVars++--------------------------------------------------------------------------------+data MandrillMetadata = MandrillMetadata {+    _mmdt_rcpt :: !T.Text+  , _mmdt_values :: MandrillVars+  } deriving Show++makeLenses ''MandrillMetadata+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillMetadata+++newtype Base64ByteString = B64BS B.ByteString deriving Show++instance ToJSON Base64ByteString where+  toJSON (B64BS bs) = String . TL.decodeUtf8 . Base64.encode $ 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 rest = typeMismatch "Base64ByteString must be a String." rest++--------------------------------------------------------------------------------+data MandrillWebContent = MandrillWebContent {+    _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+  , _mwct_content :: !Base64ByteString+  } deriving Show++makeLenses ''MandrillWebContent+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillWebContent++--------------------------------------------------------------------------------+-- | The information on the message to send+data MandrillMessage = MandrillMessage {+   _mmsg_html :: MandrillHtml+   -- ^ The full HTML content to be sent+ , _mmsg_text :: Maybe T.Text+   -- ^ Optional full text content to be sent+ , _mmsg_subject :: !T.Text+   -- ^ The message subject+ , _mmsg_from_email :: EmailAddress+   -- ^ The sender email address+ , _mmsg_from_name :: Maybe T.Text+   -- ^ Optional from name to be used+ , _mmsg_to :: [MandrillRecipient]+   -- ^ A list of recipient information+ , _mmsg_headers :: MandrillHeaders+   -- ^ optional extra headers to add to the message (most headers are allowed)+ , _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+   -- ^ whether or not to turn on open tracking for the message+ , _mmsg_track_clicks :: Maybe Bool+   -- ^ whether or not to turn on click tracking for the message+ , _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+   -- ^ whether or not to automatically generate an HTML part for messages that are not given HTML+ , _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+   -- ^ whether or not to strip the query string from URLs when aggregating tracked URL data+ , _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+   -- ^ set to false to remove content logging for sensitive emails+ , _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+   -- ^ 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 +   -- (for "via" or "on behalf of" in email clients)+ , _mmsg_return_path_domain :: Maybe Bool+   -- ^ a custom domain to use for the messages's return-path+ , _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]+   -- ^ global merge variables to use for all recipients. You can override these per recipient.+ , _mmsg_merge_vars :: [MandrillMergeVars]+   -- ^ per-recipient merge variables, which override global merge variables with the same name.+ , _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+   -- ^ the unique id of a subaccount for this message+   -- - must already exist or will fail with an error+ , _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.+ , _mmsg_google_analytics_campaign :: Maybe T.Text+   -- ^ 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+   -- ^ 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]+   -- ^ Per-recipient metadata that will override the global values+   -- specified in the metadata parameter.+ , _mmsg_attachments :: [MandrillWebContent]+   -- ^ an array of supported attachments to add to the message+ , _mmsg_images :: [MandrillWebContent]+   -- ^ an array of embedded images to add to the message+ } deriving Show++makeLenses ''MandrillMessage+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillMessage++instance Arbitrary MandrillMessage where+  arbitrary = MandrillMessage <$> arbitrary+                              <*> pure Nothing+                              <*> pure "Test Subject"+                              <*> pure (fromJust $ emailAddress "sender@example.com")+                              <*> pure Nothing+                              <*> resize 2 arbitrary+                              <*> pure emptyObject+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure Nothing+                              <*> pure []+                              <*> pure []+                              <*> pure []+                              <*> pure Nothing+                              <*> pure []+                              <*> pure Nothing+                              <*> pure emptyObject+                              <*> pure []+                              <*> pure []+                              <*> pure []++--------------------------------------------------------------------------------+type MandrillKey = T.Text++newtype MandrillDate = MandrillDate {+  fromMandrillDate :: UTCTime+  } deriving Show++instance ToJSON MandrillDate where+  toJSON = toJSON . fromMandrillDate++instance FromJSON MandrillDate where+  parseJSON = withText "MandrillDate" $ \t ->+      case parseTime defaultTimeLocale "%Y-%m-%d %I:%M:%S%Q" (T.unpack t) of+        Just d -> pure $ MandrillDate d+        _      -> fail "could not parse Mandrill date"

@@ -0,0 +1,32 @@++module Network.API.Mandrill.Users where++import           Network.API.Mandrill.Settings+import           Network.API.Mandrill.HTTP+import           Network.API.Mandrill.Types+import           Network.API.Mandrill.Users.Types+import           Data.Aeson+++--------------------------------------------------------------------------------+-- | Return the information about the API-connected user+info :: MandrillKey -> IO (MandrillResponse UsersInfoResponse)+info key = toMandrillResponse UsersInfo (UsersRq key)+++--------------------------------------------------------------------------------+-- | Validate an API key and respond to a ping+ping :: MandrillKey -> IO (MandrillResponse UsersPingResponse)+ping _ = fail "users/ping.json doesn't return valid JSON, thus is not implemented yet."+++--------------------------------------------------------------------------------+-- | Validate an API key and respond to a ping (anal JSON parser version)+ping2 :: MandrillKey -> IO (MandrillResponse UsersPing2Response)+ping2 key = toMandrillResponse UsersPing2 (UsersRq key)+++--------------------------------------------------------------------------------+-- | Return the senders that have tried to use this account, both verified and unverified+senders :: MandrillKey -> IO (MandrillResponse [UsersSendersResponse])+senders key = toMandrillResponse UsersSenders (UsersRq key)

@@ -0,0 +1,122 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Network.API.Mandrill.Users.Types where++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           Network.API.Mandrill.Types+++--------------------------------------------------------------------------------+data UsersRq = UsersRq {+    _ureq_key :: !MandrillKey+  } deriving Show++makeLenses ''UsersRq+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersRq++--------------------------------------------------------------------------------+data MandrillStats = MandrillStats {+    _msts_sent :: Int+  , _msts_hard_bounces :: Int+  , _msts_soft_bounces :: Int+  , _msts_rejects :: Int+  , _msts_complaints :: Int+  , _msts_unsubs :: Int+  , _msts_opens :: Int+  , _msts_unique_opens :: Int+  , _msts_clicks :: Int+  , _msts_unique_clicks :: Int+  } deriving Show++makeLenses ''MandrillStats+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillStats++--------------------------------------------------------------------------------+data UserStats = UserStats {+    _usts_today :: MandrillStats+  , _usts_last_7_days :: MandrillStats+  , _usts_last_30_days :: MandrillStats+  , _usts_last_60_days :: MandrillStats+  , _usts_last_90_days :: MandrillStats+  , _usts_all_time :: MandrillStats+  } deriving Show++makeLenses ''UserStats+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UserStats++--------------------------------------------------------------------------------+data UsersInfoResponse = UsersInfoResponse {+    _usir_username :: !T.Text+  , _usir_created_at :: MandrillDate+  , _usir_public_id :: !T.Text+  , _usir_reputation :: !Int+  , _usir_hourly_quota :: !Int+  , _usir_backlog :: !Int+  , _usir_stats :: UserStats+  } deriving Show++makeLenses ''UsersInfoResponse+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersInfoResponse+++--------------------------------------------------------------------------------+newtype UsersPingResponse = UsersPingResponse T.Text deriving Show++deriveFromJSON defaultOptions ''UsersPingResponse++instance ToJSON UsersPingResponse where+  toJSON (UsersPingResponse t) = String t+++--------------------------------------------------------------------------------+data UsersPing2Response = UsersPing2Response {+    _usrr_PING :: T.Text+  } deriving Show++deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersPing2Response++++--------------------------------------------------------------------------------+data UsersSendersResponse = UsersResponse {+    _usrr_address :: !T.Text+    -- ^ The sender's email address+  , _usrr_created_at :: MandrillDate+    -- ^ The date and time that the sender was first seen by Mandrill +    -- as a UTC date string in YYYY-MM-DD HH:MM:SS format+  , _usrr_sent :: !Int+    -- ^ The total number of messages sent by this sender+  , _usrr_hard_bounces :: !Int+    -- ^ The total number of hard bounces by messages by this sender+  , _usrr_soft_bounces :: !Int+    -- ^ The total number of soft bounces by messages by this sender+  , _usrr_rejects :: !Int+    -- ^ The total number of rejected messages by this sender+  , _usrr_complaints :: !Int+    -- ^ The total number of spam complaints received+    -- for messages by this sender+  , _usrr_unsubs :: !Int+    -- ^ The total number of unsubscribe requests received+    -- for messages by this sender+  , _usrr_opens :: !Int+    -- ^ The total number of times messages by this sender have been opened+  , _usrr_clicks :: !Int+    -- ^ The total number of times tracked URLs in messages+    -- by this sender have been clicked+  , _usrr_unique_opens :: !Int+    -- ^ The number of unique opens for emails sent for this sender+  , _usrr_unique_clicks :: !Int+    -- ^ The number of unique clicks for emails sent for this sender+  } deriving Show++makeLenses ''UsersSendersResponse+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersSendersResponse

@@ -0,0 +1,17 @@++module Network.API.Mandrill.Utils where++import Data.Char++--------------------------------------------------------------------------------+-- | Turns camelCase strings into suitable dashified ones.+-- >>> modRejectReason "TestModeLimit"+--     "test-mode-limit"+modRejectReason :: String -> String+modRejectReason [] = []+modRejectReason (x:xs) = toLower x : go xs+  where+    go [] = []+    go (y:ys) = case isUpper y of+      False -> y : go ys+      True  -> '-' : toLower y : go ys

@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import           System.Environment+import           Data.Monoid+import           Tests+import           Online+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Tasty.QuickCheck+import qualified Data.Text as T++----------------------------------------------------------------------+withQuickCheckDepth :: TestName -> Int -> [TestTree] -> TestTree+withQuickCheckDepth tn depth tests =+  localOption (QuickCheckTests depth) (testGroup tn tests)++----------------------------------------------------------------------+onlineTestsIfEnabled :: IO [TestTree]+onlineTestsIfEnabled = do+  apiKey <- (return . fmap T.pack) =<< lookupEnv "MANDRILL_API_KEY"+  case apiKey of+    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)+                 ]]++----------------------------------------------------------------------+main :: IO ()+main = do+  onlineTests <- onlineTestsIfEnabled+  defaultMainWithIngredients defaultIngredients $+    testGroup "Mandrill tests" $ onlineTests <> [+         testGroup "Mandrill offline tests" [+           testCase "users/info.json API parsing"    testUsersInfo+         , testCase "users/senders.json API parsing" testUsersSenders+         , testCase "messages/send.json API parsing" testMessagesSend+         ]+     ]

@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+module Online where++import           Test.QuickCheck+import           Test.Tasty.HUnit+import           Text.RawString.QQ+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           Network.API.Mandrill.Types+import qualified Network.API.Mandrill.Messages as API+import qualified Network.API.Mandrill.Users as API++--+-- Users calls+--+testOnlineUsersInfo :: MandrillKey -> Assertion+testOnlineUsersInfo k = do+  res <- API.info k+  case res of+    MandrillSuccess _ -> return ()+    MandrillFailure e -> fail $ "users/info.json " ++ show e++testOnlineUsersPing2 :: MandrillKey -> Assertion+testOnlineUsersPing2 k = do+  res <- API.ping2 k+  case res of+    MandrillSuccess _ -> return ()+    MandrillFailure e -> fail $ "users/ping2.json " ++ show e++testOnlineUsersSenders :: MandrillKey -> Assertion+testOnlineUsersSenders k = do+  res <- API.senders k+  case res of+    MandrillSuccess _ -> return ()+    MandrillFailure e -> fail $ "users/senders.json " ++ show e+++--+-- Messages calls+--+testOnlineMessagesSend :: MandrillKey -> Assertion+testOnlineMessagesSend k = do+  msg <- generate arbitrary+  res <- API.send k msg Nothing Nothing Nothing+  case res of+    MandrillSuccess _ -> return ()+    MandrillFailure e -> fail $ "messages/send.json " ++ show e

@@ -0,0 +1,202 @@+{-# LANGUAGE QuasiQuotes #-}+module RawData where++import Test.QuickCheck+import Test.Tasty.HUnit+import Text.RawString.QQ+import Data.Either++usersInfoData :: String+usersInfoData = [r|+{+    "username": "foo@bar.com",+    "created_at": "2014-03-27 09:42:20.62599",+    "public_id": "barbaz",+    "reputation": 99,+    "hourly_quota": 1094,+    "backlog": 0,+    "stats": {+        "today": {+            "sent": 102,+            "hard_bounces": 0,+            "soft_bounces": 0,+            "rejects": 0,+            "complaints": 0,+            "unsubs": 0,+            "opens": 71,+            "unique_opens": 52,+            "clicks": 25,+            "unique_clicks": 19+        },+        "last_7_days": {+            "sent": 396,+            "hard_bounces": 0,+            "soft_bounces": 1,+            "rejects": 0,+            "complaints": 0,+            "unsubs": 0,+            "opens": 321,+            "unique_opens": 209,+            "clicks": 147,+            "unique_clicks": 84+        },+        "last_30_days": {+            "sent": 3022,+            "hard_bounces": 3,+            "soft_bounces": 4,+            "rejects": 0,+            "complaints": 0,+            "unsubs": 0,+            "opens": 2408,+            "unique_opens": 1540,+            "clicks": 958,+            "unique_clicks": 578+        },+        "last_60_days": {+            "sent": 6120,+            "hard_bounces": 5,+            "soft_bounces": 4,+            "rejects": 0,+            "complaints": 0,+            "unsubs": 0,+            "opens": 4869,+            "unique_opens": 3112,+            "clicks": 2004,+            "unique_clicks": 1223+        },+        "last_90_days": {+            "sent": 9267,+            "hard_bounces": 6,+            "soft_bounces": 4,+            "rejects": 1,+            "complaints": 1,+            "unsubs": 0,+            "opens": 7428,+            "unique_opens": 4772,+            "clicks": 2943,+            "unique_clicks": 1802+        },+        "all_time": {+            "sent": 15278,+            "hard_bounces": 7,+            "soft_bounces": 7,+            "rejects": 1,+            "complaints": 1,+            "unsubs": 0,+            "opens": 12782,+            "unique_opens": 7926,+            "clicks": 5336,+            "unique_clicks": 3341+        }+    }+}+|]++usersSendersData :: String+usersSendersData = [r|+{+    "address": "sender.example@mandrillapp.com",+    "created_at": "2014-08-12 20:49:42.8344",+    "sent": 42,+    "hard_bounces": 42,+    "soft_bounces": 42,+    "rejects": 42,+    "complaints": 42,+    "unsubs": 42,+    "opens": 42,+    "clicks": 42,+    "unique_opens": 42,+    "unique_clicks": 42+}+|]++sendData :: String+sendData = [r|+{+    "key": "example key",+    "message": {+        "html": "<p>Example HTML content</p>",+        "text": "Example text content",+        "subject": "example subject",+        "from_email": "message.from_email@example.com",+        "from_name": "Example Name",+        "to": [+            {+                "email": "recipient.email@example.com",+                "name": "Recipient Name",+                "type": "to"+            }+        ],+        "headers": {+            "Reply-To": "message.reply@example.com"+        },+        "important": false,+        "track_opens": null,+        "track_clicks": null,+        "auto_text": null,+        "auto_html": null,+        "inline_css": null,+        "url_strip_qs": null,+        "preserve_recipients": null,+        "view_content_link": null,+        "bcc_address": "message.bcc_address@example.com",+        "tracking_domain": null,+        "signing_domain": null,+        "return_path_domain": null,+        "merge": true,+        "global_merge_vars": [+            {+                "name": "merge1",+                "content": "merge1 content"+            }+        ],+        "merge_vars": [+            {+                "rcpt": "recipient.email@example.com",+                "vars": [+                    {+                        "name": "merge2",+                        "content": "merge2 content"+                    }+                ]+            }+        ],+        "tags": [+            "password-resets"+        ],+        "subaccount": "customer-123",+        "google_analytics_domains": [+            "example.com"+        ],+        "google_analytics_campaign": "message.from_email@example.com",+        "metadata": {+            "website": "www.example.com"+        },+        "recipient_metadata": [+            {+                "rcpt": "recipient.email@example.com",+                "values": {+                    "user_id": 123456+                }+            }+        ],+        "attachments": [+            {+                "type": "text/plain",+                "name": "myfile.txt",+                "content": "ZXhhbXBsZSBmaWxl"+            }+        ],+        "images": [+            {+                "type": "image/png",+                "name": "IMAGECID",+                "content": "ZXhhbXBsZSBmaWxl"+            }+        ]+    },+    "async": false,+    "ip_pool": "Main Pool",+    "send_at": "2014-08-17T14:23:02.954Z"+}+|]

@@ -0,0 +1,42 @@+{-# 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++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 706+isRight :: Either a b -> Bool+isRight (Left _) = False+isRight _ = True+#endif++testMessagesSend :: Assertion+testMessagesSend = +  assertBool ("send.json: Parsing failed! " ++ show parsePayload)+             (isRight parsePayload)+  where+    parsePayload :: Either String MessagesSendRq+    parsePayload = eitherDecodeStrict . C8.pack $ sendData++testUsersInfo :: Assertion+testUsersInfo = do+  let res = parsePayload+  assertBool ("users/info.json (response): Parsing failed: " ++ show res)+             (isRight parsePayload)+  where+    parsePayload :: Either String UsersInfoResponse+    parsePayload = eitherDecodeStrict . C8.pack $ usersInfoData++testUsersSenders :: Assertion+testUsersSenders = do+  let res = parsePayload+  assertBool ("users/senders.json (response): Parsing failed: " ++ show res)+             (isRight parsePayload)+  where+    parsePayload :: Either String UsersSendersResponse+    parsePayload = eitherDecodeStrict . C8.pack $ usersSendersData