on master help sign in
Improve retrying, checking of status code, and streaming (#33)

See the updates in the changelog.

commitb86cd3c3f09c17541c6361de9eb8e20444e1b848 authorMark Karpov <markkarpov92@gmail.com> dateFri 1 Dec 2017, 14:09 (9 years ago) parent9c79ac4
6 files changed+266−160
.travis.yml−2 CHANGELOG.md+34 Network/HTTP/Req.hs+210−106 httpbin-tests/Network/HTTP/ReqSpec.hs+4−24 pure-tests/Network/HTTP/ReqSpec.hs+14−23 req.cabal+4−5
.travis.yml−2
@@ -9,8 +9,6 @@ cache:
99
1010matrix:
1111 include:
12− - env: CABALVER=1.24 GHCVER=7.8.4
13− addons: {apt: {packages: [cabal-install-1.24,ghc-7.8.4], sources: [hvr-ghc]}}
1412 - env: CABALVER=1.24 GHCVER=7.10.3
1513 addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3],sources: [hvr-ghc]}}
1614 - env: CABALVER=1.24 GHCVER=8.0.2
CHANGELOG.md+34
@@ -1,5 +1,39 @@
11## Req 1.0.0
22
3+* Added the `reqBr` function allowing to consume `Response BodyReader`
4+ without using a pre-defined instance of `HttpResponse`, in a custom way.
5+
6+* Now streaming of response body does not happen until we've checked headers
7+ and status code with `httpConfigCheckResponse`. It also doesn't happen on
8+ every retry. Streaming and obtaining of final response value happens only
9+ once when we're happy with everything.
10+
11+ Previously we first tried to consume and interpret response body before
12+ checking status code and determining whether we should retry the request.
13+ This was not good, because we could expect a JSON response but get a
14+ response with status code 500, and then still we would try to parse it as
15+ JSON first before letting `httpConfigCheckResponse` throw an exception.
16+
17+ The corrected behavior should also make retrying more efficient.
18+
19+* Changed signatures of several fields of `HttpConfig`:
20+ `httpConfigCheckResponse`, `httpConfigRetryPolicy`, and
21+ `httpConfigRetryJudge` in order to eliminate redundant `IO` and prevent
22+ the possibility that these functions could start consuming `BodyReader`.
23+
24+* Removed the `makeResponsePreview` method from the `HttpResponse` type
25+ class. Preview business is handled by the library automatically on a lower
26+ level now. Users do not need to concern themselves with such stuff.
27+
28+* Changed the type signature of the `getHttpResponse` method of the
29+ `HttpResponse` type class. Previously it left too much freedom (and
30+ responsibility) to implementers of the method. In fact, we now limit what
31+ `getHttpResponse` does to just consuming and interpreting `Response
32+ BodyReader`, so we can properly control details of connection
33+ opening/closing etc., for the user.
34+
35+* Dropped support for GHC 7.8.
36+
337* Minor documentation improvements.
438
539## Req 0.5.0
Network/HTTP/Req.hs+210−106
@@ -88,6 +88,7 @@
8888-- machinery for performing requests is the same as with @http-conduit@ and
8989-- @wreq@. The only difference is the API.
9090
91+{-# LANGUAGE BangPatterns #-}
9192{-# LANGUAGE CPP #-}
9293{-# LANGUAGE DataKinds #-}
9394{-# LANGUAGE DeriveDataTypeable #-}
@@ -106,10 +107,6 @@
106107{-# LANGUAGE UndecidableInstances #-}
107108#endif
108109
109−#if __GLASGOW_HASKELL__ < 710
110−{-# LANGUAGE ConstraintKinds #-}
111−#endif
112−
113110#if __GLASGOW_HASKELL__ >= 800
114111{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
115112#endif
@@ -118,6 +115,7 @@ module Network.HTTP.Req
118115 ( -- * Making a request
119116 -- $making-a-request
120117 req
118+ , reqBr
121119 , req'
122120 , withReqManager
123121 -- * Embedding requests into your monad
@@ -214,8 +212,6 @@ where
214212
215213import Control.Applicative
216214import Control.Arrow (first, second)
217−import Control.Exception (Exception, try, handle, throwIO)
218−import Control.Monad
219215import Control.Monad.Base
220216import Control.Monad.IO.Class
221217import Control.Monad.Reader
@@ -256,8 +252,10 @@ import qualified Network.HTTP.Types as Y
256252import qualified Web.Authenticate.OAuth as OAuth
257253
258254#if MIN_VERSION_base(4,9,0)
255+import Control.Exception hiding (TypeError)
259256import Data.Kind (Constraint)
260257#else
258+import Control.Exception
261259import GHC.Exts (Constraint)
262260#endif
263261
@@ -266,7 +264,7 @@ import GHC.Exts (Constraint)
266264
267265-- $making-a-request
268266--
269−-- To make an HTTP request you need only one function: 'req'.
267+-- To make an HTTP request you normally need only one function: 'req'.
270268
271269-- | Make an HTTP request. The function takes 5 arguments, 4 of which
272270-- specify required parameters and the final 'Option' argument is a
@@ -404,15 +402,47 @@ req
404402 -> Proxy response -- ^ A hint how to interpret response
405403 -> Option scheme -- ^ Collection of optional parameters
406404 -> m response -- ^ Response
407−req method url body Proxy options = req' method url body options $ \request manager -> do
405+req method url body Proxy options =
406+ reqBr method url body options getHttpResponse
407+
408+-- | A version of 'req' that does not use one of the predefined instances of
409+-- 'HttpResponse' but instead allows the user to consume @'L.Response'
410+-- 'L.BodyReader'@ manually, in a custom way.
411+--
412+-- @since 1.0.0
413+
414+reqBr
415+ :: ( MonadHttp m
416+ , HttpMethod method
417+ , HttpBody body
418+ , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )
419+ => method -- ^ HTTP method
420+ -> Url scheme -- ^ 'Url'—location of resource
421+ -> body -- ^ Body of the request
422+ -> Option scheme -- ^ Collection of optional parameters
423+ -> (L.Response L.BodyReader -> IO a) -- ^ How to consume response
424+ -> m a -- ^ Result
425+reqBr method url body options consume = req' method url body options $ \request manager -> do
408426 HttpConfig {..} <- getHttpConfig
409− let wrappingVanilla = handle (throwIO . VanillaHttpException)
410− wrapExc = handle (throwIO . LI.toHttpException request)
411− (liftIO . try . wrappingVanilla . wrapExc) (do
412− response <- retrying httpConfigRetryPolicy httpConfigRetryJudge
413− (const $ getHttpResponse request manager)
414− httpConfigCheckResponse request response
415− return response)
427+ let wrapVanilla = handle (throwIO . VanillaHttpException)
428+ wrapExc = handle (throwIO . LI.toHttpException request)
429+ withRRef = bracket
430+ (newIORef Nothing)
431+ (readIORef >=> mapM_ L.responseClose)
432+ (liftIO . try . wrapVanilla . wrapExc) (withRRef $ \rref -> do
433+ let openResponse = mask_ $ do
434+ r <- readIORef rref
435+ mapM_ L.responseClose r
436+ r' <- L.responseOpen request manager
437+ writeIORef rref (Just r')
438+ return r'
439+ r <- retrying
440+ httpConfigRetryPolicy
441+ (\st r -> return $ httpConfigRetryJudge st r)
442+ (const openResponse)
443+ (preview, r') <- grabPreview bodyPreviewLength r
444+ mapM_ LI.throwHttp (httpConfigCheckResponse request r' preview)
445+ consume r')
416446 >>= either handleHttpException return
417447
418448-- | Mostly like 'req' with respect to its arguments, but accepts a callback
@@ -435,7 +465,7 @@ req'
435465 -> body -- ^ Body of the request
436466 -> Option scheme -- ^ Collection of optional parameters
437467 -> (L.Request -> L.Manager -> m a) -- ^ How to perform request
438− -> m a
468+ -> m a -- ^ Result
439469req' method url body options m = do
440470 config@HttpConfig {..} <- getHttpConfig
441471 let -- NOTE First appearance of any given header wins. This allows to
@@ -457,6 +487,13 @@ req' method url body options m = do
457487 request <- finalizeRequest options request'
458488 withReqManager (m request)
459489
490+-- | Perform an action using the global implicit 'L.Manager' that the rest
491+-- of the library uses. This allows to reuse connections that the
492+-- 'L.Manager' controls.
493+
494+withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
495+withReqManager m = liftIO (readIORef globalManager) >>= m
496+
460497-- | Global 'L.Manager' that 'req' uses. Here we just go with the default
461498-- settings, so users don't need to deal with this manager stuff at all, but
462499-- when we create a request, instance 'HttpConfig' can affect the default
@@ -477,13 +514,6 @@ globalManager = unsafePerformIO $ do
477514 newIORef manager
478515{-# NOINLINE globalManager #-}
479516
480−-- | Perform an action using global implicit 'L.Manager' that the rest of
481−-- the library uses. This allows to reuse connections that the 'L.Manager'
482−-- controls.
483−
484−withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
485−withReqManager m = liftIO (readIORef globalManager) >>= m
486−
487517----------------------------------------------------------------------------
488518-- Embedding requests into your monad
489519
@@ -496,7 +526,7 @@ withReqManager m = liftIO (readIORef globalManager) >>= m
496526-- 'MonadHttp', only define instance of 'MonadHttp' in final application.
497527-- Another option is to use @newtype@ wrapped monad stack and define
498528-- 'MonadHttp' for it. As of version /0.4.0/, the 'Req' monad that follows
499−-- this strategy is provided out-of-the-box.
529+-- this strategy is provided out-of-the-box (see below).
500530
501531-- | A type class for monads that support performing HTTP requests.
502532-- Typically, you only need to define the 'handleHttpException' method
@@ -526,37 +556,60 @@ class MonadIO m => MonadHttp m where
526556-- making HTTP requests.
527557
528558data HttpConfig = HttpConfig
529− { httpConfigProxy :: Maybe L.Proxy
559+ { httpConfigProxy :: Maybe L.Proxy
530560 -- ^ Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@
531561 -- environment variables are respected, this setting overwrites them.
532562 -- Default value: 'Nothing'.
533563 , httpConfigRedirectCount :: Int
534564 -- ^ How many redirects to follow when getting a resource. Default
535565 -- value: 10.
536− , httpConfigAltManager :: Maybe L.Manager
566+ , httpConfigAltManager :: Maybe L.Manager
537567 -- ^ Alternative 'L.Manager' to use. 'Nothing' (default value) means
538568 -- that the default implicit manager will be used (that's what you want
539569 -- in 99% of cases).
540− , httpConfigCheckResponse :: forall r. HttpResponse r => L.Request -> r -> IO ()
570+ , httpConfigCheckResponse
571+ :: forall b.
572+ L.Request
573+ -> L.Response b
574+ -> ByteString
575+ -> Maybe L.HttpExceptionContent
541576 -- ^ Function to check the response immediately after receiving the
542− -- status and headers. This is used for throwing exceptions on
543− -- non-success status codes by default (set to @\\_ _ -> return ()@ if
544− -- this behavior is not desirable). Throwing is better then just
545− -- returning a request with non-2xx status code because in that case
546− -- something is wrong and we need a way to short-cut execution. The
547− -- thrown exception is caught by the library though and is available in
548− -- 'handleHttpException'.
577+ -- status and headers, before streaming of response body. The third
578+ -- argument is the beginning of response body (typically first 1024
579+ -- bytes). This is used for throwing exceptions on non-success status
580+ -- codes by default (set to @\\_ _ _ -> Nothing@ if this behavior is not
581+ -- desirable).
582+ --
583+ -- When the value this function returns is 'Nothing', nothing will
584+ -- happen. When it there is 'L.HttpExceptionContent' inside 'Just', it
585+ -- will be thrown.
586+ --
587+ -- Throwing is better then just returning a request with non-2xx status
588+ -- code because in that case something is wrong and we need a way to
589+ -- short-cut execution (also remember that Req retries automatically on
590+ -- request timeouts and such, so when your request fails, it's certainly
591+ -- something exceptional). The thrown exception is caught by the library
592+ -- though and is available in 'handleHttpException'.
593+ --
594+ -- __Note__: signature of this function was changed in the version
595+ -- /1.0.0/.
549596 --
550597 -- @since 0.3.0
551− , httpConfigRetryPolicy :: RetryPolicyM IO
598+ , httpConfigRetryPolicy :: RetryPolicy
552599 -- ^ The retry policy to use for request retrying. By default 'def' is
553600 -- used (see 'RetryPolicyM').
554601 --
602+ -- __Note__: signature of this function was changed in the version
603+ -- /1.0.0/.
604+ --
555605 -- @since 0.3.0
556− , httpConfigRetryJudge :: forall r. HttpResponse r => RetryStatus -> r -> IO Bool
606+ , httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool
557607 -- ^ The function is used to decide whether to retry a request. 'True'
558608 -- means that the request should be retried.
559609 --
610+ -- __Note__: signature of this function was changed in the version
611+ -- /1.0.0/.
612+ --
560613 -- @since 0.3.0
561614 } deriving Typeable
562615
@@ -565,15 +618,14 @@ instance Default HttpConfig where
565618 { httpConfigProxy = Nothing
566619 , httpConfigRedirectCount = 10
567620 , httpConfigAltManager = Nothing
568− , httpConfigCheckResponse = \_ response ->
569− let statusCode = responseStatusCode response in
570− unless (200 <= statusCode && statusCode < 300) $
571− let chunk = makeResponseBodyPreview response
572− vresponse = toVanillaResponse response
573− in LI.throwHttp (L.StatusCodeException (void vresponse) chunk)
621+ , httpConfigCheckResponse = \_ response preview ->
622+ let scode = statusCode response
623+ in if 200 <= scode && scode < 300
624+ then Nothing
625+ else Just (L.StatusCodeException (void response) preview)
574626 , httpConfigRetryPolicy = def
575− , httpConfigRetryJudge = \_ r -> return $
576− responseStatusCode r `elem`
627+ , httpConfigRetryJudge = \_ response ->
628+ statusCode response `elem`
577629 [ 408 -- Request timeout
578630 , 504 -- Gateway timeout
579631 , 524 -- A timeout occurred
@@ -581,6 +633,8 @@ instance Default HttpConfig where
581633 , 599 -- (Informal convention) Network connect timeout error
582634 ]
583635 }
636+ where
637+ statusCode = Y.statusCode . L.responseStatus
584638
585639instance RequestComponent HttpConfig where
586640 getRequestMod HttpConfig {..} = Endo $ \x ->
@@ -724,7 +778,7 @@ class HttpMethod a where
724778
725779 -- | Type function 'AllowsBody' returns a type of kind 'CanHaveBody' which
726780 -- tells the rest of the library whether the method can have a body or
727− -- not. We use the special type 'CanHaveBody' “lifted” to kind level
781+ -- not. We use the special type 'CanHaveBody' lifted to the kind level
728782 -- instead of 'Bool' to get more user-friendly compiler messages.
729783
730784 type AllowsBody a :: CanHaveBody
@@ -867,7 +921,7 @@ instance RequestComponent (Url scheme) where
867921-- A number of options for request bodies are available. The @Content-Type@
868922-- header is set for you automatically according to the body option you use
869923-- (it's always specified in documentation for a given body option). To add
870−-- your own way to represent request body, see 'HttpBody'.
924+-- your own way to represent request body, define an instance of 'HttpBody'.
871925
872926-- | This data type represents empty body of an HTTP request. This is the
873927-- data type to use with 'HttpMethod's that cannot have a body, as it's the
@@ -1003,8 +1057,6 @@ reqBodyMultipart parts = liftIO $ do
10031057
10041058class HttpBody body where
10051059
1006− {-# MINIMAL getRequestBody #-}
1007−
10081060 -- | How to get actual 'L.RequestBody'.
10091061
10101062 getRequestBody :: body -> L.RequestBody
@@ -1060,7 +1112,7 @@ instance HttpBody body => RequestComponent (Womb "body" body) where
10601112-- headers, port number, etc. All optional parameters have the type
10611113-- 'Option', which is a 'Monoid'. This means that you can use 'mempty' as
10621114-- the last argument of 'req' to specify no optional parameters, or combine
1063−-- 'Option's using 'mappend' (or @('<>')@) to have several of them at once.
1115+-- 'Option's using 'mappend' or @('<>')@ to have several of them at once.
10641116
10651117-- | The opaque 'Option' type is a 'Monoid' you can use to pack collection
10661118-- of optional parameters like query parameters and headers. See sections
@@ -1123,7 +1175,7 @@ finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
11231175-- bodies (of the type 'FormUrlEncodedParam').
11241176
11251177-- | This operator builds a query parameter that will be included in URL of
1126−-- your request after question sign @?@. This is the same syntax you use
1178+-- your request after the question sign @?@. This is the same syntax you use
11271179-- with form URL encoded request bodies.
11281180--
11291181-- This operator is defined in terms of 'queryParam':
@@ -1135,8 +1187,8 @@ infix 7 =:
11351187name =: value = queryParam name (pure value)
11361188
11371189-- | Construct a flag, that is, valueless query parameter. For example, in
1138−-- the following URL @a@ is a flag, while @b@ is a query parameter with a
1139−-- value:
1190+-- the following URL @\"a\"@ is a flag, while @\"b\"@ is a query parameter
1191+-- with a value:
11401192--
11411193-- > https://httpbin.org/foo/bar?a&b=10
11421194--
@@ -1299,7 +1351,7 @@ port n = withRequest $ \x ->
12991351 x { L.port = n }
13001352
13011353-- | This 'Option' controls whether gzipped data should be decompressed on
1302−-- the fly. By default everything except for @application\/x-tar@ is
1354+-- the fly. By default everything except for @\"application\/x-tar\"@ is
13031355-- decompressed, i.e. we have:
13041356--
13051357-- > decompress (/= "application/x-tar")
@@ -1316,7 +1368,8 @@ decompress f = withRequest $ \x ->
13161368 x { L.decompress = f }
13171369
13181370-- | Specify the number of microseconds to wait for response. The default
1319−-- value is 30 seconds.
1371+-- value is 30 seconds (defined in 'L.ManagerSettings' of connection
1372+-- 'L.Manager').
13201373
13211374responseTimeout
13221375 :: Int -- ^ Number of microseconds to wait
@@ -1338,14 +1391,12 @@ httpVersion major minor = withRequest $ \x ->
13381391
13391392-- | Make a request and ignore the body of the response.
13401393
1341−data IgnoreResponse = IgnoreResponse (L.Response ())
1394+newtype IgnoreResponse = IgnoreResponse (L.Response ())
13421395
13431396instance HttpResponse IgnoreResponse where
13441397 type HttpResponseBody IgnoreResponse = ()
1345− toVanillaResponse (IgnoreResponse response) = response
1346− getHttpResponse request manager =
1347− IgnoreResponse <$> liftIO (L.httpNoBody request manager)
1348− makeResponseBodyPreview _ = "<ignored response>"
1398+ toVanillaResponse (IgnoreResponse r) = r
1399+ getHttpResponse r = return $ IgnoreResponse (void r)
13491400
13501401-- | Use this as the fourth argument of 'req' to specify that you want it to
13511402-- ignore the response body.
@@ -1358,23 +1409,16 @@ ignoreResponse = Proxy
13581409-- monad in which you use 'req' will determine what to do in the case when
13591410-- parsing fails (the 'JsonHttpException' constructor will be used).
13601411
1361−data JsonResponse a = JsonResponse (L.Response a) ByteString
1412+newtype JsonResponse a = JsonResponse (L.Response a)
13621413
13631414instance FromJSON a => HttpResponse (JsonResponse a) where
13641415 type HttpResponseBody (JsonResponse a) = a
1365− toVanillaResponse (JsonResponse response _) = response
1366− getHttpResponse request manager = do
1367− response <- L.httpLbs request manager
1368− case A.eitherDecode (L.responseBody response) of
1369− Left e -> throwIO (JsonHttpException e)
1370− Right x -> do
1371− let preview
1372− = BL.toStrict
1373− . BL.take bodyPreviewLength
1374− . L.responseBody
1375− $ response
1376− return $ JsonResponse response { L.responseBody = x } preview
1377− makeResponseBodyPreview (JsonResponse _ preview) = preview
1416+ toVanillaResponse (JsonResponse r) = r
1417+ getHttpResponse r = do
1418+ chunks <- L.brConsume (L.responseBody r)
1419+ case A.eitherDecode (BL.fromChunks chunks) of
1420+ Left e -> throwIO (JsonHttpException e)
1421+ Right x -> return $ JsonResponse (x <$ r)
13781422
13791423-- | Use this as the fourth argument of 'req' to specify that you want it to
13801424-- return the 'JsonResponse' interpretation.
@@ -1389,11 +1433,10 @@ newtype BsResponse = BsResponse (L.Response ByteString)
13891433
13901434instance HttpResponse BsResponse where
13911435 type HttpResponseBody BsResponse = ByteString
1392− toVanillaResponse (BsResponse response) = response
1393− getHttpResponse request manager =
1394− BsResponse <$> httpBs request manager
1395− makeResponseBodyPreview =
1396− B.take bodyPreviewLength . responseBody
1436+ toVanillaResponse (BsResponse r) = r
1437+ getHttpResponse r = do
1438+ chunks <- L.brConsume (L.responseBody r)
1439+ return $ BsResponse (B.concat chunks <$ r)
13971440
13981441-- | Use this as the fourth argument of 'req' to specify that you want to
13991442-- interpret the response body as a strict 'ByteString'.
@@ -1408,11 +1451,10 @@ newtype LbsResponse = LbsResponse (L.Response BL.ByteString)
14081451
14091452instance HttpResponse LbsResponse where
14101453 type HttpResponseBody LbsResponse = BL.ByteString
1411− toVanillaResponse (LbsResponse response) = response
1412− getHttpResponse request manager =
1413− LbsResponse <$> L.httpLbs request manager
1414− makeResponseBodyPreview =
1415− BL.toStrict . BL.take bodyPreviewLength . responseBody
1454+ toVanillaResponse (LbsResponse r) = r
1455+ getHttpResponse r = do
1456+ chunks <- L.brConsume (L.responseBody r)
1457+ return $ LbsResponse (BL.fromChunks chunks <$ r)
14161458
14171459-- | Use this as the fourth argument of 'req' to specify that you want to
14181460-- interpret the response body as a lazy 'BL.ByteString'.
@@ -1420,13 +1462,69 @@ instance HttpResponse LbsResponse where
14201462lbsResponse :: Proxy LbsResponse
14211463lbsResponse = Proxy
14221464
1423−-- | Perform a 'L.Request' using given 'L.Manager' and return the response
1424−-- as a strict 'ByteString'.
1425−
1426−httpBs :: L.Request -> L.Manager -> IO (L.Response ByteString)
1427−httpBs request manager = L.withResponse request manager $ \response -> do
1428− chunks <- L.brConsume (L.responseBody response)
1429− return response { L.responseBody = B.concat chunks }
1465+----------------------------------------------------------------------------
1466+-- Helpers for response interpretations
1467+
1468+-- | Fetch beginning of response and return it together with new
1469+-- @'L.Response' 'L.BodyReader'@ that can be passed to 'getHttpResponse' and
1470+-- such.
1471+
1472+grabPreview
1473+ :: Int
1474+ -- ^ How many bytes to fetch
1475+ -> L.Response L.BodyReader
1476+ -- ^ Response with body reader inside
1477+ -> IO (ByteString, L.Response L.BodyReader)
1478+ -- ^ Preview 'ByteString' and new response with body reader inside
1479+grabPreview nbytes r = do
1480+ let br = L.responseBody r
1481+ (target, leftover, done) <- brReadN br nbytes
1482+ nref <- newIORef (0 :: Int)
1483+ let br' = do
1484+ n <- readIORef nref
1485+ let incn = modifyIORef' nref (+ 1)
1486+ case n of
1487+ 0 -> do
1488+ incn
1489+ if B.null target
1490+ then br'
1491+ else return target
1492+ 1 -> do
1493+ incn
1494+ if B.null leftover
1495+ then br'
1496+ else return leftover
1497+ _ ->
1498+ if done
1499+ then return B.empty
1500+ else br
1501+ return (target, r { L.responseBody = br' })
1502+
1503+-- | Consume N bytes from 'L.BodyReader', return the target chunk, the
1504+-- leftover (may be empty), and whether we're done consuming the body.
1505+
1506+brReadN
1507+ :: L.BodyReader
1508+ -- ^ Body reader to stream from
1509+ -> Int
1510+ -- ^ How many bytes to consume
1511+ -> IO (ByteString, ByteString, Bool)
1512+ -- ^ Target chunk, the leftover, whether we're done
1513+brReadN br n = go 0 id id
1514+ where
1515+ go !tlen t l = do
1516+ chunk <- br
1517+ if B.null chunk
1518+ then return (r t, r l, True)
1519+ else do
1520+ let (target, leftover) = B.splitAt (n - tlen) chunk
1521+ tlen' = B.length target
1522+ t' = t . (target:)
1523+ l' = l . (leftover:)
1524+ if tlen + tlen' < n
1525+ then go (tlen + tlen') t' l'
1526+ else return (r t', r l', False)
1527+ r f = B.concat (f [])
14301528
14311529----------------------------------------------------------------------------
14321530-- Inspecting a response
@@ -1483,8 +1581,9 @@ responseCookieJar = L.responseCookieJar . toVanillaResponse
14831581-- To create a new response interpretation you just need to make your data
14841582-- type an instance of the 'HttpResponse' type class.
14851583
1486−-- | A type class for response interpretations. It allows to fully control
1487−-- how request is made and how its body is parsed.
1584+-- | A type class for response interpretations. It allows to describe how to
1585+-- consume response from a @'L.Response' 'L.BodyReader'@ and produce the
1586+-- final result that is to be returned to the user.
14881587
14891588class HttpResponse response where
14901589
@@ -1497,21 +1596,25 @@ class HttpResponse response where
14971596
14981597 toVanillaResponse :: response -> L.Response (HttpResponseBody response)
14991598
1500− -- | This method describes how to make an HTTP request given 'L.Request'
1501− -- (prepared by the library) and 'L.Manager'.
1502−
1503− getHttpResponse :: L.Request -> L.Manager -> IO response
1504−
1505− -- | Construct a “preview” of response body. It is recommend to limit the
1506− -- length to 1024 bytes. This is mainly used for inclusion of response
1507− -- body fragments in exceptions.
1599+ -- | This method describes how to consume response body and, more
1600+ -- generally, obtain @response@ value from @'L.Response' 'L.BodyReader'@.
15081601 --
1509− -- __Note__: in versions 0.3.0–0.4.0 this function returned @'IO'
1510− -- 'ByteString'@.
1602+ -- __Note__: 'L.BodyReader' is nothing but @'IO' 'ByteString'@. You should
1603+ -- call this action repeatedly until it yields the empty 'ByteString'. In
1604+ -- that case streaming of response is finished (which apparently leads to
1605+ -- closing of the connection, so don't call the reader after it has
1606+ -- returned the empty 'ByteString' once) and you can concatenate the
1607+ -- chunks to obtain the final result. (Of course you could as well stream
1608+ -- the contents to a file or do whatever you want.)
15111609 --
1512− -- @since 0.5.0
1610+ -- __Note__: signature of this function was changed in the version
1611+ -- /1.0.0/.
15131612
1514− makeResponseBodyPreview :: response -> ByteString
1613+ getHttpResponse
1614+ :: L.Response L.BodyReader
1615+ -- ^ Response with body reader inside
1616+ -> IO response
1617+ -- ^ The final result
15151618
15161619----------------------------------------------------------------------------
15171620-- Other
@@ -1556,8 +1659,9 @@ data HttpException
15561659
15571660instance Exception HttpException
15581661
1559−-- | A simple 'Bool'-like type we only have for better error messages. We
1560−-- use it as a kind and its data constructors as type-level tags.
1662+-- | A simple type isomorphic to 'Bool' that we only have for better error
1663+-- messages. We use it as a kind and its data constructors as type-level
1664+-- tags.
15611665--
15621666-- See also: 'HttpMethod' and 'HttpBody'.
15631667
httpbin-tests/Network/HTTP/ReqSpec.hs+4−24
@@ -14,14 +14,12 @@ import Control.Monad.Reader
1414import Control.Monad.Trans.Control
1515import Data.Aeson (Value (..), ToJSON (..), object, (.=))
1616import Data.Default.Class
17−import Data.IORef
1817import Data.Monoid ((<>))
1918import Data.Proxy
2019import Data.Text (Text)
2120import Network.HTTP.Req
2221import Test.Hspec
2322import Test.QuickCheck
24−import qualified Control.Retry as R
2523import qualified Data.Aeson as A
2624import qualified Data.ByteString as B
2725import qualified Data.ByteString.Lazy as BL
@@ -33,12 +31,6 @@ import qualified Network.HTTP.Client as L
3331import qualified Network.HTTP.Client.MultipartFormData as LM
3432import qualified Network.HTTP.Types as Y
3533
36−#if !MIN_VERSION_base(4,8,0)
37−import Control.Applicative
38−import Data.Monoid (mempty)
39−import Data.Word (Word)
40−#endif
41−
4234spec :: Spec
4335spec = do
4436
@@ -211,12 +203,12 @@ spec = do
211203
212204 describe "retrying" $
213205 it "retries as many times as specified" $ do
206+ -- FIXME We no longer can count retries because all the functions
207+ -- responsible for controlling retrying are pure now.
214208 let status = 408 :: Int
215− nref <- newIORef (0 :: Int)
216− r <- countingRetries nref $ req GET (httpbin /: "status" /~ status)
209+ r <- prepareForShit $ req GET (httpbin /: "status" /~ status)
217210 NoReqBody ignoreResponse mempty
218211 responseStatusCode r `shouldBe` status
219− readIORef nref `shouldReturn` 6 -- number of retries plus 1
220212
221213 forM_ [101..102] checkStatusCode
222214 forM_ [200..208] checkStatusCode
@@ -332,7 +324,7 @@ instance MonadHttp IO where
332324prepareForShit :: Req a -> IO a
333325prepareForShit = runReq def { httpConfigCheckResponse = noNoise }
334326 where
335− noNoise _ _ = return ()
327+ noNoise _ _ _ = Nothing
336328
337329-- | Run request with such settings that it throws on any response.
338330
@@ -341,18 +333,6 @@ blindlyThrowing = runReq def { httpConfigCheckResponse = doit }
341333 where
342334 doit _ _ = error "Oops!"
343335
344−-- | Run request with such settings that every retry increments the given
345−-- @'IORef' 'Int'@.
346−
347−countingRetries :: IORef Int -> Req a -> IO a
348−countingRetries nref = runReq def
349− { httpConfigCheckResponse = noNoise
350− , httpConfigRetryPolicy = R.constantDelay 50000 <> R.limitRetries 5
351− , httpConfigRetryJudge = judge }
352− where
353− noNoise _ _ = return ()
354− judge _ _ = True <$ modifyIORef nref (+ 1)
355−
356336-- | 'Url' representing <https://httpbin.org>.
357337
358338httpbin :: Url 'Https
pure-tests/Network/HTTP/ReqSpec.hs+14−23
@@ -1,16 +1,13 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE RankNTypes #-}
7−{-# LANGUAGE RecordWildCards #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
9−{-# OPTIONS_GHC -fno-warn-orphans #-}
10−
11−#if __GLASGOW_HASKELL__ < 710
12−{-# LANGUAGE ConstraintKinds #-}
13−#endif
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE NoMonomorphismRestriction #-}
6+{-# LANGUAGE OverloadedStrings #-}
7+{-# LANGUAGE RankNTypes #-}
8+{-# LANGUAGE RecordWildCards #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# OPTIONS_GHC -fno-warn-orphans #-}
1411
1512module Network.HTTP.ReqSpec
1613 ( spec )
@@ -41,12 +38,6 @@ import qualified Data.Text.Encoding as T
4138import qualified Network.HTTP.Client as L
4239import qualified Network.HTTP.Types as Y
4340
44−#if !MIN_VERSION_base(4,8,0)
45−import Control.Applicative
46−import Data.Foldable (foldMap)
47−import Data.Monoid (mempty)
48−#endif
49−
5041spec :: Spec
5142spec = do
5243
@@ -299,10 +290,10 @@ instance Arbitrary HttpConfig where
299290 arbitrary = do
300291 httpConfigProxy <- arbitrary
301292 httpConfigRedirectCount <- arbitrary
302− let httpConfigAltManager = Nothing
303− httpConfigCheckResponse _ _ = return ()
304− httpConfigRetryPolicy = def
305− httpConfigRetryJudge _ _ = return False
293+ let httpConfigAltManager = Nothing
294+ httpConfigCheckResponse _ _ _ = Nothing
295+ httpConfigRetryPolicy = def
296+ httpConfigRetryJudge _ _ = False
306297 return HttpConfig {..}
307298
308299instance Show HttpConfig where
req.cabal+4−5
@@ -1,7 +1,7 @@
11name: req
22version: 0.5.0
33cabal-version: >= 1.18
4−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
4+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
55license: BSD3
66license-file: LICENSE.md
77author: Mark Karpov <markkarpov92@gmail.com>
@@ -29,7 +29,7 @@ flag dev
2929library
3030 build-depends: aeson >= 0.9 && < 1.3
3131 , authenticate-oauth >= 1.5 && < 1.7
32− , base >= 4.7 && < 5.0
32+ , base >= 4.8 && < 5.0
3333 , blaze-builder >= 0.3 && < 0.5
3434 , bytestring >= 0.10.8 && < 0.11
3535 , case-insensitive >= 0.2 && < 1.3
@@ -62,7 +62,7 @@ test-suite pure-tests
6262 type: exitcode-stdio-1.0
6363 build-depends: QuickCheck >= 2.7 && < 3.0
6464 , aeson >= 0.9 && < 1.3
65− , base >= 4.7 && < 5.0
65+ , base >= 4.8 && < 5.0
6666 , blaze-builder >= 0.3 && < 0.5
6767 , bytestring >= 0.10.8 && < 0.11
6868 , case-insensitive >= 0.2 && < 1.3
@@ -88,7 +88,7 @@ test-suite httpbin-tests
8888 type: exitcode-stdio-1.0
8989 build-depends: QuickCheck >= 2.7 && < 3.0
9090 , aeson >= 0.9 && < 1.3
91− , base >= 4.7 && < 5.0
91+ , base >= 4.8 && < 5.0
9292 , bytestring >= 0.10.8 && < 0.11
9393 , data-default-class
9494 , hspec >= 2.0 && < 3.0
@@ -97,7 +97,6 @@ test-suite httpbin-tests
9797 , monad-control >= 1.0 && < 1.1
9898 , mtl >= 2.0 && < 3.0
9999 , req
100− , retry >= 0.7 && < 0.8
101100 , text >= 0.2 && < 1.3
102101 , unordered-containers >= 0.2.5 && < 0.2.9
103102 if flag(dev)