git.iko.soy/typeable/mandrill
on master help sign in
Users calls stubs and tests
48cf53cAlfredo Di Napoli
mandrill.cabal+11−2
compare with master
unifiedsplit
@@ -17,12 +17,14 @@ source-repository head
17library
17library
18 exposed-modules:
18 exposed-modules:
19 Network.API.Mandrill.Settings
19 Network.API.Mandrill.Settings
20+ Network.API.Mandrill.Types
20 Network.API.Mandrill.Users
21 Network.API.Mandrill.Users
22+ Network.API.Mandrill.Users.Types
21 Network.API.Mandrill.Messages
23 Network.API.Mandrill.Messages
22− Network.API.Mandrill.Types
24+ Network.API.Mandrill.Messages.Types
23− Network.API.Mandrill.HTTP
24 other-modules:
25 other-modules:
25 Network.API.Mandrill.Utils
26 Network.API.Mandrill.Utils
27+ Network.API.Mandrill.HTTP
26 -- other-extensions:
28 -- other-extensions:
27 build-depends:
29 build-depends:
28 base >=4.6 && < 5
30 base >=4.6 && < 5
@@ -32,10 +34,13 @@ library
32 , lens >= 4.1 && < 4.6
34 , lens >= 4.1 && < 4.6
33 , blaze-html >= 0.5.0.0
35 , blaze-html >= 0.5.0.0
34 , time
36 , time
37+ , old-locale
35 hs-source-dirs:
38 hs-source-dirs:
36 src
39 src
37 default-language:
40 default-language:
38 Haskell2010
41 Haskell2010
42+ ghc-options:
43+ -funbox-strict-fields
39
44
40test-suite mandrill-tests
45test-suite mandrill-tests
41 type:
46 type:
@@ -44,6 +49,7 @@ test-suite mandrill-tests
44 Main.hs
49 Main.hs
45 other-modules:
50 other-modules:
46 Tests
51 Tests
52+ RawData
47 hs-source-dirs:
53 hs-source-dirs:
48 test
54 test
49 default-language:
55 default-language:
@@ -51,7 +57,10 @@ test-suite mandrill-tests
51 build-depends:
57 build-depends:
52 mandrill -any
58 mandrill -any
53 , base
59 , base
60+ , aeson
61+ , bytestring
54 , QuickCheck >= 2.6 && < 2.8
62 , QuickCheck >= 2.6 && < 2.8
55 , tasty >= 0.7 && < 0.9
63 , tasty >= 0.7 && < 0.9
56 , tasty-quickcheck
64 , tasty-quickcheck
57 , tasty-hunit
65 , tasty-hunit
66+ , raw-strings-qq < 1.2
src/Network/API/Mandrill/HTTP.hs+2−2
@@ -9,10 +9,10 @@ import Data.Aeson
9import Network.Wreq
9import Network.Wreq
10import Control.Lens
10import Control.Lens
11
11
12−toMandrillResponse :: (MandrillEndpoint ep, ToJSON rq)
12+toMandrillResponse :: (MandrillEndpoint ep, FromJSON a, ToJSON rq)
13 => ep
13 => ep
14 -> rq
14 -> rq
15− -> IO MandrillResponse
15+ -> IO (MandrillResponse a)
16toMandrillResponse ep rq = do
16toMandrillResponse ep rq = do
17 let fullUrl = mandrillUrl <> toUrl ep
17 let fullUrl = mandrillUrl <> toUrl ep
18 res <- asJSON =<< post (T.unpack fullUrl) (toJSON rq)
18 res <- asJSON =<< post (T.unpack fullUrl) (toJSON rq)
src/Network/API/Mandrill/Messages.hs+8−2
@@ -2,6 +2,7 @@
2module Network.API.Mandrill.Messages where
2module Network.API.Mandrill.Messages where
3
3
4import Network.API.Mandrill.Types
4import Network.API.Mandrill.Types
5+import Network.API.Mandrill.Messages.Types
5import Network.API.Mandrill.Settings
6import Network.API.Mandrill.Settings
6import Network.API.Mandrill.HTTP
7import Network.API.Mandrill.HTTP
7import Data.Time
8import Data.Time
@@ -10,10 +11,15 @@ import qualified Data.Text as T
10--------------------------------------------------------------------------------
11--------------------------------------------------------------------------------
11-- | Send a new transactional message through Mandrill
12-- | Send a new transactional message through Mandrill
12send :: MandrillKey
13send :: MandrillKey
14+ -- ^ The API key
13 -> MandrillMessage
15 -> MandrillMessage
16+ -- ^ The email message
14 -> Maybe Bool
17 -> Maybe Bool
18+ -- ^ Enable a background sending mode that is optimized for bulk sending
15 -> Maybe T.Text
19 -> Maybe T.Text
20+ -- ^ ip_pool
16 -> Maybe UTCTime
21 -> Maybe UTCTime
22+ -- ^ send_at
17− -> IO MandrillResponse
23+ -> IO (MandrillResponse MessagesResponse)
18send k msg async ip_pool send_at =
24send k msg async ip_pool send_at =
19− toMandrillResponse Send (MandrillSendRq k msg async ip_pool send_at)
25+ toMandrillResponse MessagesSend (MessagesSendRq k msg async ip_pool send_at)
src/Network/API/Mandrill/Messages/Types.hsnew file+44
@@ -0,0 +1,44 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+module Network.API.Mandrill.Messages.Types where
4+
5+import Data.Char
6+import Data.Time
7+import qualified Data.Text as T
8+import Control.Lens
9+import Control.Monad
10+import Data.Monoid
11+import Data.Aeson
12+import Data.Aeson.Types
13+import Data.Aeson.TH
14+
15+import Network.API.Mandrill.Types
16+
17+
18+--------------------------------------------------------------------------------
19+data MessagesSendRq = MessagesSendRq {
20+ _msrq_key :: MandrillKey
21+ , _msrq_message :: MandrillMessage
22+ , _msrq_async :: Maybe Bool
23+ , _msrq_ip_pool :: Maybe T.Text
24+ , _msrq_send_at :: Maybe UTCTime
25+ } deriving Show
26+
27+makeLenses ''MessagesSendRq
28+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MessagesSendRq
29+
30+
31+--------------------------------------------------------------------------------
32+data MessagesResponse = MessagesResponse {
33+ _mres_email :: !T.Text
34+ -- ^ The email address of the recipient
35+ , _mres_status :: MandrillEmailStatus
36+ -- ^ The sending status of the recipient
37+ , _mres_reject_reason :: Maybe MandrillRejectReason
38+ -- ^ The reason for the rejection if the recipient status is "rejected"
39+ , _mres__id :: !T.Text
40+ -- ^ The message's unique id
41+ } deriving Show
42+
43+makeLenses ''MessagesResponse
44+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MessagesResponse
src/Network/API/Mandrill/Settings.hs+16−6
@@ -7,14 +7,24 @@ mandrillUrl :: T.Text
7mandrillUrl = "https://mandrillapp.com/api/1.0/"
7mandrillUrl = "https://mandrillapp.com/api/1.0/"
8
8
9data MandrillCalls =
9data MandrillCalls =
10− Send
10+ -- Users API
11− | SendTemplate
11+ UsersInfo
12+ | UsersPing
13+ | UsersPing2
14+ | UsersSenders
15+ -- Messages API
16+ | MessagesSend
17+ | MessagesSendTemplate
12− | Search deriving Show
18+ | MessagesSearch deriving Show
13
19
14class MandrillEndpoint ep where
20class MandrillEndpoint ep where
15 toUrl :: ep -> T.Text
21 toUrl :: ep -> T.Text
16
22
17instance MandrillEndpoint MandrillCalls where
23instance MandrillEndpoint MandrillCalls where
24+ toUrl UsersInfo = "users/info.json"
25+ toUrl UsersPing = "users/ping.json"
26+ toUrl UsersPing2 = "users/ping2.json"
27+ toUrl UsersSenders = "users/senders.json"
18− toUrl Send = "messages/send.json"
28+ toUrl MessagesSend = "messages/send.json"
19− toUrl SendTemplate = "messages/send-template.json"
29+ toUrl MessagesSendTemplate = "messages/send-template.json"
20− toUrl Search = "messages/search.json"
30+ toUrl MessagesSearch = "messages/search.json"
src/Network/API/Mandrill/Types.hs+18−35
@@ -1,4 +1,5 @@
1{-# LANGUAGE TemplateHaskell #-}
1{-# LANGUAGE TemplateHaskell #-}
2+{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
4module Network.API.Mandrill.Types where
5module Network.API.Mandrill.Types where
@@ -6,6 +7,8 @@ module Network.API.Mandrill.Types where
6import Network.API.Mandrill.Utils
7import Network.API.Mandrill.Utils
7import Data.Char
8import Data.Char
8import Data.Time
9import Data.Time
10+import Control.Applicative
11+import System.Locale (defaultTimeLocale)
9import qualified Data.Text as T
12import qualified Data.Text as T
10import qualified Data.Text.Lazy as TL
13import qualified Data.Text.Lazy as TL
11import Control.Lens
14import Control.Lens
@@ -56,32 +59,17 @@ deriveJSON defaultOptions {
56 } ''MandrillRejectReason
59 } ''MandrillRejectReason
57
60
58
61
59−--------------------------------------------------------------------------------
60−data MandrillResult = MandrillResult {
61− _mres_email :: !T.Text
62− -- ^ The email address of the recipient
63− , _mres_status :: MandrillEmailStatus
64− -- ^ The sending status of the recipient
65− , _mres_reject_reason :: Maybe MandrillRejectReason
66− -- ^ The reason for the rejection if the recipient status is "rejected"
67− , _mres__id :: !T.Text
68− -- ^ The message's unique id
69− } deriving Show
70−
71−makeLenses ''MandrillResult
72−deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillResult
73−
74--------------------------------------------------------------------------------
62--------------------------------------------------------------------------------
75-- | The main datatypes which models the response from the Mandrill API,
63-- | The main datatypes which models the response from the Mandrill API,
76-- which can be either a success or a failure.
64-- which can be either a success or a failure.
77−data MandrillResponse =
65+data MandrillResponse k =
78− MandrillSuccess [MandrillResult]
66+ MandrillSuccess [k]
79 | MandrillFailure MandrillError deriving Show
67 | MandrillFailure MandrillError deriving Show
80
68
81−instance FromJSON MandrillResponse where
69+instance FromJSON k => FromJSON (MandrillResponse k) where
82− parseJSON a@(Array _) = case (parseMaybe parseJSON a) :: Maybe [MandrillResult] of
70+ parseJSON a@(Array _) = case (parseMaybe parseJSON a) :: Maybe [k] of
83 Just r -> return $ MandrillSuccess r
71 Just r -> return $ MandrillSuccess r
84− Nothing -> fail $ show a <> " is not a valid MandrillResult"
72+ Nothing -> fail $ show a <> " is not a valid MandrillSuccess"
85 parseJSON o@(Object _) = case (parseMaybe parseJSON o) :: Maybe MandrillError of
73 parseJSON o@(Object _) = case (parseMaybe parseJSON o) :: Maybe MandrillError of
86 Just e -> return $ MandrillFailure e
74 Just e -> return $ MandrillFailure e
87 Nothing -> fail $ show o <> " is not a valid MandrillError"
75 Nothing -> fail $ show o <> " is not a valid MandrillError"
@@ -151,23 +139,18 @@ makeLenses ''MandrillMessage
151deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillMessage
139deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillMessage
152
140
153
141
154−--------------------------------------------------------------------------------
155−-- * Send payloads
156−--------------------------------------------------------------------------------
157−
158−
159--------------------------------------------------------------------------------
142--------------------------------------------------------------------------------
160type MandrillKey = T.Text
143type MandrillKey = T.Text
161
144
162−
145+newtype MandrillDate = MandrillDate {
163−--------------------------------------------------------------------------------
146+ fromMandrillDate :: UTCTime
164−data MandrillSendRq = MandrillSendRq {
165− _msrq_key :: MandrillKey
166− , _msrq_message :: MandrillMessage
167− , _msrq_async :: Maybe Bool
168− , _msrq_ip_pool :: Maybe T.Text
169− , _msrq_send_at :: Maybe UTCTime
170 } deriving Show
147 } deriving Show
171
148
172−makeLenses ''MandrillSendRq
149+instance ToJSON MandrillDate where
173−deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillSendRq
150+ toJSON = toJSON . fromMandrillDate
151+
152+instance FromJSON MandrillDate where
153+ parseJSON = withText "MandrillDate" $ \t ->
154+ case parseTime defaultTimeLocale "%Y-%m-%d %I:%M:%S%Q" (T.unpack t) of
155+ Just d -> pure $ MandrillDate d
156+ _ -> fail "could not parse Mandrill date"
src/Network/API/Mandrill/Users.hs+26−4
@@ -1,10 +1,32 @@
1
1
2module Network.API.Mandrill.Users where
2module Network.API.Mandrill.Users where
3
3
4−info = undefined
4+import Network.API.Mandrill.Settings
5+import Network.API.Mandrill.HTTP
6+import Network.API.Mandrill.Types
7+import Network.API.Mandrill.Users.Types
8+import Data.Aeson
5
9
6−ping = undefined
7
10
8−ping2 = undefined
11+--------------------------------------------------------------------------------
12+-- | Return the information about the API-connected user
13+info :: MandrillKey -> IO (MandrillResponse UsersResponse)
14+info key = toMandrillResponse UsersInfo (UsersRq key)
9
15
10−senders = undefined
16+
17+--------------------------------------------------------------------------------
18+-- | Validate an API key and respond to a ping
19+ping :: MandrillKey -> IO (MandrillResponse UsersResponse)
20+ping key = toMandrillResponse UsersPing (UsersRq key)
21+
22+
23+--------------------------------------------------------------------------------
24+-- | Validate an API key and respond to a ping (anal JSON parser version)
25+ping2 :: MandrillKey -> IO (MandrillResponse UsersResponse)
26+ping2 key = toMandrillResponse UsersPing2 (UsersRq key)
27+
28+
29+--------------------------------------------------------------------------------
30+-- | Return the senders that have tried to use this account, both verified and unverified
31+senders :: MandrillKey -> IO (MandrillResponse UsersResponse)
32+senders key = toMandrillResponse UsersSenders (UsersRq key)
src/Network/API/Mandrill/Users/Types.hsnew file+58
@@ -0,0 +1,58 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+module Network.API.Mandrill.Users.Types where
4+
5+import Data.Char
6+import Data.Time
7+import qualified Data.Text as T
8+import Control.Lens
9+import Control.Monad
10+import Data.Monoid
11+import Data.Aeson
12+import Data.Aeson.Types
13+import Data.Aeson.TH
14+
15+import Network.API.Mandrill.Types
16+
17+--------------------------------------------------------------------------------
18+data UsersRq = UsersRq {
19+ _ureq_key :: MandrillKey
20+ } deriving Show
21+
22+makeLenses ''UsersRq
23+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersRq
24+
25+--------------------------------------------------------------------------------
26+data UsersResponse = UsersResponse {
27+ _usrr_address :: !T.Text
28+ -- ^ The sender's email address
29+ , _usrr_created_at :: MandrillDate
30+ -- ^ The date and time that the sender was first seen by Mandrill
31+ -- as a UTC date string in YYYY-MM-DD HH:MM:SS format
32+ , _usrr_sent :: !Int
33+ -- ^ The total number of messages sent by this sender
34+ , _usrr_hard_bounces :: !Int
35+ -- ^ The total number of hard bounces by messages by this sender
36+ , _usrr_soft_bounces :: !Int
37+ -- ^ The total number of soft bounces by messages by this sender
38+ , _usrr_rejects :: !Int
39+ -- ^ The total number of rejected messages by this sender
40+ , _usrr_complaints :: !Int
41+ -- ^ The total number of spam complaints received
42+ -- for messages by this sender
43+ , _usrr_unsubs :: !Int
44+ -- ^ The total number of unsubscribe requests received
45+ -- for messages by this sender
46+ , _usrr_opens :: !Int
47+ -- ^ The total number of times messages by this sender have been opened
48+ , _usrr_clicks :: !Int
49+ -- ^ The total number of times tracked URLs in messages
50+ -- by this sender have been clicked
51+ , _usrr_unique_opens :: !Int
52+ -- ^ The number of unique opens for emails sent for this sender
53+ , _usrr_unique_clicks :: !Int
54+ -- ^ The number of unique clicks for emails sent for this sender
55+ } deriving Show
56+
57+makeLenses ''UsersResponse
58+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersResponse
test/Main.hs+2−1
@@ -15,5 +15,6 @@ withQuickCheckDepth tn depth tests =
15main :: IO ()
15main :: IO ()
16main = defaultMainWithIngredients defaultIngredients $
16main = defaultMainWithIngredients defaultIngredients $
17 testGroup "Mandrill tests" [
17 testGroup "Mandrill tests" [
18+ testCase "users/info.json API parsing" testUsersInfo
18− testCase "messages/send.json API parsing" testMessagesSend
19+ , testCase "messages/send.json API parsing" testMessagesSend
19 ]
20 ]
test/RawData.hsnew file+116
@@ -0,0 +1,116 @@
1+{-# LANGUAGE QuasiQuotes #-}
2+module RawData where
3+
4+import Test.QuickCheck
5+import Test.Tasty.HUnit
6+import Text.RawString.QQ
7+import Data.Either
8+
9+usersInfoData :: String
10+usersInfoData = [r|
11+{
12+ "address": "sender.example@mandrillapp.com",
13+ "created_at": "2014-08-12 20:49:42.8344",
14+ "sent": 42,
15+ "hard_bounces": 42,
16+ "soft_bounces": 42,
17+ "rejects": 42,
18+ "complaints": 42,
19+ "unsubs": 42,
20+ "opens": 42,
21+ "clicks": 42,
22+ "unique_opens": 42,
23+ "unique_clicks": 42
24+}
25+|]
26+
27+sendData :: String
28+sendData = [r|
29+{
30+ "key": "example key",
31+ "message": {
32+ "html": "<p>Example HTML content</p>",
33+ "text": "Example text content",
34+ "subject": "example subject",
35+ "from_email": "message.from_email@example.com",
36+ "from_name": "Example Name",
37+ "to": [
38+ {
39+ "email": "recipient.email@example.com",
40+ "name": "Recipient Name",
41+ "type": "to"
42+ }
43+ ],
44+ "headers": {
45+ "Reply-To": "message.reply@example.com"
46+ },
47+ "important": false,
48+ "track_opens": null,
49+ "track_clicks": null,
50+ "auto_text": null,
51+ "auto_html": null,
52+ "inline_css": null,
53+ "url_strip_qs": null,
54+ "preserve_recipients": null,
55+ "view_content_link": null,
56+ "bcc_address": "message.bcc_address@example.com",
57+ "tracking_domain": null,
58+ "signing_domain": null,
59+ "return_path_domain": null,
60+ "merge": true,
61+ "global_merge_vars": [
62+ {
63+ "name": "merge1",
64+ "content": "merge1 content"
65+ }
66+ ],
67+ "merge_vars": [
68+ {
69+ "rcpt": "recipient.email@example.com",
70+ "vars": [
71+ {
72+ "name": "merge2",
73+ "content": "merge2 content"
74+ }
75+ ]
76+ }
77+ ],
78+ "tags": [
79+ "password-resets"
80+ ],
81+ "subaccount": "customer-123",
82+ "google_analytics_domains": [
83+ "example.com"
84+ ],
85+ "google_analytics_campaign": "message.from_email@example.com",
86+ "metadata": {
87+ "website": "www.example.com"
88+ },
89+ "recipient_metadata": [
90+ {
91+ "rcpt": "recipient.email@example.com",
92+ "values": {
93+ "user_id": 123456
94+ }
95+ }
96+ ],
97+ "attachments": [
98+ {
99+ "type": "text/plain",
100+ "name": "myfile.txt",
101+ "content": "ZXhhbXBsZSBmaWxl"
102+ }
103+ ],
104+ "images": [
105+ {
106+ "type": "image/png",
107+ "name": "IMAGECID",
108+ "content": "ZXhhbXBsZSBmaWxl"
109+ }
110+ ]
111+ },
112+ "async": false,
113+ "ip_pool": "Main Pool",
114+ "send_at": "2014-08-17T14:23:02.954Z"
115+}
116+|]
test/Tests.hs+20−3
@@ -1,9 +1,26 @@
1−
2module Tests where
1module Tests where
3
2
4import Test.QuickCheck
3import Test.QuickCheck
5import Test.Tasty.HUnit
4import Test.Tasty.HUnit
6−
5+import Text.RawString.QQ
6+import Data.Either
7+import Data.Aeson
8+import Network.API.Mandrill.Messages.Types
9+import Network.API.Mandrill.Users.Types
10+import qualified Data.ByteString.Char8 as C8
11+import RawData
7
12
8testMessagesSend :: Assertion
13testMessagesSend :: Assertion
9−testMessagesSend = return ()
14+testMessagesSend = assertBool "send.json: Parsing failed!" (isRight parsePayload)
15+ where
16+ parsePayload :: Either String MessagesSendRq
17+ parsePayload = eitherDecodeStrict . C8.pack $ sendData
18+
19+testUsersInfo :: Assertion
20+testUsersInfo = do
21+ let res = parsePayload
22+ assertBool ("users.json (response): Parsing failed: " ++ show res)
23+ (isRight parsePayload)
24+ where
25+ parsePayload :: Either String UsersResponse
26+ parsePayload = eitherDecodeStrict . C8.pack $ usersInfoData