7d14784 · typeable/mandrill

git.iko.soy/typeable/mandrill

Got rid of wreq.

commit7d14784d2bbc5a686882b63bca53da9eac4797c3 authorAlfredo Di Napoli <alfredo.dinapoli@gmail.com> dateSun 7 Dec 2014, 12:11 (12 years ago) parent1d66ba8

7 files changed+48−28

compare with master

unifiedsplit

mandrill.cabal+5−4 src/Network/API/Mandrill.hs+4−4 src/Network/API/Mandrill/HTTP.hs+19−5 src/Network/API/Mandrill/Messages.hs+3−2 src/Network/API/Mandrill/Trans.hs+7−3 src/Network/API/Mandrill/Users.hs+6−6 test/Online.hs+4−4

mandrill.cabal+5−4

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

11name: mandrill

2−version: 0.1.0.3

2+version: 0.1.1.0

33synopsis: Library for interfacing with the Mandrill JSON API

44description: Pure Haskell client for the Mandrill JSON API

55license: MIT

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

3636 , bytestring >= 0.9.0

3737 , base64-bytestring >= 1.0.0.1

3838 , 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

4042 , 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

4344 , blaze-html >= 0.5.0.0

4445 , QuickCheck >= 2.6 && < 2.8

4546 , mtl < 3.0

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

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

136136 => MandrillMessage

137137 -> MandrillT m (MandrillResponse [MessagesResponse])

138138sendEmail msg = do

139− key <- ask

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

139+ (key, mgr) <- ask

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

141141

142142

143143--------------------------------------------------------------------------------

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

145145 => MandrillMessage

146146 -> MandrillT m (MandrillResponse [MessagesResponse])

147147sendTextEmail msg = do

148− key <- ask

148+ (key, mgr) <- ask

149149 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

66import qualified Data.Text as T

77import Data.Monoid

88import Data.Aeson

9−import Network.Wreq

10−import Control.Lens

9+import Control.Applicative

10+import Network.HTTP.Types

11+import Network.HTTP.Client

12+import Network.HTTP.Client.TLS

1113

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

1315 => ep

1416 -> rq

17+ -> Maybe Manager

1518 -> IO (MandrillResponse a)

16−toMandrillResponse ep rq = do

19+toMandrillResponse ep rq mbMgr = do

1720 let fullUrl = mandrillUrl <> toUrl ep

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

19− return $ res ^. responseBody

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

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

55import Network.API.Mandrill.Messages.Types

66import Network.API.Mandrill.Settings

77import Network.API.Mandrill.HTTP

8+import Network.HTTP.Client

89import Data.Time

910import qualified Data.Text as T

1011

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

2021 -- ^ ip_pool

2122 -> Maybe UTCTime

2223 -- ^ send_at

24+ -> Maybe Manager

2325 -> 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

44import Control.Monad.Reader

55import Control.Applicative

66import Network.API.Mandrill.Types

7+import Network.HTTP.Client

8+import Network.HTTP.Client.TLS

810

911--------------------------------------------------------------------------------

1012newtype MandrillT m a = MandrillT {

11− runMandrillT :: ReaderT MandrillKey m a

12− } deriving (MonadTrans, MonadReader MandrillKey,

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

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

1315 Functor, Applicative, Monad, MonadIO)

1416

1517

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

2224 => MandrillKey

2325 -> MandrillT m a

2426 -> m a

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

27+runMandrill key action = do

28+ mgr <- liftIO $ newManager tlsManagerSettings

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

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

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

55import Network.API.Mandrill.HTTP

66import Network.API.Mandrill.Types

77import Network.API.Mandrill.Users.Types

8−import Data.Aeson

8+import Network.HTTP.Client

1010

1111--------------------------------------------------------------------------------

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

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

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

1414info key = toMandrillResponse UsersInfo (UsersRq key)

1515

1616

1717--------------------------------------------------------------------------------

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

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

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

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

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

2121

2222

2323--------------------------------------------------------------------------------

2424-- | 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)

2626ping2 key = toMandrillResponse UsersPing2 (UsersRq key)

2727

2828

2929--------------------------------------------------------------------------------

3030-- | 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])

3232senders key = toMandrillResponse UsersSenders (UsersRq key)

test/Online.hs+4−4

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

2020--

2121testOnlineUsersInfo :: MandrillKey -> Assertion

2222testOnlineUsersInfo k = do

23− res <- API.info k

23+ res <- API.info k Nothing

2424 case res of

2525 MandrillSuccess _ -> return ()

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

2727

2828testOnlineUsersPing2 :: MandrillKey -> Assertion

2929testOnlineUsersPing2 k = do

30− res <- API.ping2 k

30+ res <- API.ping2 k Nothing

3131 case res of

3232 MandrillSuccess _ -> return ()

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

3434

3535testOnlineUsersSenders :: MandrillKey -> Assertion

3636testOnlineUsersSenders k = do

37− res <- API.senders k

37+ res <- API.senders k Nothing

3838 case res of

3939 MandrillSuccess _ -> return ()

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

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

4646testOnlineMessagesSend :: MandrillKey -> Assertion

4747testOnlineMessagesSend k = do

4848 msg <- generate arbitrary

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

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

5050 case res of

5151 MandrillSuccess _ -> return ()

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