diff --git a/network-api-support.cabal b/network-api-support.cabal --- a/network-api-support.cabal +++ b/network-api-support.cabal @@ -1,5 +1,5 @@ Name: network-api-support -Version: 0.0.7 +Version: 0.0.8 License: BSD3 License-File: LICENSE Author: Mark Hibberd @@ -35,8 +35,9 @@ , case-insensitive >= 0.4 , certificate >= 1.2 , failure >= 0.2 - , http-conduit >= 1.4 + , http-conduit >= 2.0.0.4 , http-types >= 0.6 + , http-client >= 0.1 , resourcet >= 0.3 , text >= 0.11 , time >= 1 diff --git a/src/Network/Api/Support/Core.hs b/src/Network/Api/Support/Core.hs --- a/src/Network/Api/Support/Core.hs +++ b/src/Network/Api/Support/Core.hs @@ -26,8 +26,8 @@ ManagerSettings -> StdMethod -> Text - -> RequestTransformer m - -> Responder m b + -> RequestTransformer + -> Responder b -> m b runRequest settings stdmethod url transform = runRequest' settings url (transform <> setMethod (renderStdMethod stdmethod)) @@ -39,21 +39,11 @@ (MonadIO m, MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m, Failure HttpException m) => ManagerSettings -> Text - -> RequestTransformer m - -> Responder m b + -> RequestTransformer + -> Responder b -> m b runRequest' settings url transform responder = do url' <- parseUrl $ unpack url let url'' = url' { checkStatus = const . const . const $ Nothing } -- handle all response codes. let req = appEndo transform url'' - liftM (responder req) . withCustomManager settings . httpLbs $ req - --- Build a custom connection manager and run ResourceT against that connection manager. --- This function is responsible for ensuring manager is always closed. -withCustomManager :: - (MonadIO m, MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m) => - ManagerSettings -> - (Manager -> ResourceT m a) -> - m a -withCustomManager settings f = runResourceT $ - allocate (newManager settings) closeManager >>= \(_, manager) -> f manager + liftM (responder req) . withManagerSettings settings . httpLbs $ req diff --git a/src/Network/Api/Support/Request.hs b/src/Network/Api/Support/Request.hs --- a/src/Network/Api/Support/Request.hs +++ b/src/Network/Api/Support/Request.hs @@ -15,8 +15,6 @@ , (<>) ) where -import Control.Monad.Trans.Resource - import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Aeson @@ -25,59 +23,59 @@ import Data.Time import Network.HTTP.Conduit -import Network.HTTP.Conduit.Internal (insertCookiesIntoRequest) +import Network.HTTP.Client (insertCookiesIntoRequest) -- * Request transformers -- | A RequestTransformer allows you to build up attributes on the request. -- | RequestTransformer is simply an Endo, and therefore has a Monoid, so -- | can be combined with `<>`. -type RequestTransformer m = Endo (Request (ResourceT m)) +type RequestTransformer = Endo Request -- | Set an api key for use with basic auth. -setApiKey :: B.ByteString -> RequestTransformer m +setApiKey :: B.ByteString -> RequestTransformer setApiKey key = Endo $ applyBasicAuth key "" -- | Set request query parameters. -setParams :: Monad m => [(B.ByteString, B.ByteString)] -> RequestTransformer m +setParams :: [(B.ByteString, B.ByteString)] -> RequestTransformer setParams params = Endo $ urlEncodedBody params -- | Set request headers. -setHeaders :: [(CI B.ByteString, B.ByteString)] -> RequestTransformer m +setHeaders :: [(CI B.ByteString, B.ByteString)] -> RequestTransformer setHeaders hs = Endo $ \r -> r { requestHeaders = hs } -- | Set a request headers. -setHeader :: (CI B.ByteString, B.ByteString) -> RequestTransformer m +setHeader :: (CI B.ByteString, B.ByteString) -> RequestTransformer setHeader h = stripHeader (fst h) <> addHeader h -- | Add a request headers. -addHeader :: (CI B.ByteString, B.ByteString) -> RequestTransformer m +addHeader :: (CI B.ByteString, B.ByteString) -> RequestTransformer addHeader h = Endo $ \r -> r { requestHeaders = requestHeaders r ++ [h] } -- | Set a request headers. -stripHeader :: CI B.ByteString -> RequestTransformer m +stripHeader :: CI B.ByteString -> RequestTransformer stripHeader n = (Endo $ \r -> r { requestHeaders = filter (\x -> fst x == n) (requestHeaders r) }) -- | Register all cookies in cookie jar against request. -setCookieJar :: CookieJar -> UTCTime -> RequestTransformer m +setCookieJar :: CookieJar -> UTCTime -> RequestTransformer setCookieJar cj now = Endo $ \r -> fst $ insertCookiesIntoRequest r cj now -- | Set the request method to be the specified name. -setMethod :: B.ByteString -> RequestTransformer m +setMethod :: B.ByteString -> RequestTransformer setMethod m = Endo $ \r -> r { method = m } -- | Set the request body from the specified byte string. -setBody :: B.ByteString -> RequestTransformer m +setBody :: B.ByteString -> RequestTransformer setBody b = Endo $ \r -> r { requestBody = RequestBodyBS b } -- | Set the request body from the specified lazy byte string. -setBodyLazy :: BL.ByteString -> RequestTransformer m +setBodyLazy :: BL.ByteString -> RequestTransformer setBodyLazy b = Endo $ \r -> r { requestBody = RequestBodyLBS b } -- | Set the request body from the value which can be converted to JSON. -setJson :: ToJSON a => a -> RequestTransformer m +setJson :: ToJSON a => a -> RequestTransformer setJson v = setHeader ("Content-Type", "application/json") <> (setBodyLazy . encode . toJSON $ v) diff --git a/src/Network/Api/Support/Response.hs b/src/Network/Api/Support/Response.hs --- a/src/Network/Api/Support/Response.hs +++ b/src/Network/Api/Support/Response.hs @@ -6,8 +6,6 @@ , basicResponder ) where -import Control.Monad.Trans.Resource - import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Attoparsec.Lazy @@ -18,8 +16,8 @@ import Network.HTTP.Types -- | Response handler. -type Responder m a = - Request (ResourceT m) -> Response BL.ByteString -> a +type Responder a = + Request -> Response BL.ByteString -> a -- | Wrap up json parse and decode errors. data JsonResult a = @@ -54,5 +52,5 @@ (Success a) -> JsonSuccess a -- | Lift function handling status code and body into a responder. -basicResponder :: (Int -> BL.ByteString -> a) -> Responder m a +basicResponder :: (Int -> BL.ByteString -> a) -> Responder a basicResponder f _ r = f (statusCode (responseStatus r)) (responseBody r)