d05237b · typeable/mandrill

mandrill.cabal+5−4

compare with master

unifiedsplit

@@ -1,5 +1,5 @@

1name: mandrill

2−version: 0.1.0.3

2+version: 0.1.1.0

3synopsis: Library for interfacing with the Mandrill JSON API

4description: Pure Haskell client for the Mandrill JSON API

5license: MIT

@@ -36,10 +36,11 @@ library

36 , bytestring >= 0.9.0

37 , base64-bytestring >= 1.0.0.1

38 , text >= 1.0.0.0 && < 1.3

39− , wreq >= 0.1.0.1

39+ , http-types >= 0.8.0

40+ , http-client >= 0.3.0

41+ , http-client-tls >= 0.2.0.0

40 , aeson >= 0.7.0.3 && < 0.9

42 , aeson >= 0.7.0.3 && < 0.9

41− -- Until wreq 0.3.0.0 won't be out we need lens 4.4

42− , lens == 4.4

43+ , lens >= 4.0

43 , blaze-html >= 0.5.0.0

44 , blaze-html >= 0.5.0.0

44 , QuickCheck >= 2.6 && < 2.8

45 , QuickCheck >= 2.6 && < 2.8

45 , mtl < 3.0

46 , mtl < 3.0

src/Network/API/Mandrill.hs+4−4

@@ -136,8 +136,8 @@ sendEmail :: MonadIO m

136 => MandrillMessage

137 -> MandrillT m (MandrillResponse [MessagesResponse])

138sendEmail msg = do

139− key <- ask

139+ (key, mgr) <- ask

140− liftIO $ send key msg (Just True) Nothing Nothing

140+ liftIO $ send key msg (Just True) Nothing Nothing (Just mgr)

141

142

143--------------------------------------------------------------------------------

@@ -145,6 +145,6 @@ sendTextEmail :: MonadIO m

145 => MandrillMessage

146 -> MandrillT m (MandrillResponse [MessagesResponse])

147sendTextEmail msg = do

148− key <- ask

148+ (key, mgr) <- ask

149 now <- liftIO getCurrentTime

150− liftIO $ send key msg (Just True) Nothing (Just now)

150+ liftIO $ send key msg (Just True) Nothing (Just now) (Just mgr)

src/Network/API/Mandrill/HTTP.hs+19−5

@@ -6,14 +6,28 @@ import Network.API.Mandrill.Types

6import qualified Data.Text as T

7import Data.Monoid

8import Data.Aeson

9−import Network.Wreq

9+import Control.Applicative

10−import Control.Lens

10+import Network.HTTP.Types

11+import Network.HTTP.Client

12+import Network.HTTP.Client.TLS

11

13

12toMandrillResponse :: (MandrillEndpoint ep, FromJSON a, ToJSON rq)

14toMandrillResponse :: (MandrillEndpoint ep, FromJSON a, ToJSON rq)

13 => ep

15 => ep

14 -> rq

16 -> rq

17+ -> Maybe Manager

15 -> IO (MandrillResponse a)

18 -> IO (MandrillResponse a)

16−toMandrillResponse ep rq = do

19+toMandrillResponse ep rq mbMgr = do

17 let fullUrl = mandrillUrl <> toUrl ep

20 let fullUrl = mandrillUrl <> toUrl ep

18− res <- asJSON =<< post (T.unpack fullUrl) (toJSON rq)

21+ rq' <- parseUrl (T.unpack fullUrl)

22+ let headers = [(hContentType, "application/json")]

23+ let jsonBody = encode rq

24+ let req = rq' {

25+ method = "POST"

26+ , requestHeaders = headers

27+ , requestBody = RequestBodyLBS jsonBody

28+ }

29+ mgr <- maybe (newManager tlsManagerSettings) return mbMgr

19− return $ res ^. responseBody

30+ res <- responseBody <$> httpLbs req mgr

31+ case eitherDecode res of

32+ Left e -> fail e

33+ Right v -> return v

src/Network/API/Mandrill/Messages.hs+3−2

@@ -5,6 +5,7 @@ import Network.API.Mandrill.Types

5import Network.API.Mandrill.Messages.Types

6import Network.API.Mandrill.Settings

7import Network.API.Mandrill.HTTP

8+import Network.HTTP.Client

8import Data.Time

9import Data.Time

9import qualified Data.Text as T

10import qualified Data.Text as T

10

11

@@ -20,6 +21,6 @@ send :: MandrillKey

20 -- ^ ip_pool

21 -- ^ ip_pool

21 -> Maybe UTCTime

22 -> Maybe UTCTime

22 -- ^ send_at

23 -- ^ send_at

24+ -> Maybe Manager

23 -> IO (MandrillResponse [MessagesResponse])

25 -> IO (MandrillResponse [MessagesResponse])

24−send k msg async ip_pool send_at =

25− toMandrillResponse MessagesSend (MessagesSendRq k msg async ip_pool send_at)

26+send k msg async ip_pool send_at = toMandrillResponse MessagesSend (MessagesSendRq k msg async ip_pool send_at)

src/Network/API/Mandrill/Trans.hs+7−3

@@ -4,12 +4,14 @@ module Network.API.Mandrill.Trans where

4import Control.Monad.Reader

5import Control.Applicative

6import Network.API.Mandrill.Types

7+import Network.HTTP.Client

8+import Network.HTTP.Client.TLS

7

9

8

10

9--------------------------------------------------------------------------------

11--------------------------------------------------------------------------------

10newtype MandrillT m a = MandrillT {

12newtype MandrillT m a = MandrillT {

11− runMandrillT :: ReaderT MandrillKey m a

13+ runMandrillT :: ReaderT (MandrillKey, Manager) m a

12− } deriving (MonadTrans, MonadReader MandrillKey,

14+ } deriving (MonadTrans, MonadReader (MandrillKey, Manager),

13 Functor, Applicative, Monad, MonadIO)

15 Functor, Applicative, Monad, MonadIO)

14

16

15

17

@@ -22,4 +24,6 @@ runMandrill :: MonadIO m

22 => MandrillKey

24 => MandrillKey

23 -> MandrillT m a

25 -> MandrillT m a

24 -> m a

26 -> m a

27+runMandrill key action = do

28+ mgr <- liftIO $ newManager tlsManagerSettings

25−runMandrill key action = runReaderT (runMandrillT action) key

29+ runReaderT (runMandrillT action) (key, mgr)

src/Network/API/Mandrill/Users.hs+6−6

@@ -5,28 +5,28 @@ import Network.API.Mandrill.Settings

5import Network.API.Mandrill.HTTP

6import Network.API.Mandrill.Types

7import Network.API.Mandrill.Users.Types

8−import Data.Aeson

8+import Network.HTTP.Client

9

10

11--------------------------------------------------------------------------------

12-- | Return the information about the API-connected user

13−info :: MandrillKey -> IO (MandrillResponse UsersInfoResponse)

13+info :: MandrillKey -> Maybe Manager -> IO (MandrillResponse UsersInfoResponse)

14info key = toMandrillResponse UsersInfo (UsersRq key)

15

16

17--------------------------------------------------------------------------------

18-- | Validate an API key and respond to a ping

19−ping :: MandrillKey -> IO (MandrillResponse UsersPingResponse)

19+ping :: MandrillKey -> Maybe Manager -> IO (MandrillResponse UsersPingResponse)

20−ping _ = fail "users/ping.json doesn't return valid JSON, thus is not implemented yet."

20+ping _ _ = fail "users/ping.json doesn't return valid JSON, thus is not implemented yet."

21

22

23--------------------------------------------------------------------------------

24-- | Validate an API key and respond to a ping (anal JSON parser version)

25−ping2 :: MandrillKey -> IO (MandrillResponse UsersPing2Response)

25+ping2 :: MandrillKey -> Maybe Manager -> IO (MandrillResponse UsersPing2Response)

26ping2 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 [UsersSendersResponse])

31+senders :: MandrillKey -> Maybe Manager -> IO (MandrillResponse [UsersSendersResponse])

32senders key = toMandrillResponse UsersSenders (UsersRq key)

test/Online.hs+4−4

@@ -20,21 +20,21 @@ import qualified Network.API.Mandrill.Users as API

20--

21testOnlineUsersInfo :: MandrillKey -> Assertion

22testOnlineUsersInfo k = do

23− res <- API.info k

23+ res <- API.info k Nothing

24 case res of

25 MandrillSuccess _ -> return ()

26 MandrillFailure e -> fail $ "users/info.json " ++ show e

27

28testOnlineUsersPing2 :: MandrillKey -> Assertion

29testOnlineUsersPing2 k = do

30− res <- API.ping2 k

30+ res <- API.ping2 k Nothing

31 case res of

32 MandrillSuccess _ -> return ()

33 MandrillFailure e -> fail $ "users/ping2.json " ++ show e

34

35testOnlineUsersSenders :: MandrillKey -> Assertion

36testOnlineUsersSenders k = do

37− res <- API.senders k

37+ res <- API.senders k Nothing

38 case res of

39 MandrillSuccess _ -> return ()

40 MandrillFailure e -> fail $ "users/senders.json " ++ show e

@@ -46,7 +46,7 @@ testOnlineUsersSenders k = do

46testOnlineMessagesSend :: MandrillKey -> Assertion

47testOnlineMessagesSend k = do

48 msg <- generate arbitrary

49− res <- API.send k msg Nothing Nothing Nothing

49+ res <- API.send k msg Nothing Nothing Nothing Nothing

50 case res of

51 MandrillSuccess _ -> return ()

52 MandrillFailure e -> fail $ "messages/send.json " ++ show e