{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.Core
    ( withResponse
    , httpLbs
    , httpNoBody
    , httpRaw
    , httpRaw'
    , requestAction
    , getModifiedRequestManager
    , responseOpen
    , responseClose
    , httpRedirect
    , httpRedirect'
    , withConnection
    , handleClosedRead
    ) where

import Network.HTTP.Types
import Network.HTTP.Client.Manager
import Network.HTTP.Client.Types
import Network.HTTP.Client.Headers
import Network.HTTP.Client.Body
import Network.HTTP.Client.Request
import Network.HTTP.Client.Response
import Network.HTTP.Client.Cookies
import Data.Maybe (fromMaybe, isJust)
import Data.Time
import Data.IORef
import Control.Exception
import qualified Data.ByteString.Lazy as L
import Data.Monoid
import Control.Monad (void)
import System.Timeout (timeout)
import System.IO.Unsafe (unsafePerformIO)
import Data.KeyedPool
import GHC.IO.Exception (IOException(..), IOErrorType(..))

-- | Perform a @Request@ using a connection acquired from the given @Manager@,
-- and then provide the @Response@ to the given function. This function is
-- fully exception safe, guaranteeing that the response will be closed when the
-- inner function exits. It is defined as:
--
-- > withResponse req man f = bracket (responseOpen req man) responseClose f
--
-- It is recommended that you use this function in place of explicit calls to
-- 'responseOpen' and 'responseClose'.
--
-- You will need to use functions such as 'brRead' to consume the response
-- body.
--
-- Since 0.1.0
withResponse :: Request
             -> Manager
             -> (Response BodyReader -> IO a)
             -> IO a
withResponse :: forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
withResponse Request
req Manager
man Response BodyReader -> IO a
f = IO (Response BodyReader)
-> (Response BodyReader -> IO ())
-> (Response BodyReader -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Request -> Manager -> IO (Response BodyReader)
responseOpen Request
req Manager
man) Response BodyReader -> IO ()
forall a. Response a -> IO ()
responseClose Response BodyReader -> IO a
f

-- | A convenience wrapper around 'withResponse' which reads in the entire
-- response body and immediately closes the connection. Note that this function
-- performs fully strict I\/O, and only uses a lazy ByteString in its response
-- for memory efficiency. If you are anticipating a large response body, you
-- are encouraged to use 'withResponse' and 'brRead' instead.
--
-- Since 0.1.0
httpLbs :: Request -> Manager -> IO (Response L.ByteString)
httpLbs :: Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
man = Request
-> Manager
-> (Response BodyReader -> IO (Response ByteString))
-> IO (Response ByteString)
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
withResponse Request
req Manager
man ((Response BodyReader -> IO (Response ByteString))
 -> IO (Response ByteString))
-> (Response BodyReader -> IO (Response ByteString))
-> IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ \Response BodyReader
res -> do
    [ByteString]
bss <- BodyReader -> IO [ByteString]
brConsume (BodyReader -> IO [ByteString]) -> BodyReader -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ Response BodyReader -> BodyReader
forall body. Response body -> body
responseBody Response BodyReader
res
    Response ByteString -> IO (Response ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
res { responseBody = L.fromChunks bss }

-- | A convenient wrapper around 'withResponse' which ignores the response
-- body. This is useful, for example, when performing a HEAD request.
--
-- Since 0.3.2
httpNoBody :: Request -> Manager -> IO (Response ())
httpNoBody :: Request -> Manager -> IO (Response ())
httpNoBody Request
req Manager
man = Request
-> Manager
-> (Response BodyReader -> IO (Response ()))
-> IO (Response ())
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
withResponse Request
req Manager
man ((Response BodyReader -> IO (Response ())) -> IO (Response ()))
-> (Response BodyReader -> IO (Response ())) -> IO (Response ())
forall a b. (a -> b) -> a -> b
$ Response () -> IO (Response ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response () -> IO (Response ()))
-> (Response BodyReader -> Response ())
-> Response BodyReader
-> IO (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void


-- | Get a 'Response' without any redirect following.
httpRaw
     :: Request
     -> Manager
     -> IO (Response BodyReader)
httpRaw :: Request -> Manager -> IO (Response BodyReader)
httpRaw = (IO (Request, Response BodyReader) -> IO (Response BodyReader))
-> (Manager -> IO (Request, Response BodyReader))
-> Manager
-> IO (Response BodyReader)
forall a b. (a -> b) -> (Manager -> a) -> Manager -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Request, Response BodyReader) -> Response BodyReader)
-> IO (Request, Response BodyReader) -> IO (Response BodyReader)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Request, Response BodyReader) -> Response BodyReader
forall a b. (a, b) -> b
snd) ((Manager -> IO (Request, Response BodyReader))
 -> Manager -> IO (Response BodyReader))
-> (Request -> Manager -> IO (Request, Response BodyReader))
-> Request
-> Manager
-> IO (Response BodyReader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Manager -> IO (Request, Response BodyReader)
httpRaw'

-- | Get a 'Response' without any redirect following.
--
-- This extended version of 'httpRaw' also returns the potentially modified Request.
httpRaw'
     :: Request
     -> Manager
     -> IO (Request, Response BodyReader)
httpRaw' :: Request -> Manager -> IO (Request, Response BodyReader)
httpRaw' Request
req0 Manager
m = do
    let req' :: Request
req' = Manager -> Request -> Request
mSetProxy Manager
m Request
req0
    (Request
req, CookieJar
cookie_jar') <- case Request -> Maybe CookieJar
cookieJar Request
req' of
        Just CookieJar
cj -> do
            UTCTime
now <- IO UTCTime
getCurrentTime
            (Request, CookieJar) -> IO (Request, CookieJar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Request, CookieJar) -> IO (Request, CookieJar))
-> (Request, CookieJar) -> IO (Request, CookieJar)
forall a b. (a -> b) -> a -> b
$ Request -> CookieJar -> UTCTime -> (Request, CookieJar)
insertCookiesIntoRequest Request
req' (CookieJar -> UTCTime -> CookieJar
evictExpiredCookies CookieJar
cj UTCTime
now) UTCTime
now
        Maybe CookieJar
Nothing -> (Request, CookieJar) -> IO (Request, CookieJar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
req', CookieJar
forall a. Monoid a => a
Data.Monoid.mempty)
    Response BodyReader
res <- Request -> Manager -> IO (Response BodyReader)
makeRequest Request
req Manager
m
    case Request -> Maybe CookieJar
cookieJar Request
req' of
        Just CookieJar
_ -> do
            UTCTime
now' <- IO UTCTime
getCurrentTime
            let (CookieJar
cookie_jar, Response BodyReader
_) = Response BodyReader
-> Request
-> UTCTime
-> CookieJar
-> (CookieJar, Response BodyReader)
forall a.
Response a
-> Request -> UTCTime -> CookieJar -> (CookieJar, Response a)
updateCookieJar Response BodyReader
res Request
req UTCTime
now' CookieJar
cookie_jar'
            (Request, Response BodyReader) -> IO (Request, Response BodyReader)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
req, Response BodyReader
res {responseCookieJar = cookie_jar})
        Maybe CookieJar
Nothing -> (Request, Response BodyReader) -> IO (Request, Response BodyReader)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
req, Response BodyReader
res)

makeRequest
    :: Request
    -> Manager
    -> IO (Response BodyReader)
makeRequest :: Request -> Manager -> IO (Response BodyReader)
makeRequest Request
req Manager
m = do
    Request -> Manager -> IO (Response BodyReader)
action <- IORef (Request -> Manager -> IO (Response BodyReader))
-> IO (Request -> Manager -> IO (Response BodyReader))
forall a. IORef a -> IO a
readIORef IORef (Request -> Manager -> IO (Response BodyReader))
requestAction
    Request -> Manager -> IO (Response BodyReader)
action Request
req Manager
m

requestAction :: IORef (Request -> Manager -> IO (Response BodyReader))
{-# NOINLINE requestAction #-}
requestAction :: IORef (Request -> Manager -> IO (Response BodyReader))
requestAction = IO (IORef (Request -> Manager -> IO (Response BodyReader)))
-> IORef (Request -> Manager -> IO (Response BodyReader))
forall a. IO a -> a
unsafePerformIO ((Request -> Manager -> IO (Response BodyReader))
-> IO (IORef (Request -> Manager -> IO (Response BodyReader)))
forall a. a -> IO (IORef a)
newIORef Request -> Manager -> IO (Response BodyReader)
action)
  where
    action
        :: Request
        -> Manager
        -> IO (Response BodyReader)
    action :: Request -> Manager -> IO (Response BodyReader)
action Request
req Manager
m = do
        (Maybe Int
timeout', Managed Connection
mconn) <- Maybe Int
-> IO (Managed Connection) -> IO (Maybe Int, Managed Connection)
forall {a} {resource}.
Integral a =>
Maybe Int
-> IO (Managed resource) -> IO (Maybe a, Managed resource)
getConnectionWrapper
            (Request -> Maybe Int
responseTimeout' Request
req)
            (Request -> Manager -> IO (Managed Connection)
getConn Request
req Manager
m)

        -- Originally, we would only test for exceptions when sending the request,
        -- not on calling @getResponse@. However, some servers seem to close
        -- connections after accepting the request headers, so we need to check for
        -- exceptions in both.
        Either SomeException (Response BodyReader)
ex <- IO (Response BodyReader)
-> IO (Either SomeException (Response BodyReader))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Response BodyReader)
 -> IO (Either SomeException (Response BodyReader)))
-> IO (Response BodyReader)
-> IO (Either SomeException (Response BodyReader))
forall a b. (a -> b) -> a -> b
$ do
            Maybe (IO ())
cont <- Request -> Connection -> IO (Maybe (IO ()))
requestBuilder (Request -> Request
dropProxyAuthSecure Request
req) (Managed Connection -> Connection
forall resource. Managed resource -> resource
managedResource Managed Connection
mconn)

            Maybe MaxHeaderLength
-> Maybe MaxNumberHeaders
-> Maybe Int
-> Request
-> Managed Connection
-> Maybe (IO ())
-> IO (Response BodyReader)
getResponse (Manager -> Maybe MaxHeaderLength
mMaxHeaderLength Manager
m) (Manager -> Maybe MaxNumberHeaders
mMaxNumberHeaders Manager
m) Maybe Int
timeout' Request
req Managed Connection
mconn Maybe (IO ())
cont

        case Either SomeException (Response BodyReader)
ex of
            -- Connection was reused, and might have been closed. Try again
            Left SomeException
e | Managed Connection -> Bool
forall resource. Managed resource -> Bool
managedReused Managed Connection
mconn Bool -> Bool -> Bool
&& Manager -> SomeException -> Bool
mRetryableException Manager
m SomeException
e -> do
                Managed Connection -> Reuse -> IO ()
forall resource. Managed resource -> Reuse -> IO ()
managedRelease Managed Connection
mconn Reuse
DontReuse
                Request -> Manager -> IO (Response BodyReader)
action Request
req Manager
m
            -- Not reused, or a non-retry, so this is a real exception
            Left SomeException
e -> do
              -- Explicitly release connection for all real exceptions:
              -- https://github.com/snoyberg/http-client/pull/454
              Managed Connection -> Reuse -> IO ()
forall resource. Managed resource -> Reuse -> IO ()
managedRelease Managed Connection
mconn Reuse
DontReuse
              SomeException -> IO (Response BodyReader)
forall e a. Exception e => e -> IO a
throwIO SomeException
e
            -- Everything went ok, so the connection is good. If any exceptions get
            -- thrown in the response body, just throw them as normal.
            Right Response BodyReader
res -> Response BodyReader -> IO (Response BodyReader)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
res
      where
        getConnectionWrapper :: Maybe Int
-> IO (Managed resource) -> IO (Maybe a, Managed resource)
getConnectionWrapper Maybe Int
mtimeout IO (Managed resource)
f =
            case Maybe Int
mtimeout of
                Maybe Int
Nothing -> (Managed resource -> (Maybe a, Managed resource))
-> IO (Managed resource) -> IO (Maybe a, Managed resource)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Maybe a
forall a. Maybe a
Nothing) IO (Managed resource)
f
                Just Int
timeout' -> do
                    UTCTime
before <- IO UTCTime
getCurrentTime
                    Maybe (Managed resource)
mres <- Int -> IO (Managed resource) -> IO (Maybe (Managed resource))
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
timeout' IO (Managed resource)
f
                    case Maybe (Managed resource)
mres of
                        Maybe (Managed resource)
Nothing -> HttpExceptionContent -> IO (Maybe a, Managed resource)
forall a. HttpExceptionContent -> IO a
throwHttp HttpExceptionContent
ConnectionTimeout
                        Just Managed resource
mConn -> do
                            UTCTime
now <- IO UTCTime
getCurrentTime
                            let timeSpentMicro :: NominalDiffTime
timeSpentMicro = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
before NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
1000000
                                remainingTime :: a
remainingTime = NominalDiffTime -> a
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (NominalDiffTime -> a) -> NominalDiffTime -> a
forall a b. (a -> b) -> a -> b
$ Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timeout' NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
timeSpentMicro
                            if a
remainingTime a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0
                                then do
                                    Managed resource -> Reuse -> IO ()
forall resource. Managed resource -> Reuse -> IO ()
managedRelease Managed resource
mConn Reuse
DontReuse
                                    HttpExceptionContent -> IO (Maybe a, Managed resource)
forall a. HttpExceptionContent -> IO a
throwHttp HttpExceptionContent
ConnectionTimeout
                                else (Maybe a, Managed resource) -> IO (Maybe a, Managed resource)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
remainingTime, Managed resource
mConn)

        responseTimeout' :: Request -> Maybe Int
responseTimeout' Request
req =
            case Request -> ResponseTimeout
responseTimeout Request
req of
                ResponseTimeout
ResponseTimeoutDefault ->
                    case Manager -> ResponseTimeout
mResponseTimeout Manager
m of
                        ResponseTimeout
ResponseTimeoutDefault -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
30000000
                        ResponseTimeout
ResponseTimeoutNone -> Maybe Int
forall a. Maybe a
Nothing
                        ResponseTimeoutMicro Int
u -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
u
                ResponseTimeout
ResponseTimeoutNone -> Maybe Int
forall a. Maybe a
Nothing
                ResponseTimeoutMicro Int
u -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
u

-- | The used Manager can be overridden (by requestManagerOverride) and the used
-- Request can be modified (through managerModifyRequest). This function allows
-- to retrieve the possibly overridden Manager and the possibly modified
-- Request.
--
-- (In case the Manager is overridden by requestManagerOverride, the Request is
-- being modified by managerModifyRequest of the new Manager, not the old one.)
getModifiedRequestManager :: Manager -> Request -> IO (Manager, Request)
getModifiedRequestManager :: Manager -> Request -> IO (Manager, Request)
getModifiedRequestManager Manager
manager0 Request
req0 = do
  let manager :: Manager
manager = Manager -> Maybe Manager -> Manager
forall a. a -> Maybe a -> a
fromMaybe Manager
manager0 (Request -> Maybe Manager
requestManagerOverride Request
req0)
  Request
req <- Manager -> Request -> IO Request
mModifyRequest Manager
manager Request
req0
  (Manager, Request) -> IO (Manager, Request)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Manager
manager, Request
req)

-- | The most low-level function for initiating an HTTP request.
--
-- The first argument to this function gives a full specification
-- on the request: the host to connect to, whether to use SSL,
-- headers, etc. Please see 'Request' for full details.  The
-- second argument specifies which 'Manager' should be used.
--
-- This function then returns a 'Response' with a
-- 'BodyReader'.  The 'Response' contains the status code
-- and headers that were sent back to us, and the
-- 'BodyReader' contains the body of the request.  Note
-- that this 'BodyReader' allows you to have fully
-- interleaved IO actions during your HTTP download, making it
-- possible to download very large responses in constant memory.
--
-- An important note: the response body returned by this function represents a
-- live HTTP connection. As such, if you do not use the response body, an open
-- socket will be retained indefinitely. You must be certain to call
-- 'responseClose' on this response to free up resources.
--
-- This function automatically performs any necessary redirects, as specified
-- by the 'redirectCount' setting.
--
-- When implementing a (reverse) proxy using this function or relating
-- functions, it's wise to remove Transfer-Encoding:, Content-Length:,
-- Content-Encoding: and Accept-Encoding: from request and response
-- headers to be relayed.
--
-- Since 0.1.0
responseOpen :: Request -> Manager -> IO (Response BodyReader)
responseOpen :: Request -> Manager -> IO (Response BodyReader)
responseOpen Request
inputReq Manager
manager' = do
  case RequestHeaders -> HeadersValidationResult
validateHeaders (Request -> RequestHeaders
requestHeaders Request
inputReq) of
    HeadersValidationResult
GoodHeaders -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    BadHeaders ByteString
reason -> HttpExceptionContent -> IO ()
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> IO ()) -> HttpExceptionContent -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> HttpExceptionContent
InvalidRequestHeader ByteString
reason
  (Manager
manager, Request
req0) <- Manager -> Request -> IO (Manager, Request)
getModifiedRequestManager Manager
manager' Request
inputReq
  Request -> IO (Response BodyReader) -> IO (Response BodyReader)
forall a. Request -> IO a -> IO a
wrapExc Request
req0 (IO (Response BodyReader) -> IO (Response BodyReader))
-> IO (Response BodyReader) -> IO (Response BodyReader)
forall a b. (a -> b) -> a -> b
$ Manager -> forall a. Request -> IO a -> IO a
mWrapException Manager
manager Request
req0 (IO (Response BodyReader) -> IO (Response BodyReader))
-> IO (Response BodyReader) -> IO (Response BodyReader)
forall a b. (a -> b) -> a -> b
$ do
    (Request
req, Response BodyReader
res) <- Manager -> Int -> Request -> IO (Request, Response BodyReader)
go Manager
manager (Request -> Int
redirectCount Request
req0) Request
req0
    Request -> Request -> Response BodyReader -> IO ()
checkResponse Request
req Request
req Response BodyReader
res
    Manager -> Response BodyReader -> IO (Response BodyReader)
mModifyResponse Manager
manager Response BodyReader
res
        { responseBody = wrapExc req0 (responseBody res)
        }
  where
    wrapExc :: Request -> IO a -> IO a
    wrapExc :: forall a. Request -> IO a -> IO a
wrapExc Request
req0 = (HttpExceptionContentWrapper -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((HttpExceptionContentWrapper -> IO a) -> IO a -> IO a)
-> (HttpExceptionContentWrapper -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ HttpException -> IO a
forall e a. Exception e => e -> IO a
throwIO (HttpException -> IO a)
-> (HttpExceptionContentWrapper -> HttpException)
-> HttpExceptionContentWrapper
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> HttpExceptionContentWrapper -> HttpException
toHttpException Request
req0

    go :: Manager -> Int -> Request -> IO (Request, Response BodyReader)
go Manager
manager0 Int
count Request
req' = Int
-> (Request -> IO (Response BodyReader, Request, Bool))
-> Request
-> IO (Request, Response BodyReader)
httpRedirect'
      Int
count
      (\Request
req -> do
        (Manager
manager, Request
modReq) <- Manager -> Request -> IO (Manager, Request)
getModifiedRequestManager Manager
manager0 Request
req
        (Request
req'', Response BodyReader
res) <- Request -> Manager -> IO (Request, Response BodyReader)
httpRaw' Request
modReq Manager
manager
        let mreq :: Maybe Request
mreq = if Request -> Int
redirectCount Request
modReq Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
              then Maybe Request
forall a. Maybe a
Nothing
              else Request
-> Request -> RequestHeaders -> CookieJar -> Int -> Maybe Request
getRedirectedRequest Request
req' Request
req'' (Response BodyReader -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders Response BodyReader
res) (Response BodyReader -> CookieJar
forall body. Response body -> CookieJar
responseCookieJar Response BodyReader
res) (Status -> Int
statusCode (Response BodyReader -> Status
forall body. Response body -> Status
responseStatus Response BodyReader
res))
        (Response BodyReader, Request, Bool)
-> IO (Response BodyReader, Request, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response BodyReader
res, Request -> Maybe Request -> Request
forall a. a -> Maybe a -> a
fromMaybe Request
req'' Maybe Request
mreq, Maybe Request -> Bool
forall a. Maybe a -> Bool
isJust Maybe Request
mreq))
      Request
req'

-- | Redirect loop.
httpRedirect
     :: Int -- ^ 'redirectCount'
     -> (Request -> IO (Response BodyReader, Maybe Request)) -- ^ function which performs a request and returns a response, and possibly another request if there's a redirect.
     -> Request
     -> IO (Response BodyReader)
httpRedirect :: Int
-> (Request -> IO (Response BodyReader, Maybe Request))
-> Request
-> IO (Response BodyReader)
httpRedirect Int
count0 Request -> IO (Response BodyReader, Maybe Request)
http0 Request
req0 = ((Request, Response BodyReader) -> Response BodyReader)
-> IO (Request, Response BodyReader) -> IO (Response BodyReader)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Request, Response BodyReader) -> Response BodyReader
forall a b. (a, b) -> b
snd (IO (Request, Response BodyReader) -> IO (Response BodyReader))
-> IO (Request, Response BodyReader) -> IO (Response BodyReader)
forall a b. (a -> b) -> a -> b
$ Int
-> (Request -> IO (Response BodyReader, Request, Bool))
-> Request
-> IO (Request, Response BodyReader)
httpRedirect' Int
count0 Request -> IO (Response BodyReader, Request, Bool)
http' Request
req0
  where
    -- adapt callback API
    http' :: Request -> IO (Response BodyReader, Request, Bool)
http' Request
req' = do
        (Response BodyReader
res, Maybe Request
mbReq) <- Request -> IO (Response BodyReader, Maybe Request)
http0 Request
req'
        (Response BodyReader, Request, Bool)
-> IO (Response BodyReader, Request, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response BodyReader
res, Request -> Maybe Request -> Request
forall a. a -> Maybe a -> a
fromMaybe Request
req0 Maybe Request
mbReq, Maybe Request -> Bool
forall a. Maybe a -> Bool
isJust Maybe Request
mbReq)

handleClosedRead :: SomeException -> IO L.ByteString
handleClosedRead :: SomeException -> IO ByteString
handleClosedRead SomeException
se
    | Just HttpExceptionContent
ConnectionClosed <- (HttpExceptionContentWrapper -> HttpExceptionContent)
-> Maybe HttpExceptionContentWrapper -> Maybe HttpExceptionContent
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HttpExceptionContentWrapper -> HttpExceptionContent
unHttpExceptionContentWrapper (SomeException -> Maybe HttpExceptionContentWrapper
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se)
        = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty
    | Just (HttpExceptionRequest Request
_ HttpExceptionContent
ConnectionClosed) <- SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se
        = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty
    | Just (IOError Maybe Handle
_ IOErrorType
ResourceVanished String
_ String
_ Maybe CInt
_ Maybe String
_) <- SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se
        = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty
    | Bool
otherwise
        = SomeException -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO SomeException
se

-- | Redirect loop.
--
-- This extended version of 'httpRaw' also returns the Request potentially modified by @managerModifyRequest@.
httpRedirect'
     :: Int -- ^ 'redirectCount'
     -> (Request -> IO (Response BodyReader, Request, Bool)) -- ^ function which performs a request and returns a response, the potentially modified request, and a Bool indicating if there was a redirect.
     -> Request
     -> IO (Request, Response BodyReader)
httpRedirect' :: Int
-> (Request -> IO (Response BodyReader, Request, Bool))
-> Request
-> IO (Request, Response BodyReader)
httpRedirect' Int
count0 Request -> IO (Response BodyReader, Request, Bool)
http' Request
req0 = Int
-> Request
-> [Response ByteString]
-> IO (Request, Response BodyReader)
forall {t}.
(Ord t, Num t) =>
t
-> Request
-> [Response ByteString]
-> IO (Request, Response BodyReader)
go Int
count0 Request
req0 []
  where
    go :: t
-> Request
-> [Response ByteString]
-> IO (Request, Response BodyReader)
go t
count Request
_ [Response ByteString]
ress | t
count t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0 = HttpExceptionContent -> IO (Request, Response BodyReader)
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> IO (Request, Response BodyReader))
-> HttpExceptionContent -> IO (Request, Response BodyReader)
forall a b. (a -> b) -> a -> b
$ [Response ByteString] -> HttpExceptionContent
TooManyRedirects [Response ByteString]
ress
    go t
count Request
req' [Response ByteString]
ress = do
        (Response BodyReader
res, Request
req, Bool
isRedirect) <- Request -> IO (Response BodyReader, Request, Bool)
http' Request
req'
        if Bool
isRedirect then do
            -- Allow the original connection to return to the
            -- connection pool immediately by flushing the body.
            -- If the response body is too large, don't flush, but
            -- instead just close the connection.
            let maxFlush :: Int
maxFlush = Int
1024
            ByteString
lbs <- BodyReader -> Int -> IO ByteString
brReadSome (Response BodyReader -> BodyReader
forall body. Response body -> body
responseBody Response BodyReader
res) Int
maxFlush
                -- The connection may already be closed, e.g.
                -- when using withResponseHistory. See
                -- https://github.com/snoyberg/http-client/issues/169
                IO ByteString -> (SomeException -> IO ByteString) -> IO ByteString
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Control.Exception.catch` SomeException -> IO ByteString
handleClosedRead
            Response BodyReader -> IO ()
forall a. Response a -> IO ()
responseClose Response BodyReader
res

            -- And now perform the actual redirect
            t
-> Request
-> [Response ByteString]
-> IO (Request, Response BodyReader)
go (t
count t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Request
req (Response BodyReader
res { responseBody = lbs }Response ByteString
-> [Response ByteString] -> [Response ByteString]
forall a. a -> [a] -> [a]
:[Response ByteString]
ress)
        else
            (Request, Response BodyReader) -> IO (Request, Response BodyReader)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
req, Response BodyReader
res)

-- | Close any open resources associated with the given @Response@. In general,
-- this will either close an active @Connection@ or return it to the @Manager@
-- to be reused.
--
-- Since 0.1.0
responseClose :: Response a -> IO ()
responseClose :: forall a. Response a -> IO ()
responseClose = ResponseClose -> IO ()
runResponseClose (ResponseClose -> IO ())
-> (Response a -> ResponseClose) -> Response a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response a -> ResponseClose
forall body. Response body -> ResponseClose
responseClose'

-- | Perform an action using a @Connection@ acquired from the given @Manager@.
--
-- You should use this only when you have to read and write interactively
-- through the connection (e.g. connection by the WebSocket protocol).
--
-- @since 0.5.13
withConnection :: Request -> Manager -> (Connection -> IO a) -> IO a
withConnection :: forall a. Request -> Manager -> (Connection -> IO a) -> IO a
withConnection Request
origReq Manager
man Connection -> IO a
action = do
    Managed Connection
mHttpConn <- Request -> Manager -> IO (Managed Connection)
getConn (Manager -> Request -> Request
mSetProxy Manager
man Request
origReq) Manager
man
    Connection -> IO a
action (Managed Connection -> Connection
forall resource. Managed resource -> resource
managedResource Managed Connection
mHttpConn) IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Managed Connection -> IO ()
forall resource. Managed resource -> IO ()
keepAlive Managed Connection
mHttpConn
        IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Managed Connection -> Reuse -> IO ()
forall resource. Managed resource -> Reuse -> IO ()
managedRelease Managed Connection
mHttpConn Reuse
DontReuse