    {-# LANGUAGE RankNTypes, CPP #-}
    -- | Backend for Common Gateway Interface. Almost all users should use the
    -- 'run' function.
    module Network.Wai.Handler.CGI
        ( run
        , runSendfile
        , runGeneric
        , requestBodyFunc
        ) where

    import Network.Wai
    import Network.Wai.Internal
    import Network.Socket (getAddrInfo, addrAddress)
    import Data.IORef
    import Data.Maybe (fromMaybe)
    import qualified Data.ByteString.Char8 as B
    import qualified Data.ByteString.Lazy as L
    import Control.Arrow ((***))
    import Data.Char (toLower)
    import qualified System.IO
    import qualified Data.String as String
    import Data.ByteString.Builder (byteString, toLazyByteString, char7, string8)
    import Data.ByteString.Builder.Extra (flush)
    import Data.ByteString.Lazy.Internal (defaultChunkSize)
    import System.IO (Handle)
    import Network.HTTP.Types (Status (..), hRange, hContentType, hContentLength)
    import qualified Network.HTTP.Types as H
    import qualified Data.CaseInsensitive as CI
    #if __GLASGOW_HASKELL__ < 710
    import Data.Monoid (mconcat, mempty, mappend)
    #endif

    import qualified Data.Streaming.ByteString.Builder as Builder
    import Data.Function (fix)
    import Control.Monad (unless, void)

    #if WINDOWS
    import System.Environment (getEnvironment)
    #else
    import qualified System.Posix.Env.ByteString as Env

    getEnvironment :: IO [(String, String)]
    getEnvironment :: IO [(String, String)]
    getEnvironment = ((ByteString, ByteString) -> (String, String))
    -> [(ByteString, ByteString)] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString -> String
    B.unpack (ByteString -> String)
    -> (ByteString -> String)
    -> (ByteString, ByteString)
    -> (String, String)
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** ByteString -> String
    B.unpack) ([(ByteString, ByteString)] -> [(String, String)])
    -> IO [(ByteString, ByteString)] -> IO [(String, String)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` IO [(ByteString, ByteString)]
    Env.getEnvironment
    #endif

    safeRead :: Read a => a -> String -> a
    safeRead :: a -> String -> a
    safeRead d :: a
    d s :: String
    s =
      case ReadS a
    forall a. Read a => ReadS a
    reads String
    s of
        ((x :: a
    x, _):_) -> a
    x
        [] -> a
    d

    lookup' :: String -> [(String, String)] -> String
    lookup' :: String -> [(String, String)] -> String
    lookup' key :: String
    key pairs :: [(String, String)]
    pairs = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe "" (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    key [(String, String)]
    pairs

    -- | Run an application using CGI.
    run :: Application -> IO ()
    run :: Application -> IO ()
    run app :: Application
    app = do
        [(String, String)]
    vars <- IO [(String, String)]
    getEnvironment
        let input :: Int -> IO (IO ByteString)
    input = Handle -> Int -> IO (IO ByteString)
    requestBodyHandle Handle
    System.IO.stdin
            output :: ByteString -> IO ()
    output = Handle -> ByteString -> IO ()
    B.hPut Handle
    System.IO.stdout
        [(String, String)]
    -> (Int -> IO (IO ByteString))
    -> (ByteString -> IO ())
    -> Maybe ByteString
    -> Application
    -> IO ()
    runGeneric [(String, String)]
    vars Int -> IO (IO ByteString)
    input ByteString -> IO ()
    output Maybe ByteString
    forall a. Maybe a
    Nothing Application
    app

    -- | Some web servers provide an optimization for sending files via a sendfile
    -- system call via a special header. To use this feature, provide that header
    -- name here.
    runSendfile :: B.ByteString -- ^ sendfile header
                -> Application -> IO ()
    runSendfile :: ByteString -> Application -> IO ()
    runSendfile sf :: ByteString
    sf app :: Application
    app = do
        [(String, String)]
    vars <- IO [(String, String)]
    getEnvironment
        let input :: Int -> IO (IO ByteString)
    input = Handle -> Int -> IO (IO ByteString)
    requestBodyHandle Handle
    System.IO.stdin
            output :: ByteString -> IO ()
    output = Handle -> ByteString -> IO ()
    B.hPut Handle
    System.IO.stdout
        [(String, String)]
    -> (Int -> IO (IO ByteString))
    -> (ByteString -> IO ())
    -> Maybe ByteString
    -> Application
    -> IO ()
    runGeneric [(String, String)]
    vars Int -> IO (IO ByteString)
    input ByteString -> IO ()
    output (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    sf) Application
    app

    -- | A generic CGI helper, which allows other backends (FastCGI and SCGI) to
    -- use the same code as CGI. Most users will not need this function, and can
    -- stick with 'run' or 'runSendfile'.
    runGeneric
         :: [(String, String)] -- ^ all variables
         -> (Int -> IO (IO B.ByteString)) -- ^ responseBody of input
         -> (B.ByteString -> IO ()) -- ^ destination for output
         -> Maybe B.ByteString -- ^ does the server support the X-Sendfile header?
         -> Application
         -> IO ()
    runGeneric :: [(String, String)]
    -> (Int -> IO (IO ByteString))
    -> (ByteString -> IO ())
    -> Maybe ByteString
    -> Application
    -> IO ()
    runGeneric vars :: [(String, String)]
    vars inputH :: Int -> IO (IO ByteString)
    inputH outputH :: ByteString -> IO ()
    outputH xsendfile :: Maybe ByteString
    xsendfile app :: Application
    app = do
        let rmethod :: ByteString
    rmethod = String -> ByteString
    B.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> String
    lookup' "REQUEST_METHOD" [(String, String)]
    vars
            pinfo :: String
    pinfo = String -> [(String, String)] -> String
    lookup' "PATH_INFO" [(String, String)]
    vars
            qstring :: String
    qstring = String -> [(String, String)] -> String
    lookup' "QUERY_STRING" [(String, String)]
    vars
            contentLength :: Int
    contentLength = Int -> String -> Int
    forall a. Read a => a -> String -> a
    safeRead 0 (String -> Int) -> String -> Int
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> String
    lookup' "CONTENT_LENGTH" [(String, String)]
    vars
            remoteHost' :: String
    remoteHost' =
                case String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "REMOTE_ADDR" [(String, String)]
    vars of
                    Just x :: String
    x -> String
    x
                    Nothing ->
                        case String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "REMOTE_HOST" [(String, String)]
    vars of
                            Just x :: String
    x -> String
    x
                            Nothing -> ""
            isSecure' :: Bool
    isSecure' =
                case (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> String
    lookup' "SERVER_PROTOCOL" [(String, String)]
    vars of
                    "https" -> Bool
    True
                    _ -> Bool
    False
        [AddrInfo]
    addrs <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
    getAddrInfo Maybe AddrInfo
    forall a. Maybe a
    Nothing (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    remoteHost') Maybe String
    forall a. Maybe a
    Nothing
        IO ByteString
    requestBody' <- Int -> IO (IO ByteString)
    inputH Int
    contentLength
        let addr :: SockAddr
    addr =
                case [AddrInfo]
    addrs of
                    a :: AddrInfo
    a:_ -> AddrInfo -> SockAddr
    addrAddress AddrInfo
    a
                    [] -> String -> SockAddr
    forall a. HasCallStack => String -> a
    error (String -> SockAddr) -> String -> SockAddr
    forall a b. (a -> b) -> a -> b
    $ "Invalid REMOTE_ADDR or REMOTE_HOST: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    remoteHost'
            reqHeaders :: [(CI ByteString, ByteString)]
    reqHeaders = ((String, String) -> (CI ByteString, ByteString))
    -> [(String, String)] -> [(CI ByteString, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> CI ByteString
    cleanupVarName (String -> CI ByteString)
    -> (String -> ByteString)
    -> (String, String)
    -> (CI ByteString, ByteString)
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** String -> ByteString
    B.pack) [(String, String)]
    vars
            env :: Request
    env = Request :: ByteString
    -> HttpVersion
    -> ByteString
    -> ByteString
    -> [(CI ByteString, ByteString)]
    -> Bool
    -> SockAddr
    -> [Text]
    -> Query
    -> IO ByteString
    -> Vault
    -> RequestBodyLength
    -> Maybe ByteString
    -> Maybe ByteString
    -> Maybe ByteString
    -> Maybe ByteString
    -> Request
    Request
                { requestMethod :: ByteString
    requestMethod = ByteString
    rmethod
                , rawPathInfo :: ByteString
    rawPathInfo = String -> ByteString
    B.pack String
    pinfo
                , pathInfo :: [Text]
    pathInfo = ByteString -> [Text]
    H.decodePathSegments (ByteString -> [Text]) -> ByteString -> [Text]
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    B.pack String
    pinfo
                , rawQueryString :: ByteString
    rawQueryString = String -> ByteString
    B.pack String
    qstring
                , queryString :: Query
    queryString = ByteString -> Query
    H.parseQuery (ByteString -> Query) -> ByteString -> Query
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    B.pack String
    qstring
                , requestHeaders :: [(CI ByteString, ByteString)]
    requestHeaders = [(CI ByteString, ByteString)]
    reqHeaders
                , isSecure :: Bool
    isSecure = Bool
    isSecure'
                , remoteHost :: SockAddr
    remoteHost = SockAddr
    addr
                , httpVersion :: HttpVersion
    httpVersion = HttpVersion
    H.http11 -- FIXME
                , requestBody :: IO ByteString
    requestBody = IO ByteString
    requestBody'
                , vault :: Vault
    vault = Vault
    forall a. Monoid a => a
    mempty
                , requestBodyLength :: RequestBodyLength
    requestBodyLength = Word64 -> RequestBodyLength
    KnownLength (Word64 -> RequestBodyLength) -> Word64 -> RequestBodyLength
    forall a b. (a -> b) -> a -> b
    $ Int -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    contentLength
                , requestHeaderHost :: Maybe ByteString
    requestHeaderHost = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "host" [(CI ByteString, ByteString)]
    reqHeaders
                , requestHeaderRange :: Maybe ByteString
    requestHeaderRange = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup CI ByteString
    hRange [(CI ByteString, ByteString)]
    reqHeaders
    #if MIN_VERSION_wai(3,2,0)
                , requestHeaderReferer :: Maybe ByteString
    requestHeaderReferer = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "referer" [(CI ByteString, ByteString)]
    reqHeaders
                , requestHeaderUserAgent :: Maybe ByteString
    requestHeaderUserAgent = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "user-agent" [(CI ByteString, ByteString)]
    reqHeaders
    #endif
                }
        IO ResponseReceived -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ResponseReceived -> IO ()) -> IO ResponseReceived -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Application
    app Request
    env ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \res :: Response
    res ->
            case (Maybe ByteString
    xsendfile, Response
    res) of
                (Just sf :: ByteString
    sf, ResponseFile s :: Status
    s hs :: [(CI ByteString, ByteString)]
    hs fp :: String
    fp Nothing) -> do
                    (ByteString -> IO ()) -> [ByteString] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ByteString -> IO ()
    outputH ([ByteString] -> IO ()) -> [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 -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Status
    -> [(CI ByteString, ByteString)] -> ByteString -> String -> Builder
    sfBuilder Status
    s [(CI ByteString, ByteString)]
    hs ByteString
    sf String
    fp
                    ResponseReceived -> IO ResponseReceived
    forall (m :: * -> *) a. Monad m => a -> m a
    return ResponseReceived
    ResponseReceived
                _ -> do
                    let (s :: Status
    s, hs :: [(CI ByteString, ByteString)]
    hs, wb :: (StreamingBody -> IO a) -> IO a
    wb) = Response
    -> (Status, [(CI ByteString, ByteString)],
        (StreamingBody -> IO a) -> IO a)
    forall a.
    Response
    -> (Status, [(CI ByteString, ByteString)],
        (StreamingBody -> IO a) -> IO a)
    responseToStream Response
    res
                    (blazeRecv :: BuilderRecv
    blazeRecv, blazeFinish :: BuilderFinish
    blazeFinish) <- BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish)
    Builder.newBuilderRecv BufferAllocStrategy
    Builder.defaultStrategy
                    (StreamingBody -> IO ()) -> IO ()
    forall a. (StreamingBody -> IO a) -> IO a
    wb ((StreamingBody -> IO ()) -> IO ())
    -> (StreamingBody -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \b :: StreamingBody
    b -> do
                        let sendBuilder :: Builder -> IO ()
    sendBuilder builder :: Builder
    builder = do
                                IO ByteString
    popper <- BuilderRecv
    blazeRecv Builder
    builder
                                (IO () -> IO ()) -> IO ()
    forall a. (a -> a) -> a
    fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \loop :: IO ()
    loop -> do
                                    ByteString
    bs <- IO ByteString
    popper
                                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ByteString -> Bool
    B.null ByteString
    bs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                                        ByteString -> IO ()
    outputH ByteString
    bs
                                        IO ()
    loop
                        Builder -> IO ()
    sendBuilder (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Status -> [(CI ByteString, ByteString)] -> Builder
    headers Status
    s [(CI ByteString, ByteString)]
    hs Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Char -> Builder
    char7 '\n'
                        StreamingBody
    b Builder -> IO ()
    sendBuilder (Builder -> IO ()
    sendBuilder Builder
    flush)
                    BuilderFinish
    blazeFinish BuilderFinish -> (Maybe ByteString -> IO ()) -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO () -> (ByteString -> IO ()) -> Maybe ByteString -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) ByteString -> IO ()
    outputH
                    ResponseReceived -> IO ResponseReceived
    forall (m :: * -> *) a. Monad m => a -> m a
    return ResponseReceived
    ResponseReceived
      where
        headers :: Status -> [(CI ByteString, ByteString)] -> Builder
    headers s :: Status
    s hs :: [(CI ByteString, ByteString)]
    hs = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat (((Builder, Builder) -> Builder)
    -> [(Builder, Builder)] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map (Builder, Builder) -> Builder
    header ([(Builder, Builder)] -> [Builder])
    -> [(Builder, Builder)] -> [Builder]
    forall a b. (a -> b) -> a -> b
    $ Status -> (Builder, Builder)
    status Status
    s (Builder, Builder) -> [(Builder, Builder)] -> [(Builder, Builder)]
    forall a. a -> [a] -> [a]
    : ((CI ByteString, ByteString) -> (Builder, Builder))
    -> [(CI ByteString, ByteString)] -> [(Builder, Builder)]
    forall a b. (a -> b) -> [a] -> [b]
    map (CI ByteString, ByteString) -> (Builder, Builder)
    header' ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
    forall b.
    IsString b =>
    [(CI ByteString, b)] -> [(CI ByteString, b)]
    fixHeaders [(CI ByteString, ByteString)]
    hs))
        status :: Status -> (Builder, Builder)
    status (Status i :: Int
    i m :: ByteString
    m) = (ByteString -> Builder
    byteString "Status", [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
            [ String -> Builder
    string8 (String -> Builder) -> String -> Builder
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    i
            , Char -> Builder
    char7 ' '
            , ByteString -> Builder
    byteString ByteString
    m
            ])
        header' :: (CI ByteString, ByteString) -> (Builder, Builder)
    header' (x :: CI ByteString
    x, y :: ByteString
    y) = (ByteString -> Builder
    byteString (ByteString -> Builder) -> ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $ CI ByteString -> ByteString
    forall s. CI s -> s
    CI.original CI ByteString
    x, ByteString -> Builder
    byteString ByteString
    y)
        header :: (Builder, Builder) -> Builder
    header (x :: Builder
    x, y :: Builder
    y) = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
            [ Builder
    x
            , ByteString -> Builder
    byteString ": "
            , Builder
    y
            , Char -> Builder
    char7 '\n'
            ]
        sfBuilder :: Status
    -> [(CI ByteString, ByteString)] -> ByteString -> String -> Builder
    sfBuilder s :: Status
    s hs :: [(CI ByteString, ByteString)]
    hs sf :: ByteString
    sf fp :: String
    fp = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
            [ Status -> [(CI ByteString, ByteString)] -> Builder
    headers Status
    s [(CI ByteString, ByteString)]
    hs
            , (Builder, Builder) -> Builder
    header ((Builder, Builder) -> Builder) -> (Builder, Builder) -> Builder
    forall a b. (a -> b) -> a -> b
    $ (ByteString -> Builder
    byteString ByteString
    sf, String -> Builder
    string8 String
    fp)
            , Char -> Builder
    char7 '\n'
            , ByteString -> Builder
    byteString ByteString
    sf
            , ByteString -> Builder
    byteString " not supported"
            ]
        fixHeaders :: [(CI ByteString, b)] -> [(CI ByteString, b)]
    fixHeaders h :: [(CI ByteString, b)]
    h =
            case CI ByteString -> [(CI ByteString, b)] -> Maybe b
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup CI ByteString
    hContentType [(CI ByteString, b)]
    h of
                Nothing -> (CI ByteString
    hContentType, "text/html; charset=utf-8") (CI ByteString, b) -> [(CI ByteString, b)] -> [(CI ByteString, b)]
    forall a. a -> [a] -> [a]
    : [(CI ByteString, b)]
    h
                Just _ -> [(CI ByteString, b)]
    h

    cleanupVarName :: String -> CI.CI B.ByteString
    cleanupVarName :: String -> CI ByteString
    cleanupVarName "CONTENT_TYPE" = CI ByteString
    hContentType
    cleanupVarName "CONTENT_LENGTH" = CI ByteString
    hContentLength
    cleanupVarName "SCRIPT_NAME" = "CGI-Script-Name"
    cleanupVarName s :: String
    s =
        case String
    s of
            'H':'T':'T':'P':'_':a :: Char
    a:as :: String
    as -> String -> CI ByteString
    forall a. IsString a => String -> a
    String.fromString (String -> CI ByteString) -> String -> CI ByteString
    forall a b. (a -> b) -> a -> b
    $ Char
    a Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    helper' String
    as
            _ -> String -> CI ByteString
    forall a. IsString a => String -> a
    String.fromString String
    s -- FIXME remove?
      where
        helper' :: String -> String
    helper' ('_':x :: Char
    x:rest :: String
    rest) = '-' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    helper' String
    rest
        helper' (x :: Char
    x:rest :: String
    rest) = Char -> Char
    toLower Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    helper' String
    rest
        helper' [] = []

    requestBodyHandle :: Handle -> Int -> IO (IO B.ByteString)
    requestBodyHandle :: Handle -> Int -> IO (IO ByteString)
    requestBodyHandle h :: Handle
    h = (Int -> BuilderFinish) -> Int -> IO (IO ByteString)
    requestBodyFunc ((Int -> BuilderFinish) -> Int -> IO (IO ByteString))
    -> (Int -> BuilderFinish) -> Int -> IO (IO ByteString)
    forall a b. (a -> b) -> a -> b
    $ \i :: Int
    i -> do
        ByteString
    bs <- Handle -> Int -> IO ByteString
    B.hGet Handle
    h Int
    i
        Maybe ByteString -> BuilderFinish
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> BuilderFinish)
    -> Maybe ByteString -> BuilderFinish
    forall a b. (a -> b) -> a -> b
    $ if ByteString -> Bool
    B.null ByteString
    bs then Maybe ByteString
    forall a. Maybe a
    Nothing else ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    bs

    requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> IO (IO B.ByteString)
    requestBodyFunc :: (Int -> BuilderFinish) -> Int -> IO (IO ByteString)
    requestBodyFunc get :: Int -> BuilderFinish
    get count0 :: Int
    count0 = do
        IORef Int
    ref <- Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef Int
    count0
        IO ByteString -> IO (IO ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO ByteString -> IO (IO ByteString))
    -> IO ByteString -> IO (IO ByteString)
    forall a b. (a -> b) -> a -> b
    $ do
            Int
    count <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    readIORef IORef Int
    ref
            if Int
    count Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0
                then ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    B.empty
                else do
                    Maybe ByteString
    mbs <- Int -> BuilderFinish
    get (Int -> BuilderFinish) -> Int -> BuilderFinish
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    count Int
    defaultChunkSize
                    IORef Int -> Int -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Int
    ref (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int -> (ByteString -> Int) -> Maybe ByteString -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe 0 ByteString -> Int
    B.length Maybe ByteString
    mbs
                    ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    B.empty Maybe ByteString
    mbs