@@ -88,6 +88,7 @@
88-- machinery for performing requests is the same as with @http-conduit@ and
88-- machinery for performing requests is the same as with @http-conduit@ and
89-- @wreq@. The only difference is the API.
89-- @wreq@. The only difference is the API.
91+{-# LANGUAGE BangPatterns #-}
91{-# LANGUAGE CPP #-}
92{-# LANGUAGE CPP #-}
92{-# LANGUAGE DataKinds #-}
93{-# LANGUAGE DataKinds #-}
93{-# LANGUAGE DeriveDataTypeable #-}
94{-# LANGUAGE DeriveDataTypeable #-}
@@ -106,10 +107,6 @@
106{-# LANGUAGE UndecidableInstances #-}
107{-# LANGUAGE UndecidableInstances #-}
109−#if __GLASGOW_HASKELL__ < 710
110−{-# LANGUAGE ConstraintKinds #-}
113#if __GLASGOW_HASKELL__ >= 800
110#if __GLASGOW_HASKELL__ >= 800
114{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
111{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
@@ -118,6 +115,7 @@ module Network.HTTP.Req
118 ( -- * Making a request
115 ( -- * Making a request
119 -- $making-a-request
116 -- $making-a-request
122 , withReqManager
120 , withReqManager
123 -- * Embedding requests into your monad
121 -- * Embedding requests into your monad
@@ -214,8 +212,6 @@ where
215import Control.Applicative
213import Control.Applicative
216import Control.Arrow (first, second)
214import Control.Arrow (first, second)
217−import Control.Exception (Exception, try, handle, throwIO)
219import Control.Monad.Base
215import Control.Monad.Base
220import Control.Monad.IO.Class
216import Control.Monad.IO.Class
221import Control.Monad.Reader
217import Control.Monad.Reader
@@ -256,8 +252,10 @@ import qualified Network.HTTP.Types as Y
256import qualified Web.Authenticate.OAuth as OAuth
252import qualified Web.Authenticate.OAuth as OAuth
258#if MIN_VERSION_base(4,9,0)
254#if MIN_VERSION_base(4,9,0)
255+import Control.Exception hiding (TypeError)
259import Data.Kind (Constraint)
256import Data.Kind (Constraint)
258+import Control.Exception
261import GHC.Exts (Constraint)
259import GHC.Exts (Constraint)
@@ -266,7 +264,7 @@ import GHC.Exts (Constraint)
267-- $making-a-request
265-- $making-a-request
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'.
271-- | Make an HTTP request. The function takes 5 arguments, 4 of which
269-- | Make an HTTP request. The function takes 5 arguments, 4 of which
272-- specify required parameters and the final 'Option' argument is a
270-- specify required parameters and the final 'Option' argument is a
@@ -404,15 +402,47 @@ req
404 -> Proxy response -- ^ A hint how to interpret response
402 -> Proxy response -- ^ A hint how to interpret response
405 -> Option scheme -- ^ Collection of optional parameters
403 -> Option scheme -- ^ Collection of optional parameters
406 -> m response -- ^ Response
404 -> 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
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.
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
425+reqBr method url body options consume = req' method url body options $ \request manager -> do
408 HttpConfig {..} <- getHttpConfig
426 HttpConfig {..} <- getHttpConfig
409− let wrappingVanilla = handle (throwIO . VanillaHttpException)
427+ let wrapVanilla = handle (throwIO . VanillaHttpException)
410− wrapExc = handle (throwIO . LI.toHttpException request)
428+ wrapExc = handle (throwIO . LI.toHttpException request)
431+ (readIORef >=> mapM_ L.responseClose)
411− (liftIO . try . wrappingVanilla . wrapExc) (do
432+ (liftIO . try . wrapVanilla . wrapExc) (withRRef $ \rref -> do
433+ let openResponse = mask_ $ do
435+ mapM_ L.responseClose r
436+ r' <- L.responseOpen request manager
437+ writeIORef rref (Just r')
412− response <- retrying httpConfigRetryPolicy httpConfigRetryJudge
440+ httpConfigRetryPolicy
413− (const $ getHttpResponse request manager)
441+ (\st r -> return $ httpConfigRetryJudge st r)
442+ (const openResponse)
443+ (preview, r') <- grabPreview bodyPreviewLength r
414− httpConfigCheckResponse request response
444+ mapM_ LI.throwHttp (httpConfigCheckResponse request r' preview)
415− return response)
445+ consume r')
416 >>= either handleHttpException return
446 >>= either handleHttpException return
418-- | Mostly like 'req' with respect to its arguments, but accepts a callback
448-- | Mostly like 'req' with respect to its arguments, but accepts a callback
@@ -435,7 +465,7 @@ req'
435 -> body -- ^ Body of the request
465 -> body -- ^ Body of the request
436 -> Option scheme -- ^ Collection of optional parameters
466 -> Option scheme -- ^ Collection of optional parameters
437 -> (L.Request -> L.Manager -> m a) -- ^ How to perform request
467 -> (L.Request -> L.Manager -> m a) -- ^ How to perform request
438− -> m a
468+ -> m a -- ^ Result
439req' method url body options m = do
469req' method url body options m = do
440 config@HttpConfig {..} <- getHttpConfig
470 config@HttpConfig {..} <- getHttpConfig
441 let -- NOTE First appearance of any given header wins. This allows to
471 let -- NOTE First appearance of any given header wins. This allows to
@@ -457,6 +487,13 @@ req' method url body options m = do
457 request <- finalizeRequest options request'
487 request <- finalizeRequest options request'
458 withReqManager (m request)
488 withReqManager (m request)
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.
494+withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
495+withReqManager m = liftIO (readIORef globalManager) >>= m
460-- | Global 'L.Manager' that 'req' uses. Here we just go with the default
497-- | Global 'L.Manager' that 'req' uses. Here we just go with the default
461-- settings, so users don't need to deal with this manager stuff at all, but
498-- settings, so users don't need to deal with this manager stuff at all, but
462-- when we create a request, instance 'HttpConfig' can affect the default
499-- when we create a request, instance 'HttpConfig' can affect the default
@@ -477,13 +514,6 @@ globalManager = unsafePerformIO $ do
477 newIORef manager
514 newIORef manager
478{-# NOINLINE globalManager #-}
515{-# NOINLINE globalManager #-}
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'
484−withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
485−withReqManager m = liftIO (readIORef globalManager) >>= m
487----------------------------------------------------------------------------
517----------------------------------------------------------------------------
488-- Embedding requests into your monad
518-- Embedding requests into your monad
@@ -496,7 +526,7 @@ withReqManager m = liftIO (readIORef globalManager) >>= m
496-- 'MonadHttp', only define instance of 'MonadHttp' in final application.
526-- 'MonadHttp', only define instance of 'MonadHttp' in final application.
497-- Another option is to use @newtype@ wrapped monad stack and define
527-- Another option is to use @newtype@ wrapped monad stack and define
498-- 'MonadHttp' for it. As of version /0.4.0/, the 'Req' monad that follows
528-- '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).
501-- | A type class for monads that support performing HTTP requests.
531-- | A type class for monads that support performing HTTP requests.
502-- Typically, you only need to define the 'handleHttpException' method
532-- Typically, you only need to define the 'handleHttpException' method
@@ -526,37 +556,60 @@ class MonadIO m => MonadHttp m where
526-- making HTTP requests.
556-- making HTTP requests.
528data HttpConfig = HttpConfig
558data HttpConfig = HttpConfig
529− { httpConfigProxy :: Maybe L.Proxy
559+ { httpConfigProxy :: Maybe L.Proxy
530 -- ^ Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@
560 -- ^ Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@
531 -- environment variables are respected, this setting overwrites them.
561 -- environment variables are respected, this setting overwrites them.
532 -- Default value: 'Nothing'.
562 -- Default value: 'Nothing'.
533 , httpConfigRedirectCount :: Int
563 , httpConfigRedirectCount :: Int
534 -- ^ How many redirects to follow when getting a resource. Default
564 -- ^ How many redirects to follow when getting a resource. Default
535 -- value: 10.
565 -- value: 10.
536− , httpConfigAltManager :: Maybe L.Manager
566+ , httpConfigAltManager :: Maybe L.Manager
537 -- ^ Alternative 'L.Manager' to use. 'Nothing' (default value) means
567 -- ^ Alternative 'L.Manager' to use. 'Nothing' (default value) means
538 -- that the default implicit manager will be used (that's what you want
568 -- that the default implicit manager will be used (that's what you want
539 -- in 99% of cases).
569 -- in 99% of cases).
540− , httpConfigCheckResponse :: forall r. HttpResponse r => L.Request -> r -> IO ()
570+ , httpConfigCheckResponse
575+ -> Maybe L.HttpExceptionContent
541 -- ^ Function to check the response immediately after receiving the
576 -- ^ Function to check the response immediately after receiving the
577+ -- status and headers, before streaming of response body. The third
578+ -- argument is the beginning of response body (typically first 1024
542− -- status and headers. This is used for throwing exceptions on
579+ -- bytes). This is used for throwing exceptions on non-success status
543− -- non-success status codes by default (set to @\\_ _ -> return ()@ if
580+ -- codes by default (set to @\\_ _ _ -> Nothing@ if this behavior is not
544− -- this behavior is not desirable). Throwing is better then just
581+ -- desirable).
583+ -- When the value this function returns is 'Nothing', nothing will
584+ -- happen. When it there is 'L.HttpExceptionContent' inside 'Just', it
545− -- returning a request with non-2xx status code because in that case
587+ -- Throwing is better then just returning a request with non-2xx status
546− -- something is wrong and we need a way to short-cut execution. The
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
547− -- thrown exception is caught by the library though and is available in
591+ -- something exceptional). The thrown exception is caught by the library
548− -- 'handleHttpException'.
592+ -- though and is available in 'handleHttpException'.
594+ -- __Note__: signature of this function was changed in the version
550 -- @since 0.3.0
597 -- @since 0.3.0
551− , httpConfigRetryPolicy :: RetryPolicyM IO
598+ , httpConfigRetryPolicy :: RetryPolicy
552 -- ^ The retry policy to use for request retrying. By default 'def' is
599 -- ^ The retry policy to use for request retrying. By default 'def' is
553 -- used (see 'RetryPolicyM').
600 -- used (see 'RetryPolicyM').
602+ -- __Note__: signature of this function was changed in the version
555 -- @since 0.3.0
605 -- @since 0.3.0
556− , httpConfigRetryJudge :: forall r. HttpResponse r => RetryStatus -> r -> IO Bool
606+ , httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool
557 -- ^ The function is used to decide whether to retry a request. 'True'
607 -- ^ The function is used to decide whether to retry a request. 'True'
558 -- means that the request should be retried.
608 -- means that the request should be retried.
610+ -- __Note__: signature of this function was changed in the version
560 -- @since 0.3.0
613 -- @since 0.3.0
561 } deriving Typeable
614 } deriving Typeable
@@ -565,15 +618,14 @@ instance Default HttpConfig where
565 { httpConfigProxy = Nothing
618 { httpConfigProxy = Nothing
566 , httpConfigRedirectCount = 10
619 , httpConfigRedirectCount = 10
567 , httpConfigAltManager = Nothing
620 , httpConfigAltManager = Nothing
568− , httpConfigCheckResponse = \_ response ->
621+ , httpConfigCheckResponse = \_ response preview ->
569− let statusCode = responseStatusCode response in
622+ let scode = statusCode response
570− unless (200 <= statusCode && statusCode < 300) $
623+ in if 200 <= scode && scode < 300
571− let chunk = makeResponseBodyPreview response
624+ then Nothing
572− vresponse = toVanillaResponse response
573− in LI.throwHttp (L.StatusCodeException (void vresponse) chunk)
625+ else Just (L.StatusCodeException (void response) preview)
574 , httpConfigRetryPolicy = def
626 , httpConfigRetryPolicy = def
575− , httpConfigRetryJudge = \_ r -> return $
627+ , httpConfigRetryJudge = \_ response ->
576− responseStatusCode r `elem`
628+ statusCode response `elem`
577 [ 408 -- Request timeout
629 [ 408 -- Request timeout
578 , 504 -- Gateway timeout
630 , 504 -- Gateway timeout
579 , 524 -- A timeout occurred
631 , 524 -- A timeout occurred
@@ -581,6 +633,8 @@ instance Default HttpConfig where
581 , 599 -- (Informal convention) Network connect timeout error
633 , 599 -- (Informal convention) Network connect timeout error
637+ statusCode = Y.statusCode . L.responseStatus
585instance RequestComponent HttpConfig where
639instance RequestComponent HttpConfig where
586 getRequestMod HttpConfig {..} = Endo $ \x ->
640 getRequestMod HttpConfig {..} = Endo $ \x ->
@@ -724,7 +778,7 @@ class HttpMethod a where
725 -- | Type function 'AllowsBody' returns a type of kind 'CanHaveBody' which
779 -- | Type function 'AllowsBody' returns a type of kind 'CanHaveBody' which
726 -- tells the rest of the library whether the method can have a body or
780 -- 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
728 -- instead of 'Bool' to get more user-friendly compiler messages.
782 -- instead of 'Bool' to get more user-friendly compiler messages.
730 type AllowsBody a :: CanHaveBody
784 type AllowsBody a :: CanHaveBody
@@ -867,7 +921,7 @@ instance RequestComponent (Url scheme) where
867-- A number of options for request bodies are available. The @Content-Type@
921-- A number of options for request bodies are available. The @Content-Type@
868-- header is set for you automatically according to the body option you use
922-- header is set for you automatically according to the body option you use
869-- (it's always specified in documentation for a given body option). To add
923-- (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'.
872-- | This data type represents empty body of an HTTP request. This is the
926-- | This data type represents empty body of an HTTP request. This is the
873-- data type to use with 'HttpMethod's that cannot have a body, as it's the
927-- data type to use with 'HttpMethod's that cannot have a body, as it's the
@@ -1003,8 +1057,6 @@ reqBodyMultipart parts = liftIO $ do
1004class HttpBody body where
1058class HttpBody body where
1006− {-# MINIMAL getRequestBody #-}
1008 -- | How to get actual 'L.RequestBody'.
1060 -- | How to get actual 'L.RequestBody'.
1010 getRequestBody :: body -> L.RequestBody
1062 getRequestBody :: body -> L.RequestBody
@@ -1060,7 +1112,7 @@ instance HttpBody body => RequestComponent (Womb "body" body) where
1060-- headers, port number, etc. All optional parameters have the type
1112-- headers, port number, etc. All optional parameters have the type
1061-- 'Option', which is a 'Monoid'. This means that you can use 'mempty' as
1113-- 'Option', which is a 'Monoid'. This means that you can use 'mempty' as
1062-- the last argument of 'req' to specify no optional parameters, or combine
1114-- 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.
1065-- | The opaque 'Option' type is a 'Monoid' you can use to pack collection
1117-- | The opaque 'Option' type is a 'Monoid' you can use to pack collection
1066-- of optional parameters like query parameters and headers. See sections
1118-- of optional parameters like query parameters and headers. See sections
@@ -1123,7 +1175,7 @@ finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
1123-- bodies (of the type 'FormUrlEncodedParam').
1175-- bodies (of the type 'FormUrlEncodedParam').
1125-- | This operator builds a query parameter that will be included in URL of
1177-- | 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
1127-- with form URL encoded request bodies.
1179-- with form URL encoded request bodies.
1129-- This operator is defined in terms of 'queryParam':
1181-- This operator is defined in terms of 'queryParam':
@@ -1135,8 +1187,8 @@ infix 7 =:
1135name =: value = queryParam name (pure value)
1187name =: value = queryParam name (pure value)
1137-- | Construct a flag, that is, valueless query parameter. For example, in
1189-- | 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
1190+-- the following URL @\"a\"@ is a flag, while @\"b\"@ is a query parameter
1139−-- value:
1191+-- with a value:
1141-- > https://httpbin.org/foo/bar?a&b=10
1193-- > https://httpbin.org/foo/bar?a&b=10
@@ -1299,7 +1351,7 @@ port n = withRequest $ \x ->
1299 x { L.port = n }
1351 x { L.port = n }
1301-- | This 'Option' controls whether gzipped data should be decompressed on
1353-- | 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
1303-- decompressed, i.e. we have:
1355-- decompressed, i.e. we have:
1305-- > decompress (/= "application/x-tar")
1357-- > decompress (/= "application/x-tar")
@@ -1316,7 +1368,8 @@ decompress f = withRequest $ \x ->
1316 x { L.decompress = f }
1368 x { L.decompress = f }
1318-- | Specify the number of microseconds to wait for response. The default
1370-- | 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
1321responseTimeout
1374responseTimeout
1322 :: Int -- ^ Number of microseconds to wait
1375 :: Int -- ^ Number of microseconds to wait
@@ -1338,14 +1391,12 @@ httpVersion major minor = withRequest $ \x ->
1339-- | Make a request and ignore the body of the response.
1392-- | Make a request and ignore the body of the response.
1341−data IgnoreResponse = IgnoreResponse (L.Response ())
1394+newtype IgnoreResponse = IgnoreResponse (L.Response ())
1343instance HttpResponse IgnoreResponse where
1396instance HttpResponse IgnoreResponse where
1344 type HttpResponseBody IgnoreResponse = ()
1397 type HttpResponseBody IgnoreResponse = ()
1345− toVanillaResponse (IgnoreResponse response) = response
1398+ toVanillaResponse (IgnoreResponse r) = r
1346− getHttpResponse request manager =
1399+ getHttpResponse r = return $ IgnoreResponse (void r)
1347− IgnoreResponse <$> liftIO (L.httpNoBody request manager)
1348− makeResponseBodyPreview _ = "<ignored response>"
1350-- | Use this as the fourth argument of 'req' to specify that you want it to
1401-- | Use this as the fourth argument of 'req' to specify that you want it to
1351-- ignore the response body.
1402-- ignore the response body.
@@ -1358,23 +1409,16 @@ ignoreResponse = Proxy
1358-- monad in which you use 'req' will determine what to do in the case when
1409-- monad in which you use 'req' will determine what to do in the case when
1359-- parsing fails (the 'JsonHttpException' constructor will be used).
1410-- parsing fails (the 'JsonHttpException' constructor will be used).
1361−data JsonResponse a = JsonResponse (L.Response a) ByteString
1412+newtype JsonResponse a = JsonResponse (L.Response a)
1363instance FromJSON a => HttpResponse (JsonResponse a) where
1414instance FromJSON a => HttpResponse (JsonResponse a) where
1364 type HttpResponseBody (JsonResponse a) = a
1415 type HttpResponseBody (JsonResponse a) = a
1365− toVanillaResponse (JsonResponse response _) = response
1416+ toVanillaResponse (JsonResponse r) = r
1366− getHttpResponse request manager = do
1417+ getHttpResponse r = do
1367− response <- L.httpLbs request manager
1418+ chunks <- L.brConsume (L.responseBody r)
1368− case A.eitherDecode (L.responseBody response) of
1419+ case A.eitherDecode (BL.fromChunks chunks) of
1369− Left e -> throwIO (JsonHttpException e)
1420+ Left e -> throwIO (JsonHttpException e)
1373− . BL.take bodyPreviewLength
1376− return $ JsonResponse response { L.responseBody = x } preview
1421+ Right x -> return $ JsonResponse (x <$ r)
1377− makeResponseBodyPreview (JsonResponse _ preview) = preview
1379-- | Use this as the fourth argument of 'req' to specify that you want it to
1423-- | Use this as the fourth argument of 'req' to specify that you want it to
1380-- return the 'JsonResponse' interpretation.
1424-- return the 'JsonResponse' interpretation.
@@ -1389,11 +1433,10 @@ newtype BsResponse = BsResponse (L.Response ByteString)
1390instance HttpResponse BsResponse where
1434instance HttpResponse BsResponse where
1391 type HttpResponseBody BsResponse = ByteString
1435 type HttpResponseBody BsResponse = ByteString
1392− toVanillaResponse (BsResponse response) = response
1436+ toVanillaResponse (BsResponse r) = r
1393− getHttpResponse request manager =
1437+ getHttpResponse r = do
1394− BsResponse <$> httpBs request manager
1438+ chunks <- L.brConsume (L.responseBody r)
1395− makeResponseBodyPreview =
1439+ return $ BsResponse (B.concat chunks <$ r)
1396− B.take bodyPreviewLength . responseBody
1398-- | Use this as the fourth argument of 'req' to specify that you want to
1441-- | Use this as the fourth argument of 'req' to specify that you want to
1399-- interpret the response body as a strict 'ByteString'.
1442-- interpret the response body as a strict 'ByteString'.
@@ -1408,11 +1451,10 @@ newtype LbsResponse = LbsResponse (L.Response BL.ByteString)
1409instance HttpResponse LbsResponse where
1452instance HttpResponse LbsResponse where
1410 type HttpResponseBody LbsResponse = BL.ByteString
1453 type HttpResponseBody LbsResponse = BL.ByteString
1411− toVanillaResponse (LbsResponse response) = response
1454+ toVanillaResponse (LbsResponse r) = r
1412− getHttpResponse request manager =
1455+ getHttpResponse r = do
1413− LbsResponse <$> L.httpLbs request manager
1456+ chunks <- L.brConsume (L.responseBody r)
1414− makeResponseBodyPreview =
1457+ return $ LbsResponse (BL.fromChunks chunks <$ r)
1415− BL.toStrict . BL.take bodyPreviewLength . responseBody
1417-- | Use this as the fourth argument of 'req' to specify that you want to
1459-- | Use this as the fourth argument of 'req' to specify that you want to
1418-- interpret the response body as a lazy 'BL.ByteString'.
1460-- interpret the response body as a lazy 'BL.ByteString'.
@@ -1420,13 +1462,69 @@ instance HttpResponse LbsResponse where
1420lbsResponse :: Proxy LbsResponse
1462lbsResponse :: Proxy LbsResponse
1421lbsResponse = Proxy
1463lbsResponse = Proxy
1423−-- | Perform a 'L.Request' using given 'L.Manager' and return the response
1465+----------------------------------------------------------------------------
1424−-- as a strict 'ByteString'.
1466+-- Helpers for response interpretations
1426−httpBs :: L.Request -> L.Manager -> IO (L.Response ByteString)
1468+-- | Fetch beginning of response and return it together with new
1427−httpBs request manager = L.withResponse request manager $ \response -> do
1469+-- @'L.Response' 'L.BodyReader'@ that can be passed to 'getHttpResponse' and
1428− chunks <- L.brConsume (L.responseBody response)
1470+-- such.
1429− return response { L.responseBody = B.concat chunks }
1471+
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)
1484+ n <- readIORef nref
1485+ let incn = modifyIORef' nref (+ 1)
1496+ else return leftover
1499+ then return B.empty
1501+ return (target, r { L.responseBody = br' })
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.
1508+ -- ^ Body reader to stream from
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
1518+ then return (r t, r l, True)
1520+ let (target, leftover) = B.splitAt (n - tlen) chunk
1521+ tlen' = B.length 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 [])
1431----------------------------------------------------------------------------
1529----------------------------------------------------------------------------
1432-- Inspecting a response
1530-- Inspecting a response
@@ -1483,8 +1581,9 @@ responseCookieJar = L.responseCookieJar . toVanillaResponse
1483-- To create a new response interpretation you just need to make your data
1581-- To create a new response interpretation you just need to make your data
1484-- type an instance of the 'HttpResponse' type class.
1582-- type an instance of the 'HttpResponse' type class.
1486−-- | A type class for response interpretations. It allows to fully control
1584+-- | A type class for response interpretations. It allows to describe how to
1487−-- how request is made and how its body is parsed.
1585+-- consume response from a @'L.Response' 'L.BodyReader'@ and produce the
1586+-- final result that is to be returned to the user.
1489class HttpResponse response where
1588class HttpResponse response where
@@ -1497,21 +1596,25 @@ class HttpResponse response where
1498 toVanillaResponse :: response -> L.Response (HttpResponseBody response)
1597 toVanillaResponse :: response -> L.Response (HttpResponseBody response)
1500− -- | This method describes how to make an HTTP request given 'L.Request'
1599+ -- | This method describes how to consume response body and, more
1501− -- (prepared by the library) and 'L.Manager'.
1600+ -- generally, obtain @response@ value from @'L.Response' 'L.BodyReader'@.
1503− getHttpResponse :: L.Request -> L.Manager -> IO response
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.
1509− -- __Note__: in versions 0.3.0–0.4.0 this function returned @'IO'
1602+ -- __Note__: 'L.BodyReader' is nothing but @'IO' 'ByteString'@. You should
1510− -- 'ByteString'@.
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.)
1512− -- @since 0.5.0
1610+ -- __Note__: signature of this function was changed in the version
1514− makeResponseBodyPreview :: response -> ByteString
1613+ getHttpResponse
1614+ :: L.Response L.BodyReader
1615+ -- ^ Response with body reader inside
1617+ -- ^ The final result
1516----------------------------------------------------------------------------
1619----------------------------------------------------------------------------
@@ -1556,8 +1659,9 @@ data HttpException
1557instance Exception HttpException
1660instance Exception HttpException
1559−-- | A simple 'Bool'-like type we only have for better error messages. We
1662+-- | A simple type isomorphic to 'Bool' that we only have for better error
1560−-- use it as a kind and its data constructors as type-level tags.
1663+-- messages. We use it as a kind and its data constructors as type-level
1562-- See also: 'HttpMethod' and 'HttpBody'.
1666-- See also: 'HttpMethod' and 'HttpBody'.