    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}
    module Network.HTTP.Client.Response
        ( getRedirectedRequest
        , getResponse
        , lbsResponse
        , getOriginalRequest
        ) where

    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Char8 as S8
    import qualified Data.ByteString.Lazy as L
    import qualified Data.CaseInsensitive as CI
    import Control.Arrow (second)

    import Data.Monoid (mempty)
    import Data.List (nubBy)

    import qualified Network.HTTP.Types as W
    import Network.URI (parseURIReference, escapeURIString, isAllowedInURI)

    import Network.HTTP.Client.Types

    import Network.HTTP.Client.Request
    import Network.HTTP.Client.Util
    import Network.HTTP.Client.Body
    import Network.HTTP.Client.Headers
    import Data.KeyedPool

    -- | If a request is a redirection (status code 3xx) this function will create
    -- a new request from the old request, the server headers returned with the
    -- redirection, and the redirection code itself. This function returns 'Nothing'
    -- if the code is not a 3xx, there is no 'location' header included, or if the
    -- redirected response couldn't be parsed with 'parseRequest'.
    --
    -- If a user of this library wants to know the url chain that results from a
    -- specific request, that user has to re-implement the redirect-following logic
    -- themselves. An example of that might look like this:
    --
    -- > myHttp req man = do
    -- >    (res, redirectRequests) <- (`runStateT` []) $
    -- >         'httpRedirect'
    -- >             9000
    -- >             (\req' -> do
    -- >                res <- http req'{redirectCount=0} man
    -- >                modify (\rqs -> req' : rqs)
    -- >                return (res, getRedirectedRequest req req' (responseHeaders res) (responseCookieJar res) (W.statusCode (responseStatus res))
    -- >                )
    -- >             'lift'
    -- >             req
    -- >    applyCheckStatus (checkStatus req) res
    -- >    return redirectRequests
    getRedirectedRequest :: Request -> Request -> W.ResponseHeaders -> CookieJar -> Int -> Maybe Request
    getRedirectedRequest :: Request
    -> Request -> ResponseHeaders -> CookieJar -> Int -> Maybe Request
    getRedirectedRequest Request
    origReq Request
    req ResponseHeaders
    hs CookieJar
    cookie_jar Int
    code
        | Int
    300 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    code Bool -> Bool -> Bool
    && Int
    code Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    400 = do
            l' <- HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "location" ResponseHeaders
    hs
            let l = (Char -> Bool) -> String -> String
    escapeURIString Char -> Bool
    isAllowedInURI (ByteString -> String
    S8.unpack ByteString
    l')
            req' <- fmap stripHeaders <$> setUriRelative req =<< parseURIReference l
            return $
                if code == 302 || code == 303
                    -- According to the spec, this should *only* be for status code
                    -- 303. However, almost all clients mistakenly implement it for
                    -- 302 as well. So we have to be wrong like everyone else...
                    then req'
                        { method = "GET"
                        , requestBody = RequestBodyBS ""
                        , cookieJar = cookie_jar'
                        , requestHeaders = filter ((/= W.hContentType) . fst) $ requestHeaders req'
                        }
                    else req' {cookieJar = cookie_jar'}
        | Bool
    otherwise = Maybe Request
    forall a. Maybe a
    Nothing
      where
        cookie_jar' :: Maybe CookieJar
        cookie_jar' :: Maybe CookieJar
    cookie_jar' = (CookieJar -> CookieJar) -> Maybe CookieJar -> Maybe CookieJar
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (CookieJar -> CookieJar -> CookieJar
    forall a b. a -> b -> a
    const CookieJar
    cookie_jar) (Maybe CookieJar -> Maybe CookieJar)
    -> Maybe CookieJar -> Maybe CookieJar
    forall a b. (a -> b) -> a -> b
    $ Request -> Maybe CookieJar
    cookieJar Request
    req

        hostDiffer :: Request -> Bool
        hostDiffer :: Request -> Bool
    hostDiffer Request
    req = Request -> ByteString
    host Request
    origReq ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Request -> ByteString
    host Request
    req

        shouldStripOnlyIfHostDiffer :: Bool
        shouldStripOnlyIfHostDiffer :: Bool
    shouldStripOnlyIfHostDiffer = Request -> Bool
    shouldStripHeaderOnRedirectIfOnDifferentHostOnly Request
    req

        mergeHeaders :: W.RequestHeaders -> W.RequestHeaders -> W.RequestHeaders
        mergeHeaders :: ResponseHeaders -> ResponseHeaders -> ResponseHeaders
    mergeHeaders ResponseHeaders
    lhs ResponseHeaders
    rhs = (Header -> Header -> Bool) -> ResponseHeaders -> ResponseHeaders
    forall a. (a -> a -> Bool) -> [a] -> [a]
    nubBy (\(HeaderName
    a, ByteString
    _) (HeaderName
    a', ByteString
    _) -> HeaderName
    a HeaderName -> HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderName
    a') (ResponseHeaders
    lhs ResponseHeaders -> ResponseHeaders -> ResponseHeaders
    forall a. [a] -> [a] -> [a]
    ++ ResponseHeaders
    rhs)

        stripHeaders :: Request -> Request
        stripHeaders :: Request -> Request
    stripHeaders Request
    r = do
            case (Request -> Bool
    hostDiffer Request
    r, Bool
    shouldStripOnlyIfHostDiffer) of
                (Bool
    True, Bool
    True) -> Request -> Request
    stripHeaders' Request
    r
                (Bool
    True, Bool
    False) -> Request -> Request
    stripHeaders' Request
    r
                (Bool
    False, Bool
    False) -> Request -> Request
    stripHeaders' Request
    r
                (Bool
    False, Bool
    True) -> do
                    -- We need to check if we have omitted headers in previous
                    -- request chain. Consider request chain:
                    --
                    --  1. example-1.com
                    --  2. example-2.com (we may have removed some headers here from 1)
                    --  3. example-1.com (since we are back at same host as 1, we need re-add stripped headers)
                    --
                    let strippedHeaders :: ResponseHeaders
    strippedHeaders = (Header -> Bool) -> ResponseHeaders -> ResponseHeaders
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Request -> HeaderName -> Bool
    shouldStripHeaderOnRedirect Request
    r (HeaderName -> Bool) -> (Header -> HeaderName) -> Header -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Header -> HeaderName
    forall a b. (a, b) -> a
    fst) (Request -> ResponseHeaders
    requestHeaders Request
    origReq)
                    Request
    r{requestHeaders = mergeHeaders (requestHeaders r) strippedHeaders}

        stripHeaders' :: Request -> Request
        stripHeaders' :: Request -> Request
    stripHeaders' Request
    r = Request
    r{requestHeaders =
                            filter (not . shouldStripHeaderOnRedirect req . fst) $
                            requestHeaders r}

    -- | Convert a 'Response' that has a 'Source' body to one with a lazy
    -- 'L.ByteString' body.
    lbsResponse :: Response BodyReader -> IO (Response L.ByteString)
    lbsResponse :: Response BodyReader -> IO (Response ByteString)
    lbsResponse Response BodyReader
    res = do
        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
        return res
            { responseBody = L.fromChunks bss
            }

    getResponse :: Maybe MaxHeaderLength
                -> Maybe MaxNumberHeaders
                -> Maybe Int
                -> Request
                -> Managed Connection
                -> Maybe (IO ()) -- ^ Action to run in case of a '100 Continue'.
                -> IO (Response BodyReader)
    getResponse :: Maybe MaxHeaderLength
    -> Maybe MaxNumberHeaders
    -> Maybe Int
    -> Request
    -> Managed Connection
    -> Maybe (IO ())
    -> IO (Response BodyReader)
    getResponse Maybe MaxHeaderLength
    mhl Maybe MaxNumberHeaders
    mnh Maybe Int
    timeout' req :: Request
    req@(Request {Bool
    Int
    ResponseHeaders
    Maybe HostAddress
    Maybe Manager
    Maybe Proxy
    Maybe CookieJar
    ByteString
    Set HeaderName
    HttpVersion
    ResponseTimeout
    RequestBody
    ProxySecureMode
    ResponseHeaders -> IO ()
    SomeException -> IO ()
    ByteString -> Bool
    HeaderName -> Bool
    Request -> Response BodyReader -> IO ()
    method :: Request -> ByteString
    requestBody :: Request -> RequestBody
    cookieJar :: Request -> Maybe CookieJar
    requestHeaders :: Request -> ResponseHeaders
    host :: Request -> ByteString
    shouldStripHeaderOnRedirectIfOnDifferentHostOnly :: Request -> Bool
    shouldStripHeaderOnRedirect :: Request -> HeaderName -> Bool
    method :: ByteString
    secure :: Bool
    host :: ByteString
    port :: Int
    path :: ByteString
    queryString :: ByteString
    requestHeaders :: ResponseHeaders
    requestBody :: RequestBody
    proxy :: Maybe Proxy
    hostAddress :: Maybe HostAddress
    rawBody :: Bool
    decompress :: ByteString -> Bool
    redirectCount :: Int
    checkResponse :: Request -> Response BodyReader -> IO ()
    responseTimeout :: ResponseTimeout
    cookieJar :: Maybe CookieJar
    requestVersion :: HttpVersion
    onRequestBodyException :: SomeException -> IO ()
    requestManagerOverride :: Maybe Manager
    shouldStripHeaderOnRedirect :: HeaderName -> Bool
    shouldStripHeaderOnRedirectIfOnDifferentHostOnly :: Bool
    proxySecureMode :: ProxySecureMode
    redactHeaders :: Set HeaderName
    earlyHintHeadersReceived :: ResponseHeaders -> IO ()
    earlyHintHeadersReceived :: Request -> ResponseHeaders -> IO ()
    redactHeaders :: Request -> Set HeaderName
    proxySecureMode :: Request -> ProxySecureMode
    requestManagerOverride :: Request -> Maybe Manager
    onRequestBodyException :: Request -> SomeException -> IO ()
    requestVersion :: Request -> HttpVersion
    responseTimeout :: Request -> ResponseTimeout
    checkResponse :: Request -> Request -> Response BodyReader -> IO ()
    redirectCount :: Request -> Int
    decompress :: Request -> ByteString -> Bool
    rawBody :: Request -> Bool
    hostAddress :: Request -> Maybe HostAddress
    proxy :: Request -> Maybe Proxy
    queryString :: Request -> ByteString
    path :: Request -> ByteString
    port :: Request -> Int
    secure :: Request -> Bool
    ..}) Managed Connection
    mconn Maybe (IO ())
    cont = do
        let conn :: Connection
    conn = Managed Connection -> Connection
    forall resource. Managed resource -> resource
    managedResource Managed Connection
    mconn
        StatusHeaders s version earlyHs hs <- Maybe MaxHeaderLength
    -> Maybe MaxNumberHeaders
    -> Connection
    -> Maybe Int
    -> (ResponseHeaders -> IO ())
    -> Maybe (IO ())
    -> IO StatusHeaders
    parseStatusHeaders Maybe MaxHeaderLength
    mhl Maybe MaxNumberHeaders
    mnh Connection
    conn Maybe Int
    timeout' ResponseHeaders -> IO ()
    earlyHintHeadersReceived Maybe (IO ())
    cont
        let mcl = HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "content-length" ResponseHeaders
    hs Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Maybe Int
    readPositiveInt (String -> Maybe Int)
    -> (ByteString -> String) -> ByteString -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    S8.unpack
            isChunked = (HeaderName
    "transfer-encoding", ByteString -> HeaderName
    forall s. FoldCase s => s -> CI s
    CI.mk ByteString
    "chunked") (HeaderName, HeaderName) -> [(HeaderName, HeaderName)] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (Header -> (HeaderName, HeaderName))
    -> ResponseHeaders -> [(HeaderName, HeaderName)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((ByteString -> HeaderName) -> Header -> (HeaderName, HeaderName)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ByteString -> HeaderName
    forall s. FoldCase s => s -> CI s
    CI.mk) ResponseHeaders
    hs

            -- should we put this connection back into the connection manager?
            toPut = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "close" Maybe ByteString -> Maybe ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= HeaderName -> ResponseHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "connection" ResponseHeaders
    hs Bool -> Bool -> Bool
    && HttpVersion
    version HttpVersion -> HttpVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int -> Int -> HttpVersion
    W.HttpVersion Int
    1 Int
    0
            cleanup Bool
    bodyConsumed = do
                Managed Connection -> Reuse -> IO ()
    forall resource. Managed resource -> Reuse -> IO ()
    managedRelease Managed Connection
    mconn (Reuse -> IO ()) -> Reuse -> IO ()
    forall a b. (a -> b) -> a -> b
    $ if Bool
    toPut Bool -> Bool -> Bool
    && Bool
    bodyConsumed then Reuse
    Reuse else Reuse
    DontReuse
                -- Keep alive the `Managed Connection` until we're done with it, to prevent an early
                -- collection.
                -- Reasoning: as long as someone holds a reference to the explicit cleanup,
                -- we shouldn't perform an implicit cleanup.
                Managed Connection -> IO ()
    forall resource. Managed resource -> IO ()
    keepAlive Managed Connection
    mconn

        body <-
            -- RFC 2616 section 4.4_1 defines responses that must not include a body
            if hasNoBody method (W.statusCode s) || (mcl == Just 0 && not isChunked)
                then do
                    cleanup True
                    return brEmpty
                else do
                    body1 <-
                        if isChunked
                            then makeChunkedReader mhl (cleanup True) rawBody conn
                            else
                                case mcl of
                                    Just Int
    len -> IO () -> Int -> Connection -> IO BodyReader
    makeLengthReader (Bool -> IO ()
    cleanup Bool
    True) Int
    len Connection
    conn
                                    Maybe Int
    Nothing -> IO () -> Connection -> IO BodyReader
    makeUnlimitedReader (Bool -> IO ()
    cleanup Bool
    True) Connection
    conn
                    if needsGunzip req hs
                        then makeGzipReader body1
                        else return body1

        return Response
            { responseStatus = s
            , responseVersion = version
            , responseHeaders = hs
            , responseBody = body
            , responseCookieJar = Data.Monoid.mempty
            , responseClose' = ResponseClose (cleanup False)
            , responseOriginalRequest = req {requestBody = ""}
            , responseEarlyHints = earlyHs
            }

    -- | Does this response have no body?
    hasNoBody :: ByteString -- ^ request method
              -> Int -- ^ status code
              -> Bool
    hasNoBody :: ByteString -> Int -> Bool
    hasNoBody ByteString
    "HEAD" Int
    _ = Bool
    True
    hasNoBody ByteString
    _ Int
    204 = Bool
    True
    hasNoBody ByteString
    _ Int
    304 = Bool
    True
    hasNoBody ByteString
    _ Int
    i = Int
    100 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    i Bool -> Bool -> Bool
    && Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    200

    -- | Retrieve the orignal 'Request' from a 'Response'
    --
    -- Note that the 'requestBody' is not available and always set to empty.
    --
    -- @since 0.7.8
    getOriginalRequest :: Response a -> Request
    getOriginalRequest :: forall a. Response a -> Request
    getOriginalRequest = Response a -> Request
    forall a. Response a -> Request
    responseOriginalRequest