mandrill 0.1.0.2 → 0.1.1.0
raw patch · 7 files changed
+48/−27 lines, 7 filesdep +http-clientdep +http-client-tlsdep +http-typesdep −wreqdep ~lens
Dependencies added: http-client, http-client-tls, http-types
Dependencies removed: wreq
Dependency ranges changed: lens
Files
- mandrill.cabal +5/−3
- 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 view
@@ -1,5 +1,5 @@ name: mandrill-version: 0.1.0.2+version: 0.1.1.0 synopsis: Library for interfacing with the Mandrill JSON API description: Pure Haskell client for the Mandrill JSON API license: MIT@@ -36,9 +36,11 @@ , bytestring >= 0.9.0 , base64-bytestring >= 1.0.0.1 , text >= 1.0.0.0 && < 1.3- , wreq >= 0.1.0.1+ , http-types >= 0.8.0+ , http-client >= 0.3.0+ , http-client-tls >= 0.2.0.0 , aeson >= 0.7.0.3 && < 0.9- , lens >= 4.1 && < 4.6+ , lens >= 4.0 , blaze-html >= 0.5.0.0 , QuickCheck >= 2.6 && < 2.8 , mtl < 3.0
src/Network/API/Mandrill.hs view
@@ -136,8 +136,8 @@ => MandrillMessage -> MandrillT m (MandrillResponse [MessagesResponse]) sendEmail msg = do- key <- ask- liftIO $ send key msg (Just True) Nothing Nothing+ (key, mgr) <- ask+ liftIO $ send key msg (Just True) Nothing Nothing (Just mgr) --------------------------------------------------------------------------------@@ -145,6 +145,6 @@ => MandrillMessage -> MandrillT m (MandrillResponse [MessagesResponse]) sendTextEmail msg = do- key <- ask+ (key, mgr) <- ask now <- liftIO getCurrentTime- liftIO $ send key msg (Just True) Nothing (Just now)+ liftIO $ send key msg (Just True) Nothing (Just now) (Just mgr)
src/Network/API/Mandrill/HTTP.hs view
@@ -6,14 +6,28 @@ import qualified Data.Text as T import Data.Monoid import Data.Aeson-import Network.Wreq-import Control.Lens+import Control.Applicative+import Network.HTTP.Types+import Network.HTTP.Client+import Network.HTTP.Client.TLS toMandrillResponse :: (MandrillEndpoint ep, FromJSON a, ToJSON rq) => ep -> rq+ -> Maybe Manager -> IO (MandrillResponse a)-toMandrillResponse ep rq = do+toMandrillResponse ep rq mbMgr = do let fullUrl = mandrillUrl <> toUrl ep- res <- asJSON =<< post (T.unpack fullUrl) (toJSON rq)- return $ res ^. responseBody+ rq' <- parseUrl (T.unpack fullUrl)+ let headers = [(hContentType, "application/json")]+ let jsonBody = encode rq+ let req = rq' {+ method = "POST"+ , requestHeaders = headers+ , requestBody = RequestBodyLBS jsonBody+ }+ mgr <- maybe (newManager tlsManagerSettings) return mbMgr+ res <- responseBody <$> httpLbs req mgr+ case eitherDecode res of+ Left e -> fail e+ Right v -> return v
src/Network/API/Mandrill/Messages.hs view
@@ -5,6 +5,7 @@ import Network.API.Mandrill.Messages.Types import Network.API.Mandrill.Settings import Network.API.Mandrill.HTTP+import Network.HTTP.Client import Data.Time import qualified Data.Text as T @@ -20,6 +21,6 @@ -- ^ ip_pool -> Maybe UTCTime -- ^ send_at+ -> Maybe Manager -> IO (MandrillResponse [MessagesResponse])-send k msg async ip_pool send_at =- toMandrillResponse MessagesSend (MessagesSendRq k msg async ip_pool send_at)+send k msg async ip_pool send_at = toMandrillResponse MessagesSend (MessagesSendRq k msg async ip_pool send_at)
src/Network/API/Mandrill/Trans.hs view
@@ -4,12 +4,14 @@ import Control.Monad.Reader import Control.Applicative import Network.API.Mandrill.Types+import Network.HTTP.Client+import Network.HTTP.Client.TLS -------------------------------------------------------------------------------- newtype MandrillT m a = MandrillT {- runMandrillT :: ReaderT MandrillKey m a- } deriving (MonadTrans, MonadReader MandrillKey,+ runMandrillT :: ReaderT (MandrillKey, Manager) m a+ } deriving (MonadTrans, MonadReader (MandrillKey, Manager), Functor, Applicative, Monad, MonadIO) @@ -22,4 +24,6 @@ => MandrillKey -> MandrillT m a -> m a-runMandrill key action = runReaderT (runMandrillT action) key+runMandrill key action = do+ mgr <- liftIO $ newManager tlsManagerSettings+ runReaderT (runMandrillT action) (key, mgr)
src/Network/API/Mandrill/Users.hs view
@@ -5,28 +5,28 @@ import Network.API.Mandrill.HTTP import Network.API.Mandrill.Types import Network.API.Mandrill.Users.Types-import Data.Aeson+import Network.HTTP.Client -------------------------------------------------------------------------------- -- | Return the information about the API-connected user-info :: MandrillKey -> IO (MandrillResponse UsersInfoResponse)+info :: MandrillKey -> Maybe Manager -> 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."+ping :: MandrillKey -> Maybe Manager -> 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 :: MandrillKey -> Maybe Manager -> 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 :: MandrillKey -> Maybe Manager -> IO (MandrillResponse [UsersSendersResponse]) senders key = toMandrillResponse UsersSenders (UsersRq key)
test/Online.hs view
@@ -20,21 +20,21 @@ -- testOnlineUsersInfo :: MandrillKey -> Assertion testOnlineUsersInfo k = do- res <- API.info k+ res <- API.info k Nothing case res of MandrillSuccess _ -> return () MandrillFailure e -> fail $ "users/info.json " ++ show e testOnlineUsersPing2 :: MandrillKey -> Assertion testOnlineUsersPing2 k = do- res <- API.ping2 k+ res <- API.ping2 k Nothing case res of MandrillSuccess _ -> return () MandrillFailure e -> fail $ "users/ping2.json " ++ show e testOnlineUsersSenders :: MandrillKey -> Assertion testOnlineUsersSenders k = do- res <- API.senders k+ res <- API.senders k Nothing case res of MandrillSuccess _ -> return () MandrillFailure e -> fail $ "users/senders.json " ++ show e@@ -46,7 +46,7 @@ testOnlineMessagesSend :: MandrillKey -> Assertion testOnlineMessagesSend k = do msg <- generate arbitrary- res <- API.send k msg Nothing Nothing Nothing+ res <- API.send k msg Nothing Nothing Nothing Nothing case res of MandrillSuccess _ -> return () MandrillFailure e -> fail $ "messages/send.json " ++ show e