    {-# LANGUAGE DeriveGeneric         #-}
    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings     #-}
    {-# LANGUAGE ScopedTypeVariables   #-}
    {-# LANGUAGE LambdaCase            #-}
    {-# LANGUAGE TupleSections         #-}
    {-# LANGUAGE CPP                   #-}

    module Network.HTTP.ReverseProxy
        ( -- * Types
          ProxyDest (..)
          -- * Raw
        , rawProxyTo
        , rawTcpProxyTo
          -- * WAI + http-conduit
        , waiProxyTo
        , defaultOnExc
        , waiProxyToSettings
        , WaiProxyResponse (..)
          -- ** Settings
        , WaiProxySettings
        , defaultWaiProxySettings
        , wpsOnExc
        , wpsTimeout
        , wpsSetIpHeader
        , wpsProcessBody
        , wpsUpgradeToRaw
        , wpsGetDest
        , wpsLogRequest
        , wpsModifyResponseHeaders
        , SetIpHeader (..)
          -- *** Local settings
        , LocalWaiProxySettings
        , defaultLocalWaiProxySettings
        , setLpsTimeBound
        {- FIXME
          -- * WAI to Raw
        , waiToRaw
        -}
        ) where

    import           Blaze.ByteString.Builder       (Builder, fromByteString,
                                                     toLazyByteString)
    import           Control.Applicative            ((<$>), (<|>))
    import           Control.Monad                  (unless)
    import           Data.ByteString                (ByteString)
    import qualified Data.ByteString                as S
    import qualified Data.ByteString.Char8          as S8
    import qualified Data.ByteString.Lazy           as L
    import qualified Data.CaseInsensitive           as CI
    import           Data.Conduit
    import qualified Data.Conduit.List              as CL
    import qualified Data.Conduit.Network           as DCN
    import           Data.Functor.Identity          (Identity (..))
    import           Data.IORef
    import           Data.List.NonEmpty             (NonEmpty (..))
    import qualified Data.List.NonEmpty             as NE
    import           Data.Maybe                     (fromMaybe, isNothing, listToMaybe)
    import           Data.Monoid                    (mappend, mconcat, (<>))
    import           Data.Set                       (Set)
    import qualified Data.Set                       as Set
    import           Data.Streaming.Network         (AppData, readLens)
    import qualified Data.Text.Lazy                 as TL
    import qualified Data.Text.Lazy.Encoding        as TLE
    import qualified Data.Text                      as T
    import           Data.Word8                     (isSpace, _colon, _cr)
    import           GHC.Generics                   (Generic)
    import           Network.HTTP.Client            (BodyReader, brRead)
    import qualified Network.HTTP.Client            as HC
    import qualified Network.HTTP.Types             as HT
    import qualified Network.Wai                    as WAI
    import           Network.Wai.Logger             (showSockAddr)
    import           UnliftIO                       (MonadIO, liftIO, MonadUnliftIO, timeout, SomeException, try, bracket, concurrently_)

    -- | Host\/port combination to which we want to proxy.
    data ProxyDest = ProxyDest
        { ProxyDest -> ByteString
    pdHost :: !ByteString
        , ProxyDest -> Int
    pdPort :: !Int
        } deriving (ReadPrec [ProxyDest]
    ReadPrec ProxyDest
    Int -> ReadS ProxyDest
    ReadS [ProxyDest]
    (Int -> ReadS ProxyDest)
    -> ReadS [ProxyDest]
    -> ReadPrec ProxyDest
    -> ReadPrec [ProxyDest]
    -> Read ProxyDest
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS ProxyDest
    readsPrec :: Int -> ReadS ProxyDest
    $creadList :: ReadS [ProxyDest]
    readList :: ReadS [ProxyDest]
    $creadPrec :: ReadPrec ProxyDest
    readPrec :: ReadPrec ProxyDest
    $creadListPrec :: ReadPrec [ProxyDest]
    readListPrec :: ReadPrec [ProxyDest]
    Read, Int -> ProxyDest -> ShowS
    [ProxyDest] -> ShowS
    ProxyDest -> String
    (Int -> ProxyDest -> ShowS)
    -> (ProxyDest -> String)
    -> ([ProxyDest] -> ShowS)
    -> Show ProxyDest
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ProxyDest -> ShowS
    showsPrec :: Int -> ProxyDest -> ShowS
    $cshow :: ProxyDest -> String
    show :: ProxyDest -> String
    $cshowList :: [ProxyDest] -> ShowS
    showList :: [ProxyDest] -> ShowS
    Show, ProxyDest -> ProxyDest -> Bool
    (ProxyDest -> ProxyDest -> Bool)
    -> (ProxyDest -> ProxyDest -> Bool) -> Eq ProxyDest
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ProxyDest -> ProxyDest -> Bool
    == :: ProxyDest -> ProxyDest -> Bool
    $c/= :: ProxyDest -> ProxyDest -> Bool
    /= :: ProxyDest -> ProxyDest -> Bool
    Eq, Eq ProxyDest
    Eq ProxyDest =>
    (ProxyDest -> ProxyDest -> Ordering)
    -> (ProxyDest -> ProxyDest -> Bool)
    -> (ProxyDest -> ProxyDest -> Bool)
    -> (ProxyDest -> ProxyDest -> Bool)
    -> (ProxyDest -> ProxyDest -> Bool)
    -> (ProxyDest -> ProxyDest -> ProxyDest)
    -> (ProxyDest -> ProxyDest -> ProxyDest)
    -> Ord ProxyDest
    ProxyDest -> ProxyDest -> Bool
    ProxyDest -> ProxyDest -> Ordering
    ProxyDest -> ProxyDest -> ProxyDest
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ProxyDest -> ProxyDest -> Ordering
    compare :: ProxyDest -> ProxyDest -> Ordering
    $c< :: ProxyDest -> ProxyDest -> Bool
    < :: ProxyDest -> ProxyDest -> Bool
    $c<= :: ProxyDest -> ProxyDest -> Bool
    <= :: ProxyDest -> ProxyDest -> Bool
    $c> :: ProxyDest -> ProxyDest -> Bool
    > :: ProxyDest -> ProxyDest -> Bool
    $c>= :: ProxyDest -> ProxyDest -> Bool
    >= :: ProxyDest -> ProxyDest -> Bool
    $cmax :: ProxyDest -> ProxyDest -> ProxyDest
    max :: ProxyDest -> ProxyDest -> ProxyDest
    $cmin :: ProxyDest -> ProxyDest -> ProxyDest
    min :: ProxyDest -> ProxyDest -> ProxyDest
    Ord, (forall x. ProxyDest -> Rep ProxyDest x)
    -> (forall x. Rep ProxyDest x -> ProxyDest) -> Generic ProxyDest
    forall x. Rep ProxyDest x -> ProxyDest
    forall x. ProxyDest -> Rep ProxyDest x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ProxyDest -> Rep ProxyDest x
    from :: forall x. ProxyDest -> Rep ProxyDest x
    $cto :: forall x. Rep ProxyDest x -> ProxyDest
    to :: forall x. Rep ProxyDest x -> ProxyDest
    Generic)

    -- | Trim optional whitespace (OWS) from both ends of a strict 'ByteString'.

    -- Per RFC 7230 §3.2.3, OWS = SP / HTAB. This function removes only leading
    -- and trailing space (0x20) and horizontal tab (0x09) bytes. It does not
    -- modify internal whitespace.

    -- On newer @bytestring@ versions (those that provide
    -- 'Data.ByteString.Char8.strip') this is a thin wrapper around that
    -- function; on older versions we provide a compatible fallback.
    trimOWS :: S8.ByteString -> S8.ByteString
    #if MIN_VERSION_bytestring(0,12,0)
    trimOWS :: ByteString -> ByteString
    trimOWS = ByteString -> ByteString
    S8.strip
    #else
    trimOWS = S8.reverse . S8.dropWhile isOWS . S8.reverse . S8.dropWhile isOWS
      where isOWS c = c == ' ' || c == '\t'
    #endif

    -- | Set up a reverse proxy server, which will have a minimal overhead.
    --
    -- This function uses raw sockets, parsing as little of the request as
    -- possible. The workflow is:
    --
    -- 1. Parse the first request headers.
    --
    -- 2. Ask the supplied function to specify how to reverse proxy.
    --
    -- 3. Open up a connection to the given host\/port.
    --
    -- 4. Pass all bytes across the wire unchanged.
    --
    -- If you need more control, such as modifying the request or response, use 'waiProxyTo'.
    rawProxyTo :: MonadUnliftIO m
               => (HT.RequestHeaders -> m (Either (DCN.AppData -> m ()) ProxyDest))
               -- ^ How to reverse proxy. A @Left@ result will run the given
               -- 'DCN.Application', whereas a @Right@ will reverse proxy to the
               -- given host\/port.
               -> AppData -> m ()
    rawProxyTo :: forall (m :: * -> *).
    MonadUnliftIO m =>
    (RequestHeaders -> m (Either (AppData -> m ()) ProxyDest))
    -> AppData -> m ()
    rawProxyTo RequestHeaders -> m (Either (AppData -> m ()) ProxyDest)
    getDest AppData
    appdata = do
        (rsrc, headers) <- IO (SealedConduitT () ByteString IO (), RequestHeaders)
    -> m (SealedConduitT () ByteString IO (), RequestHeaders)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (SealedConduitT () ByteString IO (), RequestHeaders)
     -> m (SealedConduitT () ByteString IO (), RequestHeaders))
    -> IO (SealedConduitT () ByteString IO (), RequestHeaders)
    -> m (SealedConduitT () ByteString IO (), RequestHeaders)
    forall a b. (a -> b) -> a -> b
    $ ConduitT () ByteString IO ()
    forall {i}. ConduitT i ByteString IO ()
    fromClient ConduitT () ByteString IO ()
    -> ConduitT ByteString Void IO RequestHeaders
    -> IO (SealedConduitT () ByteString IO (), RequestHeaders)
    forall (m :: * -> *) a b.
    Monad m =>
    ConduitT () a m ()
    -> ConduitT a Void m b -> m (SealedConduitT () a m (), b)
    $$+ ConduitT ByteString Void IO RequestHeaders
    forall (m :: * -> *) o.
    Monad m =>
    ConduitT ByteString o m RequestHeaders
    getHeaders
        edest <- getDest headers
        case edest of
            Left AppData -> m ()
    app -> do
                -- We know that the socket will be closed by the toClient side, so
                -- we can throw away the finalizer here.
                irsrc <- IO (IORef (SealedConduitT () ByteString IO ()))
    -> m (IORef (SealedConduitT () ByteString IO ()))
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef (SealedConduitT () ByteString IO ()))
     -> m (IORef (SealedConduitT () ByteString IO ())))
    -> IO (IORef (SealedConduitT () ByteString IO ()))
    -> m (IORef (SealedConduitT () ByteString IO ()))
    forall a b. (a -> b) -> a -> b
    $ SealedConduitT () ByteString IO ()
    -> IO (IORef (SealedConduitT () ByteString IO ()))
    forall a. a -> IO (IORef a)
    newIORef SealedConduitT () ByteString IO ()
    rsrc
                let readData = do
                        rsrc1 <- IORef (SealedConduitT () ByteString IO ())
    -> IO (SealedConduitT () ByteString IO ())
    forall a. IORef a -> IO a
    readIORef IORef (SealedConduitT () ByteString IO ())
    irsrc
                        (rsrc2, mbs) <- rsrc1 $$++ await
                        writeIORef irsrc rsrc2
                        return $ fromMaybe "" mbs
                app $ runIdentity (readLens (const (Identity readData)) appdata)

            Right (ProxyDest ByteString
    host Int
    port) -> IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ ClientSettings -> (AppData -> IO ()) -> IO ()
    forall a. ClientSettings -> (AppData -> IO a) -> IO a
    DCN.runTCPClient (Int -> ByteString -> ClientSettings
    DCN.clientSettings Int
    port ByteString
    host) (SealedConduitT () ByteString IO () -> AppData -> IO ()
    forall {p}.
    HasReadWrite p =>
    SealedConduitT () ByteString IO () -> p -> IO ()
    withServer SealedConduitT () ByteString IO ()
    rsrc)
      where
        fromClient :: ConduitT i ByteString IO ()
    fromClient = AppData -> ConduitT i ByteString IO ()
    forall ad (m :: * -> *) i.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT i ByteString m ()
    DCN.appSource AppData
    appdata
        toClient :: ConduitT ByteString o IO ()
    toClient = AppData -> ConduitT ByteString o IO ()
    forall ad (m :: * -> *) o.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT ByteString o m ()
    DCN.appSink AppData
    appdata
        withServer :: SealedConduitT () ByteString IO () -> p -> IO ()
    withServer SealedConduitT () ByteString IO ()
    rsrc p
    appdataServer = IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
    concurrently_
            (SealedConduitT () ByteString IO ()
    rsrc SealedConduitT () ByteString IO ()
    -> ConduitT ByteString Void IO () -> IO ()
    forall (m :: * -> *) a b.
    Monad m =>
    SealedConduitT () a m () -> ConduitT a Void m b -> m b
    $$+- ConduitT ByteString Void IO ()
    forall {o}. ConduitT ByteString o IO ()
    toServer)
            (ConduitT () Void IO () -> IO ()
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void IO () -> IO ())
    -> ConduitT () Void IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ConduitT () ByteString IO ()
    forall {i}. ConduitT i ByteString IO ()
    fromServer ConduitT () ByteString IO ()
    -> ConduitT ByteString Void IO () -> ConduitT () Void IO ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Void IO ()
    forall {o}. ConduitT ByteString o IO ()
    toClient)
          where
            fromServer :: ConduitT i ByteString IO ()
    fromServer = p -> ConduitT i ByteString IO ()
    forall ad (m :: * -> *) i.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT i ByteString m ()
    DCN.appSource p
    appdataServer
            toServer :: ConduitT ByteString o IO ()
    toServer = p -> ConduitT ByteString o IO ()
    forall ad (m :: * -> *) o.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT ByteString o m ()
    DCN.appSink p
    appdataServer

    -- | Set up a reverse tcp proxy server, which will have a minimal overhead.
    --
    -- This function uses raw sockets, parsing as little of the request as
    -- possible. The workflow is:
    --
    -- 1. Open up a connection to the given host\/port.
    --
    -- 2. Pass all bytes across the wire unchanged.
    --
    -- If you need more control, such as modifying the request or response, use 'waiProxyTo'.
    --
    -- @since 0.4.4
    rawTcpProxyTo :: MonadIO m
               => ProxyDest
               -> AppData
               -> m ()
    rawTcpProxyTo :: forall (m :: * -> *). MonadIO m => ProxyDest -> AppData -> m ()
    rawTcpProxyTo (ProxyDest ByteString
    host Int
    port) AppData
    appdata = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $
        ClientSettings -> (AppData -> IO ()) -> IO ()
    forall a. ClientSettings -> (AppData -> IO a) -> IO a
    DCN.runTCPClient (Int -> ByteString -> ClientSettings
    DCN.clientSettings Int
    port ByteString
    host) AppData -> IO ()
    forall {m :: * -> *} {ad}.
    (MonadUnliftIO m, HasReadWrite ad) =>
    ad -> m ()
    withServer
      where
        withServer :: ad -> m ()
    withServer ad
    appdataServer = m () -> m () -> m ()
    forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
    concurrently_
          (ConduitT () Void m () -> m ()
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ AppData -> ConduitT () ByteString m ()
    forall ad (m :: * -> *) i.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT i ByteString m ()
    DCN.appSource AppData
    appdata       ConduitT () ByteString m ()
    -> ConduitT ByteString Void m () -> ConduitT () Void m ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ad -> ConduitT ByteString Void m ()
    forall ad (m :: * -> *) o.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT ByteString o m ()
    DCN.appSink ad
    appdataServer)
          (ConduitT () Void m () -> m ()
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ ad -> ConduitT () ByteString m ()
    forall ad (m :: * -> *) i.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT i ByteString m ()
    DCN.appSource ad
    appdataServer ConduitT () ByteString m ()
    -> ConduitT ByteString Void m () -> ConduitT () Void m ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| AppData -> ConduitT ByteString Void m ()
    forall ad (m :: * -> *) o.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT ByteString o m ()
    DCN.appSink AppData
    appdata      )

    -- | Sends a simple 502 bad gateway error message with the contents of the
    -- exception.
    defaultOnExc :: SomeException -> WAI.Application
    defaultOnExc :: SomeException -> Application
    defaultOnExc SomeException
    exc Request
    _ Response -> IO ResponseReceived
    sendResponse = Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> RequestHeaders -> ByteString -> Response
    WAI.responseLBS
        Status
    HT.status502
        [(HeaderName
    "content-type", ByteString
    "text/plain")]
        (ByteString
    "Error connecting to gateway:\n\n" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> Text -> ByteString
    TLE.encodeUtf8 (String -> Text
    TL.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    exc))

    -- | The different responses that could be generated by a @waiProxyTo@ lookup
    -- function.
    --
    -- @since 0.2.0
    data WaiProxyResponse = WPRResponse WAI.Response
                            -- ^ Respond with the given WAI Response.
                            --
                            -- @since 0.2.0
                          | WPRProxyDest ProxyDest
                            -- ^ Send to the given destination.
                            --
                            -- @since 0.2.0
                          | WPRProxyDestSecure ProxyDest
                            -- ^ Send to the given destination via HTTPS.
                          | WPRModifiedRequest WAI.Request ProxyDest
                            -- ^ Send to the given destination, but use the given
                            -- modified Request for computing the reverse-proxied
                            -- request. This can be useful for reverse proxying to
                            -- a different path than the one specified. By the
                            -- user.
                            -- The path will be taken from rawPathInfo while
                            -- the queryString from rawQueryString of the
                            -- request.
                            --
                            -- @since 0.2.0
                          | WPRModifiedRequestSecure WAI.Request ProxyDest
                            -- ^ Same as WPRModifiedRequest but send to the
                            -- given destination via HTTPS.
                          | WPRApplication WAI.Application
                            -- ^ Respond with the given WAI Application.
                            --
                            -- @since 0.4.0

    -- | Creates a WAI 'WAI.Application' which will handle reverse proxies.
    --
    -- Connections to the proxied server will be provided via http-conduit. As
    -- such, all requests and responses will be fully processed in your reverse
    -- proxy. This allows you much more control over the data sent over the wire,
    -- but also incurs overhead. For a lower-overhead approach, consider
    -- 'rawProxyTo'.
    --
    -- Most likely, the given application should be run with Warp, though in theory
    -- other WAI handlers will work as well.
    --
    -- Note: This function will use chunked request bodies for communicating with
    -- the proxied server. Not all servers necessarily support chunked request
    -- bodies, so please confirm that yours does (Warp, Snap, and Happstack, for example, do).
    waiProxyTo :: (WAI.Request -> IO WaiProxyResponse)
               -- ^ How to reverse proxy.
               -> (SomeException -> WAI.Application)
               -- ^ How to handle exceptions when calling remote server. For a
               -- simple 502 error page, use 'defaultOnExc'.
               -> HC.Manager -- ^ connection manager to utilize
               -> WAI.Application
    waiProxyTo :: (Request -> IO WaiProxyResponse)
    -> (SomeException -> Application) -> Manager -> Application
    waiProxyTo Request -> IO WaiProxyResponse
    getDest SomeException -> Application
    onError = (Request -> IO WaiProxyResponse)
    -> WaiProxySettings -> Manager -> Application
    waiProxyToSettings Request -> IO WaiProxyResponse
    getDest WaiProxySettings
    defaultWaiProxySettings { wpsOnExc = onError }

    data LocalWaiProxySettings = LocalWaiProxySettings
        { LocalWaiProxySettings -> Maybe Int
    lpsTimeBound :: Maybe Int
        -- ^ Allows to specify the maximum time allowed for the conection on per request basis.
        --
        -- Default: no timeouts
        --
        -- @since 0.4.2
        }

    -- | Default value for 'LocalWaiProxySettings', same as 'def' but with a more explicit name.
    --
    -- @since 0.4.2
    defaultLocalWaiProxySettings :: LocalWaiProxySettings
    defaultLocalWaiProxySettings :: LocalWaiProxySettings
    defaultLocalWaiProxySettings = Maybe Int -> LocalWaiProxySettings
    LocalWaiProxySettings Maybe Int
    forall a. Maybe a
    Nothing

    -- | Allows to specify the maximum time allowed for the conection on per request basis.
    --
    -- Default: no timeouts
    --
    -- @since 0.4.2
    setLpsTimeBound :: Maybe Int -> LocalWaiProxySettings -> LocalWaiProxySettings
    setLpsTimeBound :: Maybe Int -> LocalWaiProxySettings -> LocalWaiProxySettings
    setLpsTimeBound Maybe Int
    x LocalWaiProxySettings
    s = LocalWaiProxySettings
    s { lpsTimeBound = x }

    data WaiProxySettings = WaiProxySettings
        { WaiProxySettings -> SomeException -> Application
    wpsOnExc :: SomeException -> WAI.Application
        , WaiProxySettings -> Maybe Int
    wpsTimeout :: Maybe Int
        , WaiProxySettings -> SetIpHeader
    wpsSetIpHeader :: SetIpHeader
        -- ^ Set the X-Real-IP request header with the client's IP address.
        --
        -- Default: SIHFromSocket
        --
        -- @since 0.2.0
        , WaiProxySettings
    -> Request
    -> Response ()
    -> Maybe (ConduitT ByteString (Flush Builder) IO ())
    wpsProcessBody :: WAI.Request -> HC.Response () -> Maybe (ConduitT ByteString (Flush Builder) IO ())
        -- ^ Post-process the response body returned from the host.
        --   The API for this function changed to include the extra 'WAI.Request'
        --   parameter in version 0.5.0.
        --
        -- @since 0.2.1
        , WaiProxySettings -> Request -> Bool
    wpsUpgradeToRaw :: WAI.Request -> Bool
        -- ^ Determine if the request should be upgraded to a raw proxy connection,
        -- as is needed for WebSockets. Requires WAI 2.1 or higher and a WAI
        -- handler with raw response support (e.g., Warp) to work.
        --
        -- Default: check if the upgrade header is websocket.
        --
        -- @since 0.3.1
        , WaiProxySettings
    -> Maybe (Request -> IO (LocalWaiProxySettings, WaiProxyResponse))
    wpsGetDest :: Maybe (WAI.Request -> IO (LocalWaiProxySettings, WaiProxyResponse))
        -- ^ Allow to override proxy settings for each request.
        -- If you supply this field it will take precedence over
        -- getDest parameter in waiProxyToSettings
        --
        -- Default: have one global setting
        --
        -- @since 0.4.2
        , WaiProxySettings -> Request -> IO ()
    wpsLogRequest :: HC.Request -> IO ()
        -- ^ Function provided to log the 'Request' that is constructed.
        --
        -- Default: no op
        --
        -- @since 0.6.0.1
        , WaiProxySettings
    -> Request -> Response () -> RequestHeaders -> RequestHeaders
    wpsModifyResponseHeaders :: WAI.Request -> HC.Response () -> HT.ResponseHeaders -> HT.ResponseHeaders
        -- ^ Allow to override the response headers before the response is returned upstream. Useful for example
        -- to override overly-strict 'Content-Security-Policy' when the source is known to be trustworthy.
        --
        -- Default: no op
        --
        -- @since 0.6.1.0
        }

    -- | How to set the X-Real-IP request header.
    --
    -- @since 0.2.0
    data SetIpHeader = SIHNone -- ^ Do not set the header
                     | SIHFromSocket -- ^ Set it from the socket's address.
                     | SIHFromHeader -- ^ Set it from either X-Real-IP or X-Forwarded-For, if present

    -- | Default value for 'WaiProxySettings'
    --
    -- @since 0.6.0
    defaultWaiProxySettings :: WaiProxySettings
    defaultWaiProxySettings :: WaiProxySettings
    defaultWaiProxySettings = WaiProxySettings
            { wpsOnExc :: SomeException -> Application
    wpsOnExc = SomeException -> Application
    defaultOnExc
            , wpsTimeout :: Maybe Int
    wpsTimeout = Maybe Int
    forall a. Maybe a
    Nothing
            , wpsSetIpHeader :: SetIpHeader
    wpsSetIpHeader = SetIpHeader
    SIHFromSocket
            , wpsProcessBody :: Request
    -> Response () -> Maybe (ConduitT ByteString (Flush Builder) IO ())
    wpsProcessBody = \Request
    _ Response ()
    _ -> Maybe (ConduitT ByteString (Flush Builder) IO ())
    forall a. Maybe a
    Nothing
            , wpsUpgradeToRaw :: Request -> Bool
    wpsUpgradeToRaw = \Request
    req ->
                (ByteString -> HeaderName
    forall s. FoldCase s => s -> CI s
    CI.mk (ByteString -> HeaderName) -> Maybe ByteString -> Maybe HeaderName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "upgrade" (Request -> RequestHeaders
    WAI.requestHeaders Request
    req)) Maybe HeaderName -> Maybe HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderName -> Maybe HeaderName
    forall a. a -> Maybe a
    Just HeaderName
    "websocket"
            , wpsGetDest :: Maybe (Request -> IO (LocalWaiProxySettings, WaiProxyResponse))
    wpsGetDest = Maybe (Request -> IO (LocalWaiProxySettings, WaiProxyResponse))
    forall a. Maybe a
    Nothing
            , wpsLogRequest :: Request -> IO ()
    wpsLogRequest = IO () -> Request -> IO ()
    forall a b. a -> b -> a
    const (() -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
            , wpsModifyResponseHeaders :: Request -> Response () -> RequestHeaders -> RequestHeaders
    wpsModifyResponseHeaders = \Request
    _ Response ()
    _ -> RequestHeaders -> RequestHeaders
    forall a. a -> a
    id
            }

    renderHeaders :: WAI.Request -> HT.RequestHeaders -> Builder
    renderHeaders :: Request -> RequestHeaders -> Builder
    renderHeaders Request
    req RequestHeaders
    headers
        = ByteString -> Builder
    fromByteString (Request -> ByteString
    WAI.requestMethod Request
    req)
       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    fromByteString ByteString
    " "
       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    fromByteString (Request -> ByteString
    WAI.rawPathInfo Request
    req)
       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    fromByteString (Request -> ByteString
    WAI.rawQueryString Request
    req)
       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> (if Request -> HttpVersion
    WAI.httpVersion Request
    req HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == HttpVersion
    HT.http11
               then ByteString -> Builder
    fromByteString ByteString
    " HTTP/1.1"
               else ByteString -> Builder
    fromByteString ByteString
    " HTTP/1.0")
       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat (((HeaderName, ByteString) -> Builder)
    -> RequestHeaders -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map (HeaderName, ByteString) -> Builder
    goHeader RequestHeaders
    headers)
       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    fromByteString ByteString
    "\r\n\r\n"
      where
        goHeader :: (HeaderName, ByteString) -> Builder
    goHeader (HeaderName
    x, ByteString
    y)
            = ByteString -> Builder
    fromByteString ByteString
    "\r\n"
           Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    fromByteString (HeaderName -> ByteString
    forall s. CI s -> s
    CI.original HeaderName
    x)
           Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    fromByteString ByteString
    ": "
           Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    fromByteString ByteString
    y

    tryWebSockets :: WaiProxySettings -> ByteString -> Int -> WAI.Request -> (WAI.Response -> IO b) -> IO b -> IO b
    tryWebSockets :: forall b.
    WaiProxySettings
    -> ByteString
    -> Int
    -> Request
    -> (Response -> IO b)
    -> IO b
    -> IO b
    tryWebSockets WaiProxySettings
    wps ByteString
    host Int
    port Request
    req Response -> IO b
    sendResponse IO b
    fallback
        | WaiProxySettings -> Request -> Bool
    wpsUpgradeToRaw WaiProxySettings
    wps Request
    req =
            Response -> IO b
    sendResponse (Response -> IO b) -> Response -> IO b
    forall a b. (a -> b) -> a -> b
    $ ((IO ByteString -> (ByteString -> IO ()) -> IO ())
     -> Response -> Response)
    -> Response
    -> (IO ByteString -> (ByteString -> IO ()) -> IO ())
    -> Response
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (IO ByteString -> (ByteString -> IO ()) -> IO ())
    -> Response -> Response
    WAI.responseRaw Response
    backup ((IO ByteString -> (ByteString -> IO ()) -> IO ()) -> Response)
    -> (IO ByteString -> (ByteString -> IO ()) -> IO ()) -> Response
    forall a b. (a -> b) -> a -> b
    $ \IO ByteString
    fromClientBody ByteString -> IO ()
    toClient ->
                ClientSettings -> (AppData -> IO ()) -> IO ()
    forall a. ClientSettings -> (AppData -> IO a) -> IO a
    DCN.runTCPClient ClientSettings
    settings ((AppData -> IO ()) -> IO ()) -> (AppData -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \AppData
    server ->
                    let toServer :: ConduitT ByteString o IO ()
    toServer = AppData -> ConduitT ByteString o IO ()
    forall ad (m :: * -> *) o.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT ByteString o m ()
    DCN.appSink AppData
    server
                        fromServer :: ConduitT i ByteString IO ()
    fromServer = AppData -> ConduitT i ByteString IO ()
    forall ad (m :: * -> *) i.
    (HasReadWrite ad, MonadIO m) =>
    ad -> ConduitT i ByteString m ()
    DCN.appSource AppData
    server
                        fromClient :: ConduitT i ByteString IO ()
    fromClient = do
                            (ByteString -> ConduitT i ByteString IO ())
    -> [ByteString] -> ConduitT i ByteString IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ByteString -> ConduitT i ByteString IO ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield ([ByteString] -> ConduitT i ByteString IO ())
    -> [ByteString] -> ConduitT i ByteString IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [ByteString]
    L.toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ Builder -> ByteString
    toLazyByteString Builder
    headers
                            let loop :: ConduitT i ByteString IO ()
    loop = do
                                    bs <- IO ByteString -> ConduitT i ByteString IO ByteString
    forall a. IO a -> ConduitT i ByteString IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO ByteString
    fromClientBody
                                    unless (S.null bs) $ do
                                        yield bs
                                        loop
                            ConduitT i ByteString IO ()
    forall {i}. ConduitT i ByteString IO ()
    loop
                        toClient' :: ConduitT ByteString o IO ()
    toClient' = (ByteString -> ConduitT ByteString o IO ())
    -> ConduitT ByteString o IO ()
    forall (m :: * -> *) i o r.
    Monad m =>
    (i -> ConduitT i o m r) -> ConduitT i o m ()
    awaitForever ((ByteString -> ConduitT ByteString o IO ())
     -> ConduitT ByteString o IO ())
    -> (ByteString -> ConduitT ByteString o IO ())
    -> ConduitT ByteString o IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> ConduitT ByteString o IO ()
    forall a. IO a -> ConduitT ByteString o IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ConduitT ByteString o IO ())
    -> (ByteString -> IO ())
    -> ByteString
    -> ConduitT ByteString o IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> IO ()
    toClient
                        headers :: Builder
    headers = Request -> RequestHeaders -> Builder
    renderHeaders Request
    req (RequestHeaders -> Builder) -> RequestHeaders -> Builder
    forall a b. (a -> b) -> a -> b
    $ WaiProxySettings -> Request -> RequestHeaders
    fixReqHeaders WaiProxySettings
    wps Request
    req
                     in IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
    concurrently_
                            (ConduitT () Void IO () -> IO ()
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void IO () -> IO ())
    -> ConduitT () Void IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ConduitT () ByteString IO ()
    forall {i}. ConduitT i ByteString IO ()
    fromClient ConduitT () ByteString IO ()
    -> ConduitT ByteString Void IO () -> ConduitT () Void IO ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Void IO ()
    forall {o}. ConduitT ByteString o IO ()
    toServer)
                            (ConduitT () Void IO () -> IO ()
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void IO () -> IO ())
    -> ConduitT () Void IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ConduitT () ByteString IO ()
    forall {i}. ConduitT i ByteString IO ()
    fromServer ConduitT () ByteString IO ()
    -> ConduitT ByteString Void IO () -> ConduitT () Void IO ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Void IO ()
    forall {o}. ConduitT ByteString o IO ()
    toClient')
        | Bool
    otherwise = IO b
    fallback
      where
        backup :: Response
    backup = Status -> RequestHeaders -> ByteString -> Response
    WAI.responseLBS Status
    HT.status500 [(HeaderName
    "Content-Type", ByteString
    "text/plain")]
            ByteString
    "http-reverse-proxy detected WebSockets request, but server does not support responseRaw"
        settings :: ClientSettings
    settings = Int -> ByteString -> ClientSettings
    DCN.clientSettings Int
    port ByteString
    host

    strippedHeaders :: Set HT.HeaderName
    strippedHeaders :: Set HeaderName
    strippedHeaders = [HeaderName] -> Set HeaderName
    forall a. Ord a => [a] -> Set a
    Set.fromList
        [HeaderName
    "content-length", HeaderName
    "transfer-encoding", HeaderName
    "accept-encoding", HeaderName
    "content-encoding"]

    fixReqHeaders :: WaiProxySettings -> WAI.Request -> HT.RequestHeaders
    fixReqHeaders :: WaiProxySettings -> Request -> RequestHeaders
    fixReqHeaders WaiProxySettings
    wps Request
    req =
        RequestHeaders -> RequestHeaders
    addXRealIP (RequestHeaders -> RequestHeaders)
    -> RequestHeaders -> RequestHeaders
    forall a b. (a -> b) -> a -> b
    $ ((HeaderName, ByteString) -> Bool)
    -> RequestHeaders -> RequestHeaders
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(HeaderName
    key, ByteString
    value) -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ HeaderName
    key HeaderName -> Set HeaderName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set HeaderName
    strippedHeaders
                                           Bool -> Bool -> Bool
    || (HeaderName
    key HeaderName -> HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderName
    "connection" Bool -> Bool -> Bool
    && ByteString
    value ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "close"))
                   (RequestHeaders -> RequestHeaders)
    -> RequestHeaders -> RequestHeaders
    forall a b. (a -> b) -> a -> b
    $ Request -> RequestHeaders
    WAI.requestHeaders Request
    req
      where
        fromSocket :: RequestHeaders -> RequestHeaders
    fromSocket = ((HeaderName
    "X-Real-IP", String -> ByteString
    S8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SockAddr -> String
    showSockAddr (SockAddr -> String) -> SockAddr -> String
    forall a b. (a -> b) -> a -> b
    $ Request -> SockAddr
    WAI.remoteHost Request
    req)(HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
    forall a. a -> [a] -> [a]
    :)
        fromForwardedFor :: Maybe ByteString
    fromForwardedFor = do
          h <- HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "x-forwarded-for" (Request -> RequestHeaders
    WAI.requestHeaders Request
    req)
          listToMaybe $ map trimOWS $ S8.split ',' h
        addXRealIP :: RequestHeaders -> RequestHeaders
    addXRealIP =
            case WaiProxySettings -> SetIpHeader
    wpsSetIpHeader WaiProxySettings
    wps of
                SetIpHeader
    SIHFromSocket -> RequestHeaders -> RequestHeaders
    fromSocket
                SetIpHeader
    SIHFromHeader ->
                    case HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "x-real-ip" (Request -> RequestHeaders
    WAI.requestHeaders Request
    req) Maybe ByteString -> Maybe ByteString -> Maybe ByteString
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe ByteString
    fromForwardedFor of
                        Maybe ByteString
    Nothing -> RequestHeaders -> RequestHeaders
    fromSocket
                        Just ByteString
    ip -> ((HeaderName
    "X-Real-IP", ByteString
    ip)(HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
    forall a. a -> [a] -> [a]
    :)
                SetIpHeader
    SIHNone -> RequestHeaders -> RequestHeaders
    forall a. a -> a
    id

    waiProxyToSettings :: (WAI.Request -> IO WaiProxyResponse)
                       -> WaiProxySettings
                       -> HC.Manager
                       -> WAI.Application
    waiProxyToSettings :: (Request -> IO WaiProxyResponse)
    -> WaiProxySettings -> Manager -> Application
    waiProxyToSettings Request -> IO WaiProxyResponse
    getDest WaiProxySettings
    wps' Manager
    manager Request
    req0 Response -> IO ResponseReceived
    sendResponse = do
        let wps :: WaiProxySettings
    wps = WaiProxySettings
    wps'{wpsGetDest = wpsGetDest wps' <|> Just (fmap (LocalWaiProxySettings $ wpsTimeout wps',) . getDest)}
        (lps, edest') <- (Request -> IO (LocalWaiProxySettings, WaiProxyResponse))
    -> Maybe (Request -> IO (LocalWaiProxySettings, WaiProxyResponse))
    -> Request
    -> IO (LocalWaiProxySettings, WaiProxyResponse)
    forall a. a -> Maybe a -> a
    fromMaybe
            (IO (LocalWaiProxySettings, WaiProxyResponse)
    -> Request -> IO (LocalWaiProxySettings, WaiProxyResponse)
    forall a b. a -> b -> a
    const (IO (LocalWaiProxySettings, WaiProxyResponse)
     -> Request -> IO (LocalWaiProxySettings, WaiProxyResponse))
    -> IO (LocalWaiProxySettings, WaiProxyResponse)
    -> Request
    -> IO (LocalWaiProxySettings, WaiProxyResponse)
    forall a b. (a -> b) -> a -> b
    $ (LocalWaiProxySettings, WaiProxyResponse)
    -> IO (LocalWaiProxySettings, WaiProxyResponse)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LocalWaiProxySettings
    defaultLocalWaiProxySettings, Response -> WaiProxyResponse
    WPRResponse (Response -> WaiProxyResponse) -> Response -> WaiProxyResponse
    forall a b. (a -> b) -> a -> b
    $ Status -> RequestHeaders -> ByteString -> Response
    WAI.responseLBS Status
    HT.status500 [] ByteString
    "proxy not setup"))
            (WaiProxySettings
    -> Maybe (Request -> IO (LocalWaiProxySettings, WaiProxyResponse))
    wpsGetDest WaiProxySettings
    wps)
            Request
    req0
        let edest =
                case WaiProxyResponse
    edest' of
                    WPRResponse Response
    res -> Application -> Either Application (ProxyDest, Request, Bool)
    forall a b. a -> Either a b
    Left (Application -> Either Application (ProxyDest, Request, Bool))
    -> Application -> Either Application (ProxyDest, Request, Bool)
    forall a b. (a -> b) -> a -> b
    $ \Request
    _req -> ((Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Response
    res)
                    WPRProxyDest ProxyDest
    pd -> (ProxyDest, Request, Bool)
    -> Either Application (ProxyDest, Request, Bool)
    forall a b. b -> Either a b
    Right (ProxyDest
    pd, Request
    req0, Bool
    False)
                    WPRProxyDestSecure ProxyDest
    pd -> (ProxyDest, Request, Bool)
    -> Either Application (ProxyDest, Request, Bool)
    forall a b. b -> Either a b
    Right (ProxyDest
    pd, Request
    req0, Bool
    True)
                    WPRModifiedRequest Request
    req ProxyDest
    pd -> (ProxyDest, Request, Bool)
    -> Either Application (ProxyDest, Request, Bool)
    forall a b. b -> Either a b
    Right (ProxyDest
    pd, Request
    req, Bool
    False)
                    WPRModifiedRequestSecure Request
    req ProxyDest
    pd -> (ProxyDest, Request, Bool)
    -> Either Application (ProxyDest, Request, Bool)
    forall a b. b -> Either a b
    Right (ProxyDest
    pd, Request
    req, Bool
    True)
                    WPRApplication Application
    app -> Application -> Either Application (ProxyDest, Request, Bool)
    forall a b. a -> Either a b
    Left Application
    app
            timeBound Int
    us IO ResponseReceived
    f =
                Int -> IO ResponseReceived -> IO (Maybe ResponseReceived)
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    Int -> m a -> m (Maybe a)
    timeout Int
    us IO ResponseReceived
    f IO (Maybe ResponseReceived)
    -> (Maybe ResponseReceived -> IO ResponseReceived)
    -> IO ResponseReceived
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                    Just ResponseReceived
    res -> ResponseReceived -> IO ResponseReceived
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ResponseReceived
    res
                    Maybe ResponseReceived
    Nothing -> Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> RequestHeaders -> ByteString -> Response
    WAI.responseLBS Status
    HT.status500 [] ByteString
    "timeBound"
        case edest of
            Left Application
    app -> (IO ResponseReceived -> IO ResponseReceived)
    -> (Int -> IO ResponseReceived -> IO ResponseReceived)
    -> Maybe Int
    -> IO ResponseReceived
    -> IO ResponseReceived
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO ResponseReceived -> IO ResponseReceived
    forall a. a -> a
    id Int -> IO ResponseReceived -> IO ResponseReceived
    timeBound (LocalWaiProxySettings -> Maybe Int
    lpsTimeBound LocalWaiProxySettings
    lps) (IO ResponseReceived -> IO ResponseReceived)
    -> IO ResponseReceived -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Application
    app Request
    req0 Response -> IO ResponseReceived
    sendResponse
            Right (ProxyDest ByteString
    host Int
    port, Request
    req, Bool
    secure) -> WaiProxySettings
    -> ByteString
    -> Int
    -> Request
    -> (Response -> IO ResponseReceived)
    -> IO ResponseReceived
    -> IO ResponseReceived
    forall b.
    WaiProxySettings
    -> ByteString
    -> Int
    -> Request
    -> (Response -> IO b)
    -> IO b
    -> IO b
    tryWebSockets WaiProxySettings
    wps ByteString
    host Int
    port Request
    req Response -> IO ResponseReceived
    sendResponse (IO ResponseReceived -> IO ResponseReceived)
    -> IO ResponseReceived -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ do
                scb <- IO ByteString -> IO (GivesPopper ())
    semiCachedBody (Request -> IO ByteString
    WAI.requestBody Request
    req)
                let body =
                      case Request -> RequestBodyLength
    WAI.requestBodyLength Request
    req of
                          WAI.KnownLength Word64
    i -> Int64 -> GivesPopper () -> RequestBody
    HC.RequestBodyStream (Word64 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    i) GivesPopper ()
    scb
                          RequestBodyLength
    WAI.ChunkedBody -> GivesPopper () -> RequestBody
    HC.RequestBodyStreamChunked GivesPopper ()
    scb

                let req' =
    #if MIN_VERSION_http_client(0, 5, 0)
                      Request
    HC.defaultRequest
                        { HC.checkResponse = \Request
    _ Response (IO ByteString)
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                        , HC.responseTimeout = maybe HC.responseTimeoutNone HC.responseTimeoutMicro $ lpsTimeBound lps
    #else
                      def
                        { HC.checkStatus = \_ _ _ -> Nothing
                        , HC.responseTimeout = lpsTimeBound lps
    #endif
                        , HC.method = WAI.requestMethod req
                        , HC.secure = secure
                        , HC.host = host
                        , HC.port = port
                        , HC.path = WAI.rawPathInfo req
                        , HC.queryString = WAI.rawQueryString req
                        , HC.requestHeaders = fixReqHeaders wps req
                        , HC.requestBody = body
                        , HC.redirectCount = 0
                        }
                bracket
                    (try $ do
                       liftIO $ wpsLogRequest wps' req'
                       HC.responseOpen req' manager)
                    (either (const $ return ()) HC.responseClose)
                    $ \case
                        Left SomeException
    e -> WaiProxySettings -> SomeException -> Application
    wpsOnExc WaiProxySettings
    wps SomeException
    e Request
    req Response -> IO ResponseReceived
    sendResponse
                        Right Response (IO ByteString)
    res -> do
                            let res' :: Response ()
    res' = () -> IO ByteString -> ()
    forall a b. a -> b -> a
    const () (IO ByteString -> ()) -> Response (IO ByteString) -> Response ()
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Response (IO ByteString)
    res
                                conduit :: ConduitT ByteString (Flush Builder) IO ()
    conduit = ConduitT ByteString (Flush Builder) IO ()
    -> Maybe (ConduitT ByteString (Flush Builder) IO ())
    -> ConduitT ByteString (Flush Builder) IO ()
    forall a. a -> Maybe a -> a
    fromMaybe
                                            ((ByteString -> ConduitT ByteString (Flush Builder) IO ())
    -> ConduitT ByteString (Flush Builder) IO ()
    forall (m :: * -> *) i o r.
    Monad m =>
    (i -> ConduitT i o m r) -> ConduitT i o m ()
    awaitForever (\ByteString
    bs -> Flush Builder -> ConduitT ByteString (Flush Builder) IO ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield (Builder -> Flush Builder
    forall a. a -> Flush a
    Chunk (Builder -> Flush Builder) -> Builder -> Flush Builder
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    fromByteString ByteString
    bs) ConduitT ByteString (Flush Builder) IO ()
    -> ConduitT ByteString (Flush Builder) IO ()
    -> ConduitT ByteString (Flush Builder) IO ()
    forall a b.
    ConduitT ByteString (Flush Builder) IO a
    -> ConduitT ByteString (Flush Builder) IO b
    -> ConduitT ByteString (Flush Builder) IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Flush Builder -> ConduitT ByteString (Flush Builder) IO ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield Flush Builder
    forall a. Flush a
    Flush))
                                            (WaiProxySettings
    -> Request
    -> Response ()
    -> Maybe (ConduitT ByteString (Flush Builder) IO ())
    wpsProcessBody WaiProxySettings
    wps Request
    req Response ()
    res')
                                src :: ConduitT i ByteString IO ()
    src = IO ByteString -> ConduitT i ByteString IO ()
    forall (m :: * -> *) i.
    MonadIO m =>
    IO ByteString -> ConduitT i ByteString m ()
    bodyReaderSource (IO ByteString -> ConduitT i ByteString IO ())
    -> IO ByteString -> ConduitT i ByteString IO ()
    forall a b. (a -> b) -> a -> b
    $ Response (IO ByteString) -> IO ByteString
    forall body. Response body -> body
    HC.responseBody Response (IO ByteString)
    res
                                headers :: RequestHeaders
    headers = Response (IO ByteString) -> RequestHeaders
    forall body. Response body -> RequestHeaders
    HC.responseHeaders Response (IO ByteString)
    res
                                notEncoded :: Bool
    notEncoded = Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isNothing (HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "content-encoding" RequestHeaders
    headers)
                                notChunked :: Bool
    notChunked = HttpVersion -> Int
    HT.httpMajor (Request -> HttpVersion
    WAI.httpVersion Request
    req) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2 Bool -> Bool -> Bool
    || Request -> ByteString
    WAI.requestMethod Request
    req ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    HT.methodHead
                            Response -> IO ResponseReceived
    sendResponse (Response -> IO ResponseReceived)
    -> Response -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ Status -> RequestHeaders -> StreamingBody -> Response
    WAI.responseStream
                                (Response (IO ByteString) -> Status
    forall body. Response body -> Status
    HC.responseStatus Response (IO ByteString)
    res)
                                (((HeaderName, ByteString) -> Bool)
    -> RequestHeaders -> RequestHeaders
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(HeaderName
    key, ByteString
    v) -> Bool -> Bool
    not (HeaderName
    key HeaderName -> Set HeaderName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set HeaderName
    strippedHeaders) Bool -> Bool -> Bool
    ||
                                                      HeaderName
    key HeaderName -> HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderName
    "content-length" Bool -> Bool -> Bool
    && (Bool
    notEncoded Bool -> Bool -> Bool
    && Bool
    notChunked Bool -> Bool -> Bool
    || ByteString
    v ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "0"))
                                        (WaiProxySettings
    -> Request -> Response () -> RequestHeaders -> RequestHeaders
    wpsModifyResponseHeaders WaiProxySettings
    wps Request
    req Response ()
    res' RequestHeaders
    headers))
                                (\Builder -> IO ()
    sendChunk IO ()
    flush -> ConduitT () Void IO () -> IO ()
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void IO () -> IO ())
    -> ConduitT () Void IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ConduitT () ByteString IO ()
    forall {i}. ConduitT i ByteString IO ()
    src ConduitT () ByteString IO ()
    -> ConduitT ByteString Void IO () -> ConduitT () Void IO ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString (Flush Builder) IO ()
    conduit ConduitT ByteString (Flush Builder) IO ()
    -> ConduitT (Flush Builder) Void IO ()
    -> ConduitT ByteString Void IO ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| (Flush Builder -> IO ()) -> ConduitT (Flush Builder) Void IO ()
    forall (m :: * -> *) a o.
    Monad m =>
    (a -> m ()) -> ConduitT a o m ()
    CL.mapM_ (\Flush Builder
    mb ->
                                    case Flush Builder
    mb of
                                        Flush Builder
    Flush -> IO ()
    flush
                                        Chunk Builder
    b -> Builder -> IO ()
    sendChunk Builder
    b))

    -- | Introduce a minor level of caching to handle some basic
    -- retry cases inside http-client. But to avoid a DoS attack,
    -- don't cache more than 65535 bytes (the theoretical max TCP packet size).
    --
    -- See: <https://github.com/fpco/http-reverse-proxy/issues/34#issuecomment-719136064>
    semiCachedBody :: IO ByteString -> IO (HC.GivesPopper ())
    semiCachedBody :: IO ByteString -> IO (GivesPopper ())
    semiCachedBody IO ByteString
    orig = do
      ref <- SCB -> IO (IORef SCB)
    forall a. a -> IO (IORef a)
    newIORef (SCB -> IO (IORef SCB)) -> SCB -> IO (IORef SCB)
    forall a b. (a -> b) -> a -> b
    $ Int -> [ByteString] -> SCB
    SCBCaching Int
    0 []
      pure $ \NeedsPopper ()
    needsPopper -> do
        let fromChunks :: Int -> [ByteString] -> SCB
    fromChunks Int
    len [ByteString]
    chunks =
              case [ByteString] -> Maybe (NonEmpty ByteString)
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty ([ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse [ByteString]
    chunks) of
                Maybe (NonEmpty ByteString)
    Nothing -> Int -> [ByteString] -> SCB
    SCBCaching Int
    len [ByteString]
    chunks
                Just NonEmpty ByteString
    toDrain -> Int -> [ByteString] -> NonEmpty ByteString -> SCB
    SCBDraining Int
    len [ByteString]
    chunks NonEmpty ByteString
    toDrain
        state0 <- IORef SCB -> IO SCB
    forall a. IORef a -> IO a
    readIORef IORef SCB
    ref IO SCB -> (SCB -> IO SCB) -> IO SCB
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
          \case
            SCBCaching Int
    len [ByteString]
    chunks -> SCB -> IO SCB
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SCB -> IO SCB) -> SCB -> IO SCB
    forall a b. (a -> b) -> a -> b
    $ Int -> [ByteString] -> SCB
    fromChunks Int
    len [ByteString]
    chunks
            SCBDraining Int
    len [ByteString]
    chunks NonEmpty ByteString
    _ -> SCB -> IO SCB
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SCB -> IO SCB) -> SCB -> IO SCB
    forall a b. (a -> b) -> a -> b
    $ Int -> [ByteString] -> SCB
    fromChunks Int
    len [ByteString]
    chunks
            SCB
    SCBTooMuchData -> String -> IO SCB
    forall a. HasCallStack => String -> a
    error String
    "Cannot retry this request body, need to force a new request"
        writeIORef ref $! state0
        let popper :: IO ByteString
            popper = do
              IORef SCB -> IO SCB
    forall a. IORef a -> IO a
    readIORef IORef SCB
    ref IO SCB -> (SCB -> IO ByteString) -> IO ByteString
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                \case
                  SCBDraining Int
    len [ByteString]
    chunks (ByteString
    next:|[ByteString]
    rest) -> do
                    IORef SCB -> SCB -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef SCB
    ref (SCB -> IO ()) -> SCB -> IO ()
    forall a b. (a -> b) -> a -> b
    $!
                      case [ByteString]
    rest of
                        [] -> Int -> [ByteString] -> SCB
    SCBCaching Int
    len [ByteString]
    chunks
                        ByteString
    x:[ByteString]
    xs -> Int -> [ByteString] -> NonEmpty ByteString -> SCB
    SCBDraining Int
    len [ByteString]
    chunks (ByteString
    xByteString -> [ByteString] -> NonEmpty ByteString
    forall a. a -> [a] -> NonEmpty a
    :|[ByteString]
    xs)
                    ByteString -> IO ByteString
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    next
                  SCB
    SCBTooMuchData -> IO ByteString
    orig
                  SCBCaching Int
    len [ByteString]
    chunks -> do
                    bs <- IO ByteString
    orig
                    let newLen = Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    S.length ByteString
    bs
                    writeIORef ref $!
                      if newLen > maxCache
                        then SCBTooMuchData
                        else SCBCaching newLen (bs:chunks)
                    pure bs

        needsPopper popper
      where
        maxCache :: Int
    maxCache = Int
    65535

    data SCB
      = SCBCaching !Int ![ByteString]
      | SCBDraining !Int ![ByteString] !(NonEmpty ByteString)
      | SCBTooMuchData

    -- | Get the HTTP headers for the first request on the stream, returning on
    -- consumed bytes as leftovers. Has built-in limits on how many bytes it will
    -- consume (specifically, will not ask for another chunked after it receives
    -- 1000 bytes).
    getHeaders :: Monad m => ConduitT ByteString o m HT.RequestHeaders
    getHeaders :: forall (m :: * -> *) o.
    Monad m =>
    ConduitT ByteString o m RequestHeaders
    getHeaders =
        ByteString -> RequestHeaders
    toHeaders (ByteString -> RequestHeaders)
    -> ConduitT ByteString o m ByteString
    -> ConduitT ByteString o m RequestHeaders
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ByteString -> ByteString) -> ConduitT ByteString o m ByteString
    forall {m :: * -> *} {o}.
    Monad m =>
    (ByteString -> ByteString) -> ConduitT ByteString o m ByteString
    go ByteString -> ByteString
    forall a. a -> a
    id
      where
        go :: (ByteString -> ByteString) -> ConduitT ByteString o m ByteString
    go ByteString -> ByteString
    front =
            ConduitT ByteString o m (Maybe ByteString)
    forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
    await ConduitT ByteString o m (Maybe ByteString)
    -> (Maybe ByteString -> ConduitT ByteString o m ByteString)
    -> ConduitT ByteString o m ByteString
    forall a b.
    ConduitT ByteString o m a
    -> (a -> ConduitT ByteString o m b) -> ConduitT ByteString o m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ConduitT ByteString o m ByteString
    -> (ByteString -> ConduitT ByteString o m ByteString)
    -> Maybe ByteString
    -> ConduitT ByteString o m ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ConduitT ByteString o m ByteString
    forall {o} {m :: * -> *}. ConduitT ByteString o m ByteString
    close ByteString -> ConduitT ByteString o m ByteString
    push
          where
            close :: ConduitT ByteString o m ByteString
    close = ByteString -> ConduitT ByteString o m ()
    forall i o (m :: * -> *). i -> ConduitT i o m ()
    leftover ByteString
    bs ConduitT ByteString o m ()
    -> ConduitT ByteString o m ByteString
    -> ConduitT ByteString o m ByteString
    forall a b.
    ConduitT ByteString o m a
    -> ConduitT ByteString o m b -> ConduitT ByteString o m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> ConduitT ByteString o m ByteString
    forall a. a -> ConduitT ByteString o m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bs
              where
                bs :: ByteString
    bs = ByteString -> ByteString
    front ByteString
    S8.empty
            push :: ByteString -> ConduitT ByteString o m ByteString
    push ByteString
    bs'
                | ByteString
    "\r\n\r\n" ByteString -> ByteString -> Bool
    `S8.isInfixOf` ByteString
    bs
                  Bool -> Bool -> Bool
    || ByteString
    "\n\n" ByteString -> ByteString -> Bool
    `S8.isInfixOf` ByteString
    bs
                  Bool -> Bool -> Bool
    || ByteString -> Int
    S8.length ByteString
    bs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    4096 = ByteString -> ConduitT ByteString o m ()
    forall i o (m :: * -> *). i -> ConduitT i o m ()
    leftover ByteString
    bs ConduitT ByteString o m ()
    -> ConduitT ByteString o m ByteString
    -> ConduitT ByteString o m ByteString
    forall a b.
    ConduitT ByteString o m a
    -> ConduitT ByteString o m b -> ConduitT ByteString o m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> ConduitT ByteString o m ByteString
    forall a. a -> ConduitT ByteString o m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bs
                | Bool
    otherwise = (ByteString -> ByteString) -> ConduitT ByteString o m ByteString
    go ((ByteString -> ByteString) -> ConduitT ByteString o m ByteString)
    -> (ByteString -> ByteString) -> ConduitT ByteString o m ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString -> ByteString
    forall a. Monoid a => a -> a -> a
    mappend ByteString
    bs
              where
                bs :: ByteString
    bs = ByteString -> ByteString
    front ByteString
    bs'
        toHeaders :: ByteString -> RequestHeaders
    toHeaders = (ByteString -> (HeaderName, ByteString))
    -> [ByteString] -> RequestHeaders
    forall a b. (a -> b) -> [a] -> [b]
    map ByteString -> (HeaderName, ByteString)
    toHeader ([ByteString] -> RequestHeaders)
    -> (ByteString -> [ByteString]) -> ByteString -> RequestHeaders
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> Bool) -> [ByteString] -> [ByteString]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Bool
    S8.null) ([ByteString] -> [ByteString])
    -> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [ByteString] -> [ByteString]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([ByteString] -> [ByteString])
    -> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    S8.lines
        toHeader :: ByteString -> (HeaderName, ByteString)
    toHeader ByteString
    bs =
            (ByteString -> HeaderName
    forall s. FoldCase s => s -> CI s
    CI.mk ByteString
    key, ByteString
    val)
          where
            (ByteString
    key, ByteString
    bs') = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
    S.break (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _colon) ByteString
    bs
            val :: ByteString
    val = (Word8 -> Bool) -> ByteString -> ByteString
    S.takeWhile (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    _cr) (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> Bool) -> ByteString -> ByteString
    S.dropWhile Word8 -> Bool
    isSpace (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> ByteString -> ByteString
    S.drop Int
    1 ByteString
    bs'

    {- FIXME
    -- | Convert a WAI application into a raw application, using Warp.
    waiToRaw :: WAI.Application -> DCN.Application IO
    waiToRaw app appdata0 =
        loop fromClient0
      where
        fromClient0 = DCN.appSource appdata0
        toClient = DCN.appSink appdata0
        loop fromClient = do
            mfromClient <- runResourceT $ withInternalState $ \internalState -> do
                ex <- try $ parseRequest conn internalState dummyAddr fromClient
                case ex of
                    Left (_ :: SomeException) -> return Nothing
                    Right (req, fromClient') -> do
                        res <- app req
                        keepAlive <- sendResponse
                            defaultSettings
                            req conn res
                        (fromClient'', _) <- liftIO fromClient' >>= unwrapResumable
                        return $ if keepAlive then Just fromClient'' else Nothing
            maybe (return ()) loop mfromClient

        dummyAddr = SockAddrInet (PortNum 0) 0 -- FIXME
        conn = Connection
            { connSendMany = \bss -> mapM_ yield bss $$ toClient
            , connSendAll = \bs -> yield bs $$ toClient
            , connSendFile = \fp offset len _th headers _cleaner ->
                let src1 = mapM_ yield headers
                    src2 = sourceFileRange fp (Just offset) (Just len)
                 in runResourceT
                    $  (src1 >> src2)
                    $$ transPipe lift toClient
            , connClose = return ()
            , connRecv = error "connRecv should not be used"
            }
            -}

    bodyReaderSource :: MonadIO m => BodyReader -> ConduitT i ByteString m ()
    bodyReaderSource :: forall (m :: * -> *) i.
    MonadIO m =>
    IO ByteString -> ConduitT i ByteString m ()
    bodyReaderSource IO ByteString
    br =
        ConduitT i ByteString m ()
    forall {i}. ConduitT i ByteString m ()
    loop
      where
        loop :: ConduitT i ByteString m ()
    loop = do
            bs <- IO ByteString -> ConduitT i ByteString m ByteString
    forall a. IO a -> ConduitT i ByteString m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> ConduitT i ByteString m ByteString)
    -> IO ByteString -> ConduitT i ByteString m ByteString
    forall a b. (a -> b) -> a -> b
    $ IO ByteString -> IO ByteString
    brRead IO ByteString
    br
            unless (S.null bs) $ do
                yield bs
                loop