git.iko.soy/typeable/mandrill
on master help sign in
Wrapped users calls
f3ef3d0Alfredo Di Napoli
README.md+6−2
compare with master
unifiedsplit
@@ -8,9 +8,13 @@ the [Mandrill](http://mandrillapp.com) transactional email service.
8# Supported API versions
8# Supported API versions
9
9
10* 1.0 (partially)
10* 1.0 (partially)
11− - [Users call](https://mandrillapp.com/api/docs/users.JSON.html)
11+ - [Users call](https://mandrillapp.com/api/docs/users.JSON.html) - 100%
12+ + info.json
13+ + ~~ping.json~~ (as **doesn't return valid json!**)
14+ + ping2.json
15+ + senders.json
12 - [Messages call](https://mandrillapp.com/api/docs/messages.JSON.html)
16 - [Messages call](https://mandrillapp.com/api/docs/messages.JSON.html)
13− + send
17+ + send.json
14
18
15# Testing online API
19# Testing online API
16
20
src/Network/API/Mandrill/Messages.hs+1−1
@@ -20,6 +20,6 @@ send :: MandrillKey
20 -- ^ ip_pool
20 -- ^ ip_pool
21 -> Maybe UTCTime
21 -> Maybe UTCTime
22 -- ^ send_at
22 -- ^ send_at
23− -> IO (MandrillResponse MessagesResponse)
23+ -> IO (MandrillResponse [MessagesResponse])
24send k msg async ip_pool send_at =
24send k msg async ip_pool send_at =
25 toMandrillResponse MessagesSend (MessagesSendRq k msg async ip_pool send_at)
25 toMandrillResponse MessagesSend (MessagesSendRq k msg async ip_pool send_at)
src/Network/API/Mandrill/Types.hs+7−7
@@ -64,17 +64,17 @@ deriveJSON defaultOptions {
64-- | The main datatypes which models the response from the Mandrill API,
64-- | The main datatypes which models the response from the Mandrill API,
65-- which can be either a success or a failure.
65-- which can be either a success or a failure.
66data MandrillResponse k =
66data MandrillResponse k =
67− MandrillSuccess [k]
67+ MandrillSuccess k
68 | MandrillFailure MandrillError deriving Show
68 | MandrillFailure MandrillError deriving Show
69
69
70instance FromJSON k => FromJSON (MandrillResponse k) where
70instance FromJSON k => FromJSON (MandrillResponse k) where
71− parseJSON a@(Array _) = case (parseMaybe parseJSON a) :: Maybe [k] of
71+ parseJSON v = case (parseMaybe parseJSON v) :: Maybe k of
72 Just r -> return $ MandrillSuccess r
72 Just r -> return $ MandrillSuccess r
73− Nothing -> fail $ show a <> " is not a valid MandrillSuccess"
73+ Nothing -> do
74+ -- try to parse it as an error
74− parseJSON o@(Object _) = case (parseMaybe parseJSON o) :: Maybe MandrillError of
75+ case (parseMaybe parseJSON v) :: Maybe MandrillError of
75− Just e -> return $ MandrillFailure e
76+ Just e -> return $ MandrillFailure e
76− Nothing -> fail $ show o <> " is not a valid MandrillError"
77+ Nothing -> fail $ show v <> " is neither a MandrillSuccess or a MandrillError."
77− parseJSON v = typeMismatch "Expected an Object or an Array for MandrillResponse" v
78
78
79
79
80--------------------------------------------------------------------------------
80--------------------------------------------------------------------------------
src/Network/API/Mandrill/Users.hs+5−5
@@ -10,23 +10,23 @@ import Data.Aeson
10
10
11--------------------------------------------------------------------------------
11--------------------------------------------------------------------------------
12-- | Return the information about the API-connected user
12-- | Return the information about the API-connected user
13−info :: MandrillKey -> IO (MandrillResponse UsersResponse)
13+info :: MandrillKey -> IO (MandrillResponse UsersInfoResponse)
14info key = toMandrillResponse UsersInfo (UsersRq key)
14info key = toMandrillResponse UsersInfo (UsersRq key)
15
15
16
16
17--------------------------------------------------------------------------------
17--------------------------------------------------------------------------------
18-- | Validate an API key and respond to a ping
18-- | Validate an API key and respond to a ping
19−ping :: MandrillKey -> IO (MandrillResponse UsersResponse)
19+ping :: MandrillKey -> IO (MandrillResponse UsersPingResponse)
20−ping key = toMandrillResponse UsersPing (UsersRq key)
20+ping _ = fail "users/ping.json doesn't return valid JSON, thus is not implemented yet."
21
21
22
22
23--------------------------------------------------------------------------------
23--------------------------------------------------------------------------------
24-- | Validate an API key and respond to a ping (anal JSON parser version)
24-- | Validate an API key and respond to a ping (anal JSON parser version)
25−ping2 :: MandrillKey -> IO (MandrillResponse UsersResponse)
25+ping2 :: MandrillKey -> IO (MandrillResponse UsersPing2Response)
26ping2 key = toMandrillResponse UsersPing2 (UsersRq key)
26ping2 key = toMandrillResponse UsersPing2 (UsersRq key)
27
27
28
28
29--------------------------------------------------------------------------------
29--------------------------------------------------------------------------------
30-- | Return the senders that have tried to use this account, both verified and unverified
30-- | Return the senders that have tried to use this account, both verified and unverified
31−senders :: MandrillKey -> IO (MandrillResponse UsersResponse)
31+senders :: MandrillKey -> IO (MandrillResponse [UsersSendersResponse])
32senders key = toMandrillResponse UsersSenders (UsersRq key)
32senders key = toMandrillResponse UsersSenders (UsersRq key)
src/Network/API/Mandrill/Users/Types.hs+68−4
@@ -14,16 +14,80 @@ import Data.Aeson.TH
14
14
15import Network.API.Mandrill.Types
15import Network.API.Mandrill.Types
16
16
17+
17--------------------------------------------------------------------------------
18--------------------------------------------------------------------------------
18data UsersRq = UsersRq {
19data UsersRq = UsersRq {
19− _ureq_key :: MandrillKey
20+ _ureq_key :: !MandrillKey
20 } deriving Show
21 } deriving Show
21
22
22makeLenses ''UsersRq
23makeLenses ''UsersRq
23deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersRq
24deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersRq
24
25
25--------------------------------------------------------------------------------
26--------------------------------------------------------------------------------
26−data UsersResponse = UsersResponse {
27+data MandrillStats = MandrillStats {
28+ _msts_sent :: Int
29+ , _msts_hard_bounces :: Int
30+ , _msts_soft_bounces :: Int
31+ , _msts_rejects :: Int
32+ , _msts_complaints :: Int
33+ , _msts_unsubs :: Int
34+ , _msts_opens :: Int
35+ , _msts_unique_opens :: Int
36+ , _msts_clicks :: Int
37+ , _msts_unique_clicks :: Int
38+ } deriving Show
39+
40+makeLenses ''MandrillStats
41+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillStats
42+
43+--------------------------------------------------------------------------------
44+data UserStats = UserStats {
45+ _usts_today :: MandrillStats
46+ , _usts_last_7_days :: MandrillStats
47+ , _usts_last_30_days :: MandrillStats
48+ , _usts_last_60_days :: MandrillStats
49+ , _usts_last_90_days :: MandrillStats
50+ , _usts_all_time :: MandrillStats
51+ } deriving Show
52+
53+makeLenses ''UserStats
54+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UserStats
55+
56+--------------------------------------------------------------------------------
57+data UsersInfoResponse = UsersInfoResponse {
58+ _usir_username :: !T.Text
59+ , _usir_created_at :: MandrillDate
60+ , _usir_public_id :: !T.Text
61+ , _usir_reputation :: !Int
62+ , _usir_hourly_quota :: !Int
63+ , _usir_backlog :: !Int
64+ , _usir_stats :: UserStats
65+ } deriving Show
66+
67+makeLenses ''UsersInfoResponse
68+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersInfoResponse
69+
70+
71+--------------------------------------------------------------------------------
72+newtype UsersPingResponse = UsersPingResponse T.Text deriving Show
73+
74+deriveFromJSON defaultOptions ''UsersPingResponse
75+
76+instance ToJSON UsersPingResponse where
77+ toJSON (UsersPingResponse t) = String t
78+
79+
80+--------------------------------------------------------------------------------
81+data UsersPing2Response = UsersPing2Response {
82+ _usrr_PING :: T.Text
83+ } deriving Show
84+
85+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersPing2Response
86+
87+
88+
89+--------------------------------------------------------------------------------
90+data UsersSendersResponse = UsersResponse {
27 _usrr_address :: !T.Text
91 _usrr_address :: !T.Text
28 -- ^ The sender's email address
92 -- ^ The sender's email address
29 , _usrr_created_at :: MandrillDate
93 , _usrr_created_at :: MandrillDate
@@ -54,5 +118,5 @@ data UsersResponse = UsersResponse {
54 -- ^ The number of unique clicks for emails sent for this sender
118 -- ^ The number of unique clicks for emails sent for this sender
55 } deriving Show
119 } deriving Show
56
120
57−makeLenses ''UsersResponse
121+makeLenses ''UsersSendersResponse
58−deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersResponse
122+deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''UsersSendersResponse
test/Main.hs+9−5
@@ -23,7 +23,10 @@ onlineTestsIfEnabled = do
23 Nothing -> return []
23 Nothing -> return []
24 Just k -> return [
24 Just k -> return [
25 testGroup "Mandrill online tests" [
25 testGroup "Mandrill online tests" [
26+ testCase "users/info.json" (testOnlineUsersInfo k)
27+ , testCase "users/ping2.json" (testOnlineUsersPing2 k)
28+ , testCase "users/senders.json" (testOnlineUsersSenders k)
26− testCase "messages/send.json" (testOnlineMessagesSend k)
29+ , testCase "messages/send.json" (testOnlineMessagesSend k)
27 ]]
30 ]]
28
31
29----------------------------------------------------------------------
32----------------------------------------------------------------------
@@ -33,7 +36,8 @@ main = do
33 defaultMainWithIngredients defaultIngredients $
36 defaultMainWithIngredients defaultIngredients $
34 testGroup "Mandrill tests" $ onlineTests <> [
37 testGroup "Mandrill tests" $ onlineTests <> [
35 testGroup "Mandrill offline tests" [
38 testGroup "Mandrill offline tests" [
36− testCase "users/info.json API parsing" testUsersInfo
39+ testCase "users/info.json API parsing" testUsersInfo
40+ , testCase "users/senders.json API parsing" testUsersSenders
37− , testCase "messages/send.json API parsing" testMessagesSend
41+ , testCase "messages/send.json API parsing" testMessagesSend
38− ]
42+ ]
39− ]
43+ ]
test/Online.hs+28
@@ -13,8 +13,36 @@ import RawData
13
13
14import Network.API.Mandrill.Types
14import Network.API.Mandrill.Types
15import qualified Network.API.Mandrill.Messages as API
15import qualified Network.API.Mandrill.Messages as API
16+import qualified Network.API.Mandrill.Users as API
17+
18+--
19+-- Users calls
20+--
21+testOnlineUsersInfo :: MandrillKey -> Assertion
22+testOnlineUsersInfo k = do
23+ res <- API.info k
24+ case res of
25+ MandrillSuccess _ -> return ()
26+ MandrillFailure e -> fail $ "users/info.json " ++ show e
27+
28+testOnlineUsersPing2 :: MandrillKey -> Assertion
29+testOnlineUsersPing2 k = do
30+ res <- API.ping2 k
31+ case res of
32+ MandrillSuccess _ -> return ()
33+ MandrillFailure e -> fail $ "users/ping2.json " ++ show e
34+
35+testOnlineUsersSenders :: MandrillKey -> Assertion
36+testOnlineUsersSenders k = do
37+ res <- API.senders k
38+ case res of
39+ MandrillSuccess _ -> return ()
40+ MandrillFailure e -> fail $ "users/senders.json " ++ show e
16
41
17
42
43+--
44+-- Messages calls
45+--
18testOnlineMessagesSend :: MandrillKey -> Assertion
46testOnlineMessagesSend :: MandrillKey -> Assertion
19testOnlineMessagesSend k = do
47testOnlineMessagesSend k = do
20 msg <- generate arbitrary
48 msg <- generate arbitrary
test/RawData.hs+86
@@ -8,6 +8,92 @@ import Data.Either
8
8
9usersInfoData :: String
9usersInfoData :: String
10usersInfoData = [r|
10usersInfoData = [r|
11+{
12+ "username": "foo@bar.com",
13+ "created_at": "2014-03-27 09:42:20.62599",
14+ "public_id": "barbaz",
15+ "reputation": 99,
16+ "hourly_quota": 1094,
17+ "backlog": 0,
18+ "stats": {
19+ "today": {
20+ "sent": 102,
21+ "hard_bounces": 0,
22+ "soft_bounces": 0,
23+ "rejects": 0,
24+ "complaints": 0,
25+ "unsubs": 0,
26+ "opens": 71,
27+ "unique_opens": 52,
28+ "clicks": 25,
29+ "unique_clicks": 19
30+ },
31+ "last_7_days": {
32+ "sent": 396,
33+ "hard_bounces": 0,
34+ "soft_bounces": 1,
35+ "rejects": 0,
36+ "complaints": 0,
37+ "unsubs": 0,
38+ "opens": 321,
39+ "unique_opens": 209,
40+ "clicks": 147,
41+ "unique_clicks": 84
42+ },
43+ "last_30_days": {
44+ "sent": 3022,
45+ "hard_bounces": 3,
46+ "soft_bounces": 4,
47+ "rejects": 0,
48+ "complaints": 0,
49+ "unsubs": 0,
50+ "opens": 2408,
51+ "unique_opens": 1540,
52+ "clicks": 958,
53+ "unique_clicks": 578
54+ },
55+ "last_60_days": {
56+ "sent": 6120,
57+ "hard_bounces": 5,
58+ "soft_bounces": 4,
59+ "rejects": 0,
60+ "complaints": 0,
61+ "unsubs": 0,
62+ "opens": 4869,
63+ "unique_opens": 3112,
64+ "clicks": 2004,
65+ "unique_clicks": 1223
66+ },
67+ "last_90_days": {
68+ "sent": 9267,
69+ "hard_bounces": 6,
70+ "soft_bounces": 4,
71+ "rejects": 1,
72+ "complaints": 1,
73+ "unsubs": 0,
74+ "opens": 7428,
75+ "unique_opens": 4772,
76+ "clicks": 2943,
77+ "unique_clicks": 1802
78+ },
79+ "all_time": {
80+ "sent": 15278,
81+ "hard_bounces": 7,
82+ "soft_bounces": 7,
83+ "rejects": 1,
84+ "complaints": 1,
85+ "unsubs": 0,
86+ "opens": 12782,
87+ "unique_opens": 7926,
88+ "clicks": 5336,
89+ "unique_clicks": 3341
90+ }
91+ }
92+}
93+|]
94+
95+usersSendersData :: String
96+usersSendersData = [r|
11{
97{
12 "address": "sender.example@mandrillapp.com",
98 "address": "sender.example@mandrillapp.com",
13 "created_at": "2014-08-12 20:49:42.8344",
99 "created_at": "2014-08-12 20:49:42.8344",
test/Tests.hs+11−2
@@ -26,8 +26,17 @@ testMessagesSend = assertBool "send.json: Parsing failed!" (isRight parsePayload
26testUsersInfo :: Assertion
26testUsersInfo :: Assertion
27testUsersInfo = do
27testUsersInfo = do
28 let res = parsePayload
28 let res = parsePayload
29− assertBool ("users.json (response): Parsing failed: " ++ show res)
29+ assertBool ("users/info.json (response): Parsing failed: " ++ show res)
30 (isRight parsePayload)
30 (isRight parsePayload)
31 where
31 where
32− parsePayload :: Either String UsersResponse
32+ parsePayload :: Either String UsersInfoResponse
33 parsePayload = eitherDecodeStrict . C8.pack $ usersInfoData
33 parsePayload = eitherDecodeStrict . C8.pack $ usersInfoData
34+
35+testUsersSenders :: Assertion
36+testUsersSenders = do
37+ let res = parsePayload
38+ assertBool ("users/senders.json (response): Parsing failed: " ++ show res)
39+ (isRight parsePayload)
40+ where
41+ parsePayload :: Either String UsersSendersResponse
42+ parsePayload = eitherDecodeStrict . C8.pack $ usersSendersData