diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,41 @@ +## Req 1.0.0 + +* Added the `reqBr` function allowing to consume `Response BodyReader` + without using a pre-defined instance of `HttpResponse`, in a custom way. + +* Now streaming of response body does not happen until we've checked headers + and status code with `httpConfigCheckResponse`. It also doesn't happen on + every retry. Streaming and obtaining of final response value happens only + once when we're happy with everything. + + Previously we first tried to consume and interpret response body before + checking status code and determining whether we should retry the request. + This was not good, because we could expect a JSON response but get a + response with status code 500, and then still we would try to parse it as + JSON first before letting `httpConfigCheckResponse` throw an exception. + + The corrected behavior should also make retrying more efficient. + +* Changed signatures of several fields of `HttpConfig`: + `httpConfigCheckResponse`, `httpConfigRetryPolicy`, and + `httpConfigRetryJudge` in order to eliminate redundant `IO` and prevent + the possibility that these functions could start consuming `BodyReader`. + +* Removed the `makeResponsePreview` method from the `HttpResponse` type + class. Preview business is handled by the library automatically on a lower + level now. Users do not need to concern themselves with such stuff. + +* Changed the type signature of the `getHttpResponse` method of the + `HttpResponse` type class. Previously it left too much freedom (and + responsibility) to implementers of the method. In fact, we now limit what + `getHttpResponse` does to just consuming and interpreting `Response + BodyReader`, so we can properly control details of connection + opening/closing etc., for the user. + +* Dropped support for GHC 7.8. + +* Minor documentation improvements. + ## Req 0.5.0 * Changed the signature of the `makeResponseBodyPreview` from `response -> @@ -41,12 +79,12 @@ ## Req 0.2.0 -* Added support for multipart form data in form of `ReqBodyMultipart` body - option and `reqBodyMultipart` helper function. This also required a change - in type signature of `getRequestContentType`, which now takes `body`, not - `Proxy body` because we need to extract boundary from `body` and put it - into `Content-Type` header. This change, however, shouldn't be too - dangerous for end-users. +* Added support for multipart form data in the form of `ReqBodyMultipart` + body option and `reqBodyMultipart` helper function. This also required a + change in the type signature of `getRequestContentType`, which now takes + `body`, not `Proxy body` because we need to extract boundary from `body` + and put it into `Content-Type` header. This change, however, shouldn't be + too dangerous for end-users. * Added support for OAuth 1.0 authentication via `oAuth1` option. diff --git a/Network/HTTP/Req.hs b/Network/HTTP/Req.hs --- a/Network/HTTP/Req.hs +++ b/Network/HTTP/Req.hs @@ -88,6 +88,7 @@ -- machinery for performing requests is the same as with @http-conduit@ and -- @wreq@. The only difference is the API. +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} @@ -106,10 +107,6 @@ {-# LANGUAGE UndecidableInstances #-} #endif -#if __GLASGOW_HASKELL__ < 710 -{-# LANGUAGE ConstraintKinds #-} -#endif - #if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #endif @@ -118,6 +115,7 @@ ( -- * Making a request -- $making-a-request req + , reqBr , req' , withReqManager -- * Embedding requests into your monad @@ -214,8 +212,6 @@ import Control.Applicative import Control.Arrow (first, second) -import Control.Exception (Exception, try, handle, throwIO) -import Control.Monad import Control.Monad.Base import Control.Monad.IO.Class import Control.Monad.Reader @@ -256,8 +252,10 @@ import qualified Web.Authenticate.OAuth as OAuth #if MIN_VERSION_base(4,9,0) +import Control.Exception hiding (TypeError) import Data.Kind (Constraint) #else +import Control.Exception import GHC.Exts (Constraint) #endif @@ -266,7 +264,7 @@ -- $making-a-request -- --- To make an HTTP request you need only one function: 'req'. +-- To make an HTTP request you normally need only one function: 'req'. -- | Make an HTTP request. The function takes 5 arguments, 4 of which -- specify required parameters and the final 'Option' argument is a @@ -404,23 +402,55 @@ -> Proxy response -- ^ A hint how to interpret response -> Option scheme -- ^ Collection of optional parameters -> m response -- ^ Response -req method url body Proxy options = req' method url body options $ \request manager -> do +req method url body Proxy options = + reqBr method url body options getHttpResponse + +-- | A version of 'req' that does not use one of the predefined instances of +-- 'HttpResponse' but instead allows the user to consume @'L.Response' +-- 'L.BodyReader'@ manually, in a custom way. +-- +-- @since 1.0.0 + +reqBr + :: ( MonadHttp m + , HttpMethod method + , HttpBody body + , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) ) + => method -- ^ HTTP method + -> Url scheme -- ^ 'Url'—location of resource + -> body -- ^ Body of the request + -> Option scheme -- ^ Collection of optional parameters + -> (L.Response L.BodyReader -> IO a) -- ^ How to consume response + -> m a -- ^ Result +reqBr method url body options consume = req' method url body options $ \request manager -> do HttpConfig {..} <- getHttpConfig - let wrappingVanilla = handle (throwIO . VanillaHttpException) - wrapExc = handle (throwIO . LI.toHttpException request) - (liftIO . try . wrappingVanilla . wrapExc) (do - response <- retrying httpConfigRetryPolicy httpConfigRetryJudge - (const $ getHttpResponse request manager) - httpConfigCheckResponse request response - return response) + let wrapVanilla = handle (throwIO . VanillaHttpException) + wrapExc = handle (throwIO . LI.toHttpException request) + withRRef = bracket + (newIORef Nothing) + (readIORef >=> mapM_ L.responseClose) + (liftIO . try . wrapVanilla . wrapExc) (withRRef $ \rref -> do + let openResponse = mask_ $ do + r <- readIORef rref + mapM_ L.responseClose r + r' <- L.responseOpen request manager + writeIORef rref (Just r') + return r' + r <- retrying + httpConfigRetryPolicy + (\st r -> return $ httpConfigRetryJudge st r) + (const openResponse) + (preview, r') <- grabPreview bodyPreviewLength r + mapM_ LI.throwHttp (httpConfigCheckResponse request r' preview) + consume r') >>= either handleHttpException return -- | Mostly like 'req' with respect to its arguments, but accepts a callback -- that allows to perform a request in arbitrary fashion. -- -- This function /does not/ perform handling\/wrapping exceptions, checking --- response, and retrying. It only prepares 'L.Request' and allows you to --- use it. +-- response (with 'httpConfigCheckResponse'), and retrying. It only prepares +-- 'L.Request' and allows you to use it. -- -- @since 0.3.0 @@ -435,10 +465,9 @@ -> body -- ^ Body of the request -> Option scheme -- ^ Collection of optional parameters -> (L.Request -> L.Manager -> m a) -- ^ How to perform request - -> m a + -> m a -- ^ Result req' method url body options m = do config@HttpConfig {..} <- getHttpConfig - manager <- liftIO (readIORef globalManager) let -- NOTE First appearance of any given header wins. This allows to -- “overwrite” headers when we construct a request by cons-ing. nubHeaders = Endo $ \x -> @@ -456,8 +485,15 @@ getRequestMod url <> getRequestMod (Womb method :: Womb "method" method) request <- finalizeRequest options request' - m request manager + withReqManager (m request) +-- | Perform an action using the global implicit 'L.Manager' that the rest +-- of the library uses. This allows to reuse connections that the +-- 'L.Manager' controls. + +withReqManager :: MonadIO m => (L.Manager -> m a) -> m a +withReqManager m = liftIO (readIORef globalManager) >>= m + -- | Global 'L.Manager' that 'req' uses. Here we just go with the default -- settings, so users don't need to deal with this manager stuff at all, but -- when we create a request, instance 'HttpConfig' can affect the default @@ -478,13 +514,6 @@ newIORef manager {-# NOINLINE globalManager #-} --- | Perform an action using global implicit 'L.Manager' that the rest of --- the library uses. This allows to reuse connections that the 'L.Manager' --- controls. - -withReqManager :: MonadIO m => (L.Manager -> m a) -> m a -withReqManager m = liftIO (readIORef globalManager) >>= m - ---------------------------------------------------------------------------- -- Embedding requests into your monad @@ -496,8 +525,8 @@ -- When writing a library, keep your API polymorphic in terms of -- 'MonadHttp', only define instance of 'MonadHttp' in final application. -- Another option is to use @newtype@ wrapped monad stack and define --- 'MonadHttp' for it. As of version /0.4.0/, the 'Req' monad is provided --- for this out-of-the-box. +-- 'MonadHttp' for it. As of version /0.4.0/, the 'Req' monad that follows +-- this strategy is provided out-of-the-box (see below). -- | A type class for monads that support performing HTTP requests. -- Typically, you only need to define the 'handleHttpException' method @@ -516,9 +545,9 @@ -- | Return 'HttpConfig' to be used when performing HTTP requests. Default -- implementation returns its 'def' value, which is described in the -- documentation for the type. Common usage pattern with manually defined - -- 'getHttpConfig' is to return some hard-coded value, or value extracted - -- from 'Control.Monad.Reader.MonadReader' if a more flexible approach to - -- configuration is desirable. + -- 'getHttpConfig' is to return some hard-coded value, or a value + -- extracted from 'Control.Monad.Reader.MonadReader' if a more flexible + -- approach to configuration is desirable. getHttpConfig :: m HttpConfig getHttpConfig = return def @@ -527,37 +556,60 @@ -- making HTTP requests. data HttpConfig = HttpConfig - { httpConfigProxy :: Maybe L.Proxy + { httpConfigProxy :: Maybe L.Proxy -- ^ Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@ -- environment variables are respected, this setting overwrites them. -- Default value: 'Nothing'. , httpConfigRedirectCount :: Int -- ^ How many redirects to follow when getting a resource. Default -- value: 10. - , httpConfigAltManager :: Maybe L.Manager + , httpConfigAltManager :: Maybe L.Manager -- ^ Alternative 'L.Manager' to use. 'Nothing' (default value) means - -- that default implicit manager will be used (that's what you want in - -- 99% of cases). - , httpConfigCheckResponse :: forall r. HttpResponse r => L.Request -> r -> IO () + -- that the default implicit manager will be used (that's what you want + -- in 99% of cases). + , httpConfigCheckResponse + :: forall b. + L.Request + -> L.Response b + -> ByteString + -> Maybe L.HttpExceptionContent -- ^ Function to check the response immediately after receiving the - -- status and headers. This is used for throwing exceptions on - -- non-success status codes by default (set to @\\_ _ -> return ()@ if - -- this behavior is not desirable). Throwing is better then just - -- returning a request with non-2xx status code because in that case - -- something is wrong and we need a way to short-cut execution. The - -- thrown exception is caught by the library though and is available in - -- 'handleHttpException'. + -- status and headers, before streaming of response body. The third + -- argument is the beginning of response body (typically first 1024 + -- bytes). This is used for throwing exceptions on non-success status + -- codes by default (set to @\\_ _ _ -> Nothing@ if this behavior is not + -- desirable). -- + -- When the value this function returns is 'Nothing', nothing will + -- happen. When it there is 'L.HttpExceptionContent' inside 'Just', it + -- will be thrown. + -- + -- Throwing is better then just returning a request with non-2xx status + -- code because in that case something is wrong and we need a way to + -- short-cut execution (also remember that Req retries automatically on + -- request timeouts and such, so when your request fails, it's certainly + -- something exceptional). The thrown exception is caught by the library + -- though and is available in 'handleHttpException'. + -- + -- __Note__: signature of this function was changed in the version + -- /1.0.0/. + -- -- @since 0.3.0 - , httpConfigRetryPolicy :: RetryPolicyM IO + , httpConfigRetryPolicy :: RetryPolicy -- ^ The retry policy to use for request retrying. By default 'def' is -- used (see 'RetryPolicyM'). -- + -- __Note__: signature of this function was changed in the version + -- /1.0.0/. + -- -- @since 0.3.0 - , httpConfigRetryJudge :: forall r. HttpResponse r => RetryStatus -> r -> IO Bool + , httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool -- ^ The function is used to decide whether to retry a request. 'True' -- means that the request should be retried. -- + -- __Note__: signature of this function was changed in the version + -- /1.0.0/. + -- -- @since 0.3.0 } deriving Typeable @@ -566,15 +618,14 @@ { httpConfigProxy = Nothing , httpConfigRedirectCount = 10 , httpConfigAltManager = Nothing - , httpConfigCheckResponse = \_ response -> - let statusCode = responseStatusCode response in - unless (200 <= statusCode && statusCode < 300) $ - let chunk = makeResponseBodyPreview response - vresponse = toVanillaResponse response - in LI.throwHttp (L.StatusCodeException (void vresponse) chunk) + , httpConfigCheckResponse = \_ response preview -> + let scode = statusCode response + in if 200 <= scode && scode < 300 + then Nothing + else Just (L.StatusCodeException (void response) preview) , httpConfigRetryPolicy = def - , httpConfigRetryJudge = \_ r -> return $ - responseStatusCode r `elem` + , httpConfigRetryJudge = \_ response -> + statusCode response `elem` [ 408 -- Request timeout , 504 -- Gateway timeout , 524 -- A timeout occurred @@ -582,6 +633,8 @@ , 599 -- (Informal convention) Network connect timeout error ] } + where + statusCode = Y.statusCode . L.responseStatus instance RequestComponent HttpConfig where getRequestMod HttpConfig {..} = Endo $ \x -> @@ -713,7 +766,7 @@ httpMethodName Proxy = Y.methodPatch -- | A type class for types that can be used as an HTTP method. To define a --- non-standard method, follow this example that defines COPY: +-- non-standard method, follow this example that defines @COPY@: -- -- > data COPY = COPY -- > @@ -725,7 +778,7 @@ -- | Type function 'AllowsBody' returns a type of kind 'CanHaveBody' which -- tells the rest of the library whether the method can have a body or - -- not. We use the special type 'CanHaveBody' “lifted” to kind level + -- not. We use the special type 'CanHaveBody' lifted to the kind level -- instead of 'Bool' to get more user-friendly compiler messages. type AllowsBody a :: CanHaveBody @@ -868,7 +921,7 @@ -- A number of options for request bodies are available. The @Content-Type@ -- header is set for you automatically according to the body option you use -- (it's always specified in documentation for a given body option). To add --- your own way to represent request body, see 'HttpBody'. +-- your own way to represent request body, define an instance of 'HttpBody'. -- | This data type represents empty body of an HTTP request. This is the -- data type to use with 'HttpMethod's that cannot have a body, as it's the @@ -954,7 +1007,7 @@ -- | Multipart form data. Please consult the -- "Network.HTTP.Client.MultipartFormData" module for how to construct -- parts, then use 'reqBodyMultipart' to create actual request body from the --- parts. 'reqBodyMultipart' is the only way to get a value of type +-- parts. 'reqBodyMultipart' is the only way to get a value of the type -- 'ReqBodyMultipart', as its constructor is not exported on purpose. -- -- @since 0.2.0 @@ -1004,8 +1057,6 @@ class HttpBody body where - {-# MINIMAL getRequestBody #-} - -- | How to get actual 'L.RequestBody'. getRequestBody :: body -> L.RequestBody @@ -1061,11 +1112,11 @@ -- headers, port number, etc. All optional parameters have the type -- 'Option', which is a 'Monoid'. This means that you can use 'mempty' as -- the last argument of 'req' to specify no optional parameters, or combine --- 'Option's using 'mappend' (or @('<>')@) to have several of them at once. +-- 'Option's using 'mappend' or @('<>')@ to have several of them at once. --- | Opaque 'Option' type is a 'Monoid' you can use to pack collection of --- optional parameters like query parameters and headers. See sections below --- to learn which 'Option' primitives are available. +-- | The opaque 'Option' type is a 'Monoid' you can use to pack collection +-- of optional parameters like query parameters and headers. See sections +-- below to learn which 'Option' primitives are available. data Option (scheme :: Scheme) = Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request)) @@ -1096,8 +1147,8 @@ withRequest :: (L.Request -> L.Request) -> Option scheme withRequest f = Option (Endo (second f)) Nothing --- | A helper to create an 'Option' that adds a finalizer (request --- transformation that is applied after all other modifications). +-- | A helper to create an 'Option' that adds a finalizer (an IO-enabled +-- request transformation that is applied after all other modifications). asFinalizer :: (L.Request -> IO L.Request) -> Option scheme asFinalizer = Option mempty . pure @@ -1124,7 +1175,7 @@ -- bodies (of the type 'FormUrlEncodedParam'). -- | This operator builds a query parameter that will be included in URL of --- your request after question sign @?@. This is the same syntax you use +-- your request after the question sign @?@. This is the same syntax you use -- with form URL encoded request bodies. -- -- This operator is defined in terms of 'queryParam': @@ -1136,8 +1187,8 @@ name =: value = queryParam name (pure value) -- | Construct a flag, that is, valueless query parameter. For example, in --- the following URL @a@ is a flag, while @b@ is a query parameter with a --- value: +-- the following URL @\"a\"@ is a flag, while @\"b\"@ is a query parameter +-- with a value: -- -- > https://httpbin.org/foo/bar?a&b=10 -- @@ -1293,14 +1344,14 @@ -- | Specify the port to connect to explicitly. Normally, 'Url' you use -- determines the default port: @80@ for HTTP and @443@ for HTTPS. This --- 'Option' allows to choose arbitrary port overwriting the defaults. +-- 'Option' allows to choose an arbitrary port overwriting the defaults. port :: Int -> Option scheme port n = withRequest $ \x -> x { L.port = n } -- | This 'Option' controls whether gzipped data should be decompressed on --- the fly. By default everything except for @application\/x-tar@ is +-- the fly. By default everything except for @\"application\/x-tar\"@ is -- decompressed, i.e. we have: -- -- > decompress (/= "application/x-tar") @@ -1317,7 +1368,8 @@ x { L.decompress = f } -- | Specify the number of microseconds to wait for response. The default --- value is 30 seconds. +-- value is 30 seconds (defined in 'L.ManagerSettings' of connection +-- 'L.Manager'). responseTimeout :: Int -- ^ Number of microseconds to wait @@ -1339,14 +1391,12 @@ -- | Make a request and ignore the body of the response. -data IgnoreResponse = IgnoreResponse (L.Response ()) +newtype IgnoreResponse = IgnoreResponse (L.Response ()) instance HttpResponse IgnoreResponse where type HttpResponseBody IgnoreResponse = () - toVanillaResponse (IgnoreResponse response) = response - getHttpResponse request manager = - IgnoreResponse <$> liftIO (L.httpNoBody request manager) - makeResponseBodyPreview _ = "" + toVanillaResponse (IgnoreResponse r) = r + getHttpResponse r = return $ IgnoreResponse (void r) -- | Use this as the fourth argument of 'req' to specify that you want it to -- ignore the response body. @@ -1359,23 +1409,16 @@ -- monad in which you use 'req' will determine what to do in the case when -- parsing fails (the 'JsonHttpException' constructor will be used). -data JsonResponse a = JsonResponse (L.Response a) ByteString +newtype JsonResponse a = JsonResponse (L.Response a) instance FromJSON a => HttpResponse (JsonResponse a) where type HttpResponseBody (JsonResponse a) = a - toVanillaResponse (JsonResponse response _) = response - getHttpResponse request manager = do - response <- L.httpLbs request manager - case A.eitherDecode (L.responseBody response) of - Left e -> throwIO (JsonHttpException e) - Right x -> do - let preview - = BL.toStrict - . BL.take bodyPreviewLength - . L.responseBody - $ response - return $ JsonResponse response { L.responseBody = x } preview - makeResponseBodyPreview (JsonResponse _ preview) = preview + toVanillaResponse (JsonResponse r) = r + getHttpResponse r = do + chunks <- L.brConsume (L.responseBody r) + case A.eitherDecode (BL.fromChunks chunks) of + Left e -> throwIO (JsonHttpException e) + Right x -> return $ JsonResponse (x <$ r) -- | Use this as the fourth argument of 'req' to specify that you want it to -- return the 'JsonResponse' interpretation. @@ -1390,11 +1433,10 @@ instance HttpResponse BsResponse where type HttpResponseBody BsResponse = ByteString - toVanillaResponse (BsResponse response) = response - getHttpResponse request manager = - BsResponse <$> httpBs request manager - makeResponseBodyPreview = - B.take bodyPreviewLength . responseBody + toVanillaResponse (BsResponse r) = r + getHttpResponse r = do + chunks <- L.brConsume (L.responseBody r) + return $ BsResponse (B.concat chunks <$ r) -- | Use this as the fourth argument of 'req' to specify that you want to -- interpret the response body as a strict 'ByteString'. @@ -1409,11 +1451,10 @@ instance HttpResponse LbsResponse where type HttpResponseBody LbsResponse = BL.ByteString - toVanillaResponse (LbsResponse response) = response - getHttpResponse request manager = - LbsResponse <$> L.httpLbs request manager - makeResponseBodyPreview = - BL.toStrict . BL.take bodyPreviewLength . responseBody + toVanillaResponse (LbsResponse r) = r + getHttpResponse r = do + chunks <- L.brConsume (L.responseBody r) + return $ LbsResponse (BL.fromChunks chunks <$ r) -- | Use this as the fourth argument of 'req' to specify that you want to -- interpret the response body as a lazy 'BL.ByteString'. @@ -1421,14 +1462,70 @@ lbsResponse :: Proxy LbsResponse lbsResponse = Proxy --- | Perform a 'L.Request' using given 'L.Manager' and return the response --- as a strict 'ByteString'. +---------------------------------------------------------------------------- +-- Helpers for response interpretations -httpBs :: L.Request -> L.Manager -> IO (L.Response ByteString) -httpBs request manager = L.withResponse request manager $ \response -> do - chunks <- L.brConsume (L.responseBody response) - return response { L.responseBody = B.concat chunks } +-- | Fetch beginning of response and return it together with new +-- @'L.Response' 'L.BodyReader'@ that can be passed to 'getHttpResponse' and +-- such. +grabPreview + :: Int + -- ^ How many bytes to fetch + -> L.Response L.BodyReader + -- ^ Response with body reader inside + -> IO (ByteString, L.Response L.BodyReader) + -- ^ Preview 'ByteString' and new response with body reader inside +grabPreview nbytes r = do + let br = L.responseBody r + (target, leftover, done) <- brReadN br nbytes + nref <- newIORef (0 :: Int) + let br' = do + n <- readIORef nref + let incn = modifyIORef' nref (+ 1) + case n of + 0 -> do + incn + if B.null target + then br' + else return target + 1 -> do + incn + if B.null leftover + then br' + else return leftover + _ -> + if done + then return B.empty + else br + return (target, r { L.responseBody = br' }) + +-- | Consume N bytes from 'L.BodyReader', return the target chunk, the +-- leftover (may be empty), and whether we're done consuming the body. + +brReadN + :: L.BodyReader + -- ^ Body reader to stream from + -> Int + -- ^ How many bytes to consume + -> IO (ByteString, ByteString, Bool) + -- ^ Target chunk, the leftover, whether we're done +brReadN br n = go 0 id id + where + go !tlen t l = do + chunk <- br + if B.null chunk + then return (r t, r l, True) + else do + let (target, leftover) = B.splitAt (n - tlen) chunk + tlen' = B.length target + t' = t . (target:) + l' = l . (leftover:) + if tlen + tlen' < n + then go (tlen + tlen') t' l' + else return (r t', r l', False) + r f = B.concat (f []) + ---------------------------------------------------------------------------- -- Inspecting a response @@ -1482,10 +1579,11 @@ -- $new-response-interpretation -- -- To create a new response interpretation you just need to make your data --- type an instance of 'HttpResponse' type class. +-- type an instance of the 'HttpResponse' type class. --- | A type class for response interpretations. It allows to fully control --- how request is made and how its body is parsed. +-- | A type class for response interpretations. It allows to describe how to +-- consume response from a @'L.Response' 'L.BodyReader'@ and produce the +-- final result that is to be returned to the user. class HttpResponse response where @@ -1498,21 +1596,25 @@ toVanillaResponse :: response -> L.Response (HttpResponseBody response) - -- | This method describes how to make an HTTP request given 'L.Request' - -- (prepared by the library) and 'L.Manager'. - - getHttpResponse :: L.Request -> L.Manager -> IO response - - -- | Construct a “preview” of response body. It is recommend to limit the - -- length to 1024 bytes. This is mainly useful for inclusion of response - -- body fragments in exceptions. + -- | This method describes how to consume response body and, more + -- generally, obtain @response@ value from @'L.Response' 'L.BodyReader'@. -- - -- __Note__: in versions 0.3.0–0.4.0 this function returned @'IO' - -- 'ByteString'@. + -- __Note__: 'L.BodyReader' is nothing but @'IO' 'ByteString'@. You should + -- call this action repeatedly until it yields the empty 'ByteString'. In + -- that case streaming of response is finished (which apparently leads to + -- closing of the connection, so don't call the reader after it has + -- returned the empty 'ByteString' once) and you can concatenate the + -- chunks to obtain the final result. (Of course you could as well stream + -- the contents to a file or do whatever you want.) -- - -- @since 0.5.0 + -- __Note__: signature of this function was changed in the version + -- /1.0.0/. - makeResponseBodyPreview :: response -> ByteString + getHttpResponse + :: L.Response L.BodyReader + -- ^ Response with body reader inside + -> IO response + -- ^ The final result ---------------------------------------------------------------------------- -- Other @@ -1522,14 +1624,16 @@ -- 'RequestComponent' changing\/overwriting something in it. 'Endo' is a -- monoid of endomorphisms under composition, it's used to chain different -- request components easier using @('<>')@. +-- +-- __Note__: this type class is not a part of the public API. class RequestComponent a where -- | Get a function that takes a 'L.Request' and changes it somehow - -- returning another 'L.Request'. For example HTTP method instance of - -- 'RequestComponent' just overwrites method. The function is wrapped in - -- 'Endo' so it's easier to chain such “modifying applications” together - -- building bigger and bigger 'RequestComponent's. + -- returning another 'L.Request'. For example, the 'HttpMethod' instance + -- of 'RequestComponent' just overwrites method. The function is wrapped + -- in 'Endo' so it's easier to chain such “modifying applications” + -- together building bigger and bigger 'RequestComponent's. getRequestMod :: a -> Endo L.Request @@ -1555,8 +1659,9 @@ instance Exception HttpException --- | A simple 'Bool'-like type we only have for better error messages. We --- use it as a kind and its data constructors as type-level tags. +-- | A simple type isomorphic to 'Bool' that we only have for better error +-- messages. We use it as a kind and its data constructors as type-level +-- tags. -- -- See also: 'HttpMethod' and 'HttpBody'. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,33 +14,30 @@ * [License](#license) ```haskell -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Control.Exception (throwIO) -import Network.HTTP.Req +import Control.Monad.IO.Class import Data.Aeson - --- Just make your monad stack an instance of MonadHttp in your application --- and start making requests, enjoy automatic connection sharing. - -instance MonadHttp IO where - handleHttpException = throwIO +import Data.Default.Class +import Network.HTTP.Req main :: IO () -main = do +-- You can either make your monad an instance of 'MonadHttp', or use +-- 'runReq' in any IO-enabled monad without defining new instances. +main = runReq def $ do let payload = object [ "foo" .= (10 :: Int) , "bar" .= (20 :: Int) ] - -- One function, full power and flexibility. + -- One function—full power and flexibility, automatic retrying on timeouts + -- and such, automatic connection sharing. r <- req POST -- method (https "httpbin.org" /: "post") -- safe by construction URL (ReqBodyJson payload) -- use built-in options or add your own jsonResponse -- specify how to interpret response mempty -- query params, headers, explicit port number, etc. - print (responseBody r :: Value) + liftIO $ print (responseBody r :: Value) ``` Req is an easy-to-use, type-safe, expandable, high-level HTTP library that @@ -92,7 +89,6 @@ * [`http-client`](https://hackage.haskell.org/package/http-client)—low level HTTP client used everywhere in Haskell. - * [`http-client-tls`](https://hackage.haskell.org/package/http-client-tls)—TLS (HTTPS) support for `http-client`. @@ -112,12 +108,13 @@ a common thing and still there is no high-level library for that in Haskell that I could use with pleasure. I'll explain why. -First of all there is `http-client` and `http-client-tls`. They just work. I -have no issues with the libraries except that they are too low-level for my -taste. Indeed, even the docs say that they are low-level and “intended as a -base layer for more user-friendly packages”. This is exactly how I use them -in Req, as base level. Req is nothing but a different API to `http-client`, -so it only works because of the hard work put into `http-client`. +First of all, there is `http-client` and `http-client-tls`. They just work. +I have no issues with the libraries except that they are too low-level for +my taste. Indeed, even the docs say that they are low-level and “intended as +a base layer for more user-friendly packages”. This is exactly how I use +them in Req, as base level. Req is nothing but a different API to +`http-client`, so it only works because of the hard work put into +`http-client`. `http-conduit` definitely has its place. For one thing it allows you to stream request and response bodies in constant memory, what other library @@ -133,29 +130,28 @@ string without the protection of TH that otherwise saves the day as in Yesod. -Then there is Wreq. -`wreq` -[doesn't see much development lately](https://github.com/bos/wreq/issues/93). -`wreq` is by itself a weird library, IMO. You have functions per method—not -very good, as there may be new methods, like PATCH which is not new but -still missing (well you have `customMethod`, but what is the point of having -per-method functions if you have a more general way to use any method? you -should be able to just insert methods in the “argument slot” of -`customMethod` and end up with a more general solution). Now every method -function has a companion that takes `Options` (like you have `get` and -`getWith`). Why the duplication? Where is generality and flexibility? This -is not all though, because you cannot really use `get` you see in the main -module, because you want to have connection sharing. Wreq's author does not -take the gift of automatic connection re-use `Manager` from `http-client` -provides, he invents the whole new thing of “sessions”. Only inside a -session your connections will be shared and re-used. However with the -session stuff you have yet another set of per-method functions like `get` -and `getWith`—these are different ones, to be used with sessions! Now if you -have a multi-threaded app, here is a surprise for you: you can't share -connections between threads as connections are shared only inside -`withSession` friend and “session will no longer be valid after that -function returns”. There are valid uses for sessions, but the point is that -they are just too inconvenient for common tasks. +Then there is Wreq. `wreq` [doesn't see much development +lately](https://github.com/bos/wreq/issues/93). `wreq` is by itself a weird +library, IMO. You have functions per method—not very good, as there may be +new methods, like PATCH which is not new but still missing (well you have +`customMethod`, but what is the point of having per-method functions if you +have a more general way to use any method? you should be able to just insert +methods in the “argument slot” of `customMethod` and end up with a more +general solution). Now every method function has a companion that takes +`Options` (like you have `get` and `getWith`). Why the duplication? Where is +generality and flexibility? This is not all though, because you cannot +really use `get` you see in the main module, because you want to have +connection sharing. Wreq's author does not take the gift of automatic +connection re-use `Manager` from `http-client` provides, he invents the +whole new thing of “sessions”. Only inside a session your connections will +be shared and re-used. However with the session stuff you have yet another +set of per-method functions like `get` and `getWith`—these are different +ones, to be used with sessions! Now if you have a multi-threaded app, here +is a surprise for you: you can't share connections between threads as +connections are shared only inside `withSession` friend and “session will no +longer be valid after that function returns”. There are valid uses for +sessions, but the point is that they are just too inconvenient for common +tasks. It's funny that one client I worked for had to have his own little wrapper around `http-client` just because he could not possibly use `wreq` and @@ -164,9 +160,10 @@ thought to myself “something is wrong with HTTP client libraries in Haskell if they had to make a wrapper”. -What else? I used `servant-client` a couple of times but amount of -boilerplate is too high. If you have several query parameters, and you use -just one of them, good luck passing lots of `Nothing`s. +What else? I used `servant-client` a couple of times but the amount of +boilerplate it requires is frightening. If you have several query +parameters, and you use just one of them, good luck passing lots of +`Nothing`s. ## Unsolved problems @@ -177,11 +174,11 @@ made. In Wreq the author chose to just use `error` when body is not a (strict or lazy) `ByteString`. Maybe it's OK for Wreq, but I don't consider this a proper solution for Req as we support full variety of body options. -For example what if I want to upload 1 Gb file to S3? I want to stream it in -constant memory but at the same time I need to calculate its hash before I -start streaming. One solution to the problem seems to be in taking the hash -explicitly (as an argument of the hypothetical `awsAuth`) and making it a -responsibility of the user to calculate the hash correctly. I don't like +For example, what if I want to upload 1 Gb file to S3? I want to stream it +in constant memory but at the same time I need to calculate its hash before +I start streaming. One solution to the problem seems to be in taking the +hash explicitly (as an argument of the hypothetical `awsAuth`) and making it +a responsibility of the user to calculate the hash correctly. I don't like this because it's not user-friendly. So the question stays open, for now there is no AWS signing functionality provided out-of-the-box. The best solution for talking to AWS is the `amazonka` package so far. diff --git a/httpbin-tests/Network/HTTP/ReqSpec.hs b/httpbin-tests/Network/HTTP/ReqSpec.hs --- a/httpbin-tests/Network/HTTP/ReqSpec.hs +++ b/httpbin-tests/Network/HTTP/ReqSpec.hs @@ -14,14 +14,12 @@ import Control.Monad.Trans.Control import Data.Aeson (Value (..), ToJSON (..), object, (.=)) import Data.Default.Class -import Data.IORef import Data.Monoid ((<>)) import Data.Proxy import Data.Text (Text) import Network.HTTP.Req import Test.Hspec import Test.QuickCheck -import qualified Control.Retry as R import qualified Data.Aeson as A import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL @@ -33,12 +31,6 @@ import qualified Network.HTTP.Client.MultipartFormData as LM import qualified Network.HTTP.Types as Y -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Monoid (mempty) -import Data.Word (Word) -#endif - spec :: Spec spec = do @@ -211,12 +203,12 @@ describe "retrying" $ it "retries as many times as specified" $ do + -- FIXME We no longer can count retries because all the functions + -- responsible for controlling retrying are pure now. let status = 408 :: Int - nref <- newIORef (0 :: Int) - r <- countingRetries nref $ req GET (httpbin /: "status" /~ status) + r <- prepareForShit $ req GET (httpbin /: "status" /~ status) NoReqBody ignoreResponse mempty responseStatusCode r `shouldBe` status - readIORef nref `shouldReturn` 6 -- number of retries plus 1 forM_ [101..102] checkStatusCode forM_ [200..208] checkStatusCode @@ -332,7 +324,7 @@ prepareForShit :: Req a -> IO a prepareForShit = runReq def { httpConfigCheckResponse = noNoise } where - noNoise _ _ = return () + noNoise _ _ _ = Nothing -- | Run request with such settings that it throws on any response. @@ -340,18 +332,6 @@ blindlyThrowing = runReq def { httpConfigCheckResponse = doit } where doit _ _ = error "Oops!" - --- | Run request with such settings that every retry increments the given --- @'IORef' 'Int'@. - -countingRetries :: IORef Int -> Req a -> IO a -countingRetries nref = runReq def - { httpConfigCheckResponse = noNoise - , httpConfigRetryPolicy = R.constantDelay 50000 <> R.limitRetries 5 - , httpConfigRetryJudge = judge } - where - noNoise _ _ = return () - judge _ _ = True <$ modifyIORef nref (+ 1) -- | 'Url' representing . diff --git a/pure-tests/Network/HTTP/ReqSpec.hs b/pure-tests/Network/HTTP/ReqSpec.hs --- a/pure-tests/Network/HTTP/ReqSpec.hs +++ b/pure-tests/Network/HTTP/ReqSpec.hs @@ -1,16 +1,13 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -#if __GLASGOW_HASKELL__ < 710 -{-# LANGUAGE ConstraintKinds #-} -#endif +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Network.HTTP.ReqSpec ( spec ) @@ -41,12 +38,6 @@ import qualified Network.HTTP.Client as L import qualified Network.HTTP.Types as Y -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Foldable (foldMap) -import Data.Monoid (mempty) -#endif - spec :: Spec spec = do @@ -299,10 +290,10 @@ arbitrary = do httpConfigProxy <- arbitrary httpConfigRedirectCount <- arbitrary - let httpConfigAltManager = Nothing - httpConfigCheckResponse _ _ = return () - httpConfigRetryPolicy = def - httpConfigRetryJudge _ _ = return False + let httpConfigAltManager = Nothing + httpConfigCheckResponse _ _ _ = Nothing + httpConfigRetryPolicy = def + httpConfigRetryJudge _ _ = False return HttpConfig {..} instance Show HttpConfig where diff --git a/req.cabal b/req.cabal --- a/req.cabal +++ b/req.cabal @@ -1,7 +1,7 @@ name: req -version: 0.5.0 +version: 1.0.0 cabal-version: >= 1.18 -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 +tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 license: BSD3 license-file: LICENSE.md author: Mark Karpov @@ -29,7 +29,7 @@ library build-depends: aeson >= 0.9 && < 1.3 , authenticate-oauth >= 1.5 && < 1.7 - , base >= 4.7 && < 5.0 + , base >= 4.8 && < 5.0 , blaze-builder >= 0.3 && < 0.5 , bytestring >= 0.10.8 && < 0.11 , case-insensitive >= 0.2 && < 1.3 @@ -62,7 +62,7 @@ type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.7 && < 3.0 , aeson >= 0.9 && < 1.3 - , base >= 4.7 && < 5.0 + , base >= 4.8 && < 5.0 , blaze-builder >= 0.3 && < 0.5 , bytestring >= 0.10.8 && < 0.11 , case-insensitive >= 0.2 && < 1.3 @@ -88,7 +88,7 @@ type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.7 && < 3.0 , aeson >= 0.9 && < 1.3 - , base >= 4.7 && < 5.0 + , base >= 4.8 && < 5.0 , bytestring >= 0.10.8 && < 0.11 , data-default-class , hspec >= 2.0 && < 3.0 @@ -97,7 +97,6 @@ , monad-control >= 1.0 && < 1.1 , mtl >= 2.0 && < 3.0 , req - , retry >= 0.7 && < 0.8 , text >= 0.2 && < 1.3 , unordered-containers >= 0.2.5 && < 0.2.9 if flag(dev)