    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# OPTIONS_GHC -fno-warn-deprecations #-}

    module Network.Wai.Handler.Warp.Request (
        recvRequest
      , headerLines
      , pauseTimeoutKey
      , getFileInfoKey
    #ifdef MIN_VERSION_x509
      , getClientCertificateKey
    #endif
      , NoKeepAliveRequest (..)
      ) where

    import qualified Control.Concurrent as Conc (yield)
    import UnliftIO (throwIO, Exception)
    import Data.Array ((!))
    import qualified Data.ByteString as S
    import qualified Data.ByteString.Unsafe as SU
    import qualified Data.CaseInsensitive as CI
    import qualified Data.IORef as I
    import Data.Typeable (Typeable)
    import qualified Data.Vault.Lazy as Vault
    #ifdef MIN_VERSION_x509
    import Data.X509
    #endif
    import qualified Network.HTTP.Types as H
    import Network.Socket (SockAddr)
    import Network.Wai
    import Network.Wai.Handler.Warp.Types
    import Network.Wai.Internal
    import Prelude hiding (lines)
    import System.IO.Unsafe (unsafePerformIO)
    import qualified System.TimeManager as Timeout

    import Network.Wai.Handler.Warp.Conduit
    import Network.Wai.Handler.Warp.FileInfoCache
    import Network.Wai.Handler.Warp.Header
    import Network.Wai.Handler.Warp.Imports hiding (readInt)
    import Network.Wai.Handler.Warp.ReadInt
    import Network.Wai.Handler.Warp.RequestHeader
    import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath, settingsMaxTotalHeaderLength)

    ----------------------------------------------------------------

    -- | Receiving a HTTP request from 'Connection' and parsing its header
    --   to create 'Request'.
    recvRequest :: Bool -- ^ first request on this connection?
                -> Settings
                -> Connection
                -> InternalInfo
                -> Timeout.Handle
                -> SockAddr -- ^ Peer's address.
                -> Source -- ^ Where HTTP request comes from.
                -> Transport
                -> IO (Request
                      ,Maybe (I.IORef Int)
                      ,IndexedHeader
                      ,IO ByteString) -- ^
                -- 'Request' passed to 'Application',
                -- how many bytes remain to be consumed, if known
                -- 'IndexedHeader' of HTTP request for internal use,
                -- Body producing action used for flushing the request body

    recvRequest :: Bool
    -> Settings
    -> Connection
    -> InternalInfo
    -> Handle
    -> SockAddr
    -> Source
    -> Transport
    -> IO (Request, Maybe (IORef Int), IndexedHeader, IO HeaderValue)
    recvRequest Bool
    firstRequest Settings
    settings Connection
    conn InternalInfo
    ii Handle
    th SockAddr
    addr Source
    src Transport
    transport = do
        [HeaderValue]
    hdrlines <- Int -> Bool -> Source -> IO [HeaderValue]
    headerLines (Settings -> Int
    settingsMaxTotalHeaderLength Settings
    settings) Bool
    firstRequest Source
    src
        (HeaderValue
    method, HeaderValue
    unparsedPath, HeaderValue
    path, HeaderValue
    query, HttpVersion
    httpversion, RequestHeaders
    hdr) <- [HeaderValue]
    -> IO
         (HeaderValue, HeaderValue, HeaderValue, HeaderValue, HttpVersion,
          RequestHeaders)
    parseHeaderLines [HeaderValue]
    hdrlines
        let idxhdr :: IndexedHeader
    idxhdr = RequestHeaders -> IndexedHeader
    indexRequestHeader RequestHeaders
    hdr
            expect :: Maybe HeaderValue
    expect = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqExpect
            cl :: Maybe HeaderValue
    cl = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqContentLength
            te :: Maybe HeaderValue
    te = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqTransferEncoding
            handle100Continue :: IO ()
    handle100Continue = Connection -> HttpVersion -> Maybe HeaderValue -> IO ()
    handleExpect Connection
    conn HttpVersion
    httpversion Maybe HeaderValue
    expect
            rawPath :: HeaderValue
    rawPath = if Settings -> Bool
    settingsNoParsePath Settings
    settings then HeaderValue
    unparsedPath else HeaderValue
    path
            vaultValue :: Vault
    vaultValue = Key (IO ()) -> IO () -> Vault -> Vault
    forall a. Key a -> a -> Vault -> Vault
    Vault.insert Key (IO ())
    pauseTimeoutKey (Handle -> IO ()
    Timeout.pause Handle
    th)
                       (Vault -> Vault) -> Vault -> Vault
    forall a b. (a -> b) -> a -> b
    $ Key (FilePath -> IO FileInfo)
    -> (FilePath -> IO FileInfo) -> Vault -> Vault
    forall a. Key a -> a -> Vault -> Vault
    Vault.insert Key (FilePath -> IO FileInfo)
    getFileInfoKey (InternalInfo -> FilePath -> IO FileInfo
    getFileInfo InternalInfo
    ii)
    #ifdef MIN_VERSION_x509
                       (Vault -> Vault) -> Vault -> Vault
    forall a b. (a -> b) -> a -> b
    $ Key (Maybe CertificateChain)
    -> Maybe CertificateChain -> Vault -> Vault
    forall a. Key a -> a -> Vault -> Vault
    Vault.insert Key (Maybe CertificateChain)
    getClientCertificateKey (Transport -> Maybe CertificateChain
    getTransportClientCertificate Transport
    transport)
    #endif
                         Vault
    Vault.empty
        (IO HeaderValue
    rbody, Maybe (IORef Int)
    remainingRef, RequestBodyLength
    bodyLength) <- Source
    -> Maybe HeaderValue
    -> Maybe HeaderValue
    -> IO (IO HeaderValue, Maybe (IORef Int), RequestBodyLength)
    bodyAndSource Source
    src Maybe HeaderValue
    cl Maybe HeaderValue
    te
        -- body producing function which will produce '100-continue', if needed
        IO HeaderValue
    rbody' <- Maybe (IORef Int)
    -> Handle -> IO HeaderValue -> IO () -> IO (IO HeaderValue)
    timeoutBody Maybe (IORef Int)
    remainingRef Handle
    th IO HeaderValue
    rbody IO ()
    handle100Continue
        -- body producing function which will never produce 100-continue
        IO HeaderValue
    rbodyFlush <- Maybe (IORef Int)
    -> Handle -> IO HeaderValue -> IO () -> IO (IO HeaderValue)
    timeoutBody Maybe (IORef Int)
    remainingRef Handle
    th IO HeaderValue
    rbody (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
        let req :: Request
    req = Request {
                requestMethod :: HeaderValue
    requestMethod     = HeaderValue
    method
              , httpVersion :: HttpVersion
    httpVersion       = HttpVersion
    httpversion
              , pathInfo :: [Text]
    pathInfo          = HeaderValue -> [Text]
    H.decodePathSegments HeaderValue
    path
              , rawPathInfo :: HeaderValue
    rawPathInfo       = HeaderValue
    rawPath
              , rawQueryString :: HeaderValue
    rawQueryString    = HeaderValue
    query
              , queryString :: Query
    queryString       = HeaderValue -> Query
    H.parseQuery HeaderValue
    query
              , requestHeaders :: RequestHeaders
    requestHeaders    = RequestHeaders
    hdr
              , isSecure :: Bool
    isSecure          = Transport -> Bool
    isTransportSecure Transport
    transport
              , remoteHost :: SockAddr
    remoteHost        = SockAddr
    addr
              , requestBody :: IO HeaderValue
    requestBody       = IO HeaderValue
    rbody'
              , vault :: Vault
    vault             = Vault
    vaultValue
              , requestBodyLength :: RequestBodyLength
    requestBodyLength = RequestBodyLength
    bodyLength
              , requestHeaderHost :: Maybe HeaderValue
    requestHeaderHost      = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqHost
              , requestHeaderRange :: Maybe HeaderValue
    requestHeaderRange     = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqRange
              , requestHeaderReferer :: Maybe HeaderValue
    requestHeaderReferer   = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqReferer
              , requestHeaderUserAgent :: Maybe HeaderValue
    requestHeaderUserAgent = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqUserAgent
              }
        (Request, Maybe (IORef Int), IndexedHeader, IO HeaderValue)
    -> IO (Request, Maybe (IORef Int), IndexedHeader, IO HeaderValue)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Request
    req, Maybe (IORef Int)
    remainingRef, IndexedHeader
    idxhdr, IO HeaderValue
    rbodyFlush)

    ----------------------------------------------------------------

    headerLines :: Int -> Bool -> Source -> IO [ByteString]
    headerLines :: Int -> Bool -> Source -> IO [HeaderValue]
    headerLines Int
    maxTotalHeaderLength Bool
    firstRequest Source
    src = do
        HeaderValue
    bs <- Source -> IO HeaderValue
    readSource Source
    src
        if HeaderValue -> Bool
    S.null HeaderValue
    bs
            -- When we're working on a keep-alive connection and trying to
            -- get the second or later request, we don't want to treat the
            -- lack of data as a real exception. See the http1 function in
            -- the Run module for more details.
            then if Bool
    firstRequest then InvalidRequest -> IO [HeaderValue]
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO InvalidRequest
    ConnectionClosedByPeer else NoKeepAliveRequest -> IO [HeaderValue]
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO NoKeepAliveRequest
    NoKeepAliveRequest
            else Int -> Source -> THStatus -> HeaderValue -> IO [HeaderValue]
    push Int
    maxTotalHeaderLength Source
    src (Int -> Int -> BSEndoList -> BSEndo -> THStatus
    THStatus Int
    0 Int
    0 BSEndoList
    forall a. a -> a
    id BSEndo
    forall a. a -> a
    id) HeaderValue
    bs

    data NoKeepAliveRequest = NoKeepAliveRequest
        deriving (Int -> NoKeepAliveRequest -> ShowS
    [NoKeepAliveRequest] -> ShowS
    NoKeepAliveRequest -> FilePath
    (Int -> NoKeepAliveRequest -> ShowS)
    -> (NoKeepAliveRequest -> FilePath)
    -> ([NoKeepAliveRequest] -> ShowS)
    -> Show NoKeepAliveRequest
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> NoKeepAliveRequest -> ShowS
    showsPrec :: Int -> NoKeepAliveRequest -> ShowS
    $cshow :: NoKeepAliveRequest -> FilePath
    show :: NoKeepAliveRequest -> FilePath
    $cshowList :: [NoKeepAliveRequest] -> ShowS
    showList :: [NoKeepAliveRequest] -> ShowS
    Show, Typeable)
    instance Exception NoKeepAliveRequest

    ----------------------------------------------------------------

    handleExpect :: Connection
                 -> H.HttpVersion
                 -> Maybe HeaderValue
                 -> IO ()
    handleExpect :: Connection -> HttpVersion -> Maybe HeaderValue -> IO ()
    handleExpect Connection
    conn HttpVersion
    ver (Just HeaderValue
    "100-continue") = do
        Connection -> HeaderValue -> IO ()
    connSendAll Connection
    conn HeaderValue
    continue
        IO ()
    Conc.yield
      where
        continue :: HeaderValue
    continue
          | HttpVersion
    ver HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == HttpVersion
    H.http11 = HeaderValue
    "HTTP/1.1 100 Continue\r\n\r\n"
          | Bool
    otherwise       = HeaderValue
    "HTTP/1.0 100 Continue\r\n\r\n"
    handleExpect Connection
    _    HttpVersion
    _   Maybe HeaderValue
    _                     = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    ----------------------------------------------------------------

    bodyAndSource :: Source
                  -> Maybe HeaderValue -- ^ content length
                  -> Maybe HeaderValue -- ^ transfer-encoding
                  -> IO (IO ByteString
                        ,Maybe (I.IORef Int)
                        ,RequestBodyLength
                        )
    bodyAndSource :: Source
    -> Maybe HeaderValue
    -> Maybe HeaderValue
    -> IO (IO HeaderValue, Maybe (IORef Int), RequestBodyLength)
    bodyAndSource Source
    src Maybe HeaderValue
    cl Maybe HeaderValue
    te
      | Bool
    chunked = do
          CSource
    csrc <- Source -> IO CSource
    mkCSource Source
    src
          (IO HeaderValue, Maybe (IORef Int), RequestBodyLength)
    -> IO (IO HeaderValue, Maybe (IORef Int), RequestBodyLength)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CSource -> IO HeaderValue
    readCSource CSource
    csrc, Maybe (IORef Int)
    forall a. Maybe a
    Nothing, RequestBodyLength
    ChunkedBody)
      | Bool
    otherwise = do
          isrc :: ISource
    isrc@(ISource Source
    _ IORef Int
    remaining) <- Source -> Int -> IO ISource
    mkISource Source
    src Int
    len
          (IO HeaderValue, Maybe (IORef Int), RequestBodyLength)
    -> IO (IO HeaderValue, Maybe (IORef Int), RequestBodyLength)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ISource -> IO HeaderValue
    readISource ISource
    isrc, IORef Int -> Maybe (IORef Int)
    forall a. a -> Maybe a
    Just IORef Int
    remaining, RequestBodyLength
    bodyLen)
      where
        len :: Int
    len = Maybe HeaderValue -> Int
    toLength Maybe HeaderValue
    cl
        bodyLen :: RequestBodyLength
    bodyLen = 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
    len
        chunked :: Bool
    chunked = Maybe HeaderValue -> Bool
    isChunked Maybe HeaderValue
    te

    toLength :: Maybe HeaderValue -> Int
    toLength :: Maybe HeaderValue -> Int
    toLength Maybe HeaderValue
    Nothing   = Int
    0
    toLength (Just HeaderValue
    bs) = HeaderValue -> Int
    forall a. Integral a => HeaderValue -> a
    readInt HeaderValue
    bs

    isChunked :: Maybe HeaderValue -> Bool
    isChunked :: Maybe HeaderValue -> Bool
    isChunked (Just HeaderValue
    bs) = BSEndo
    forall s. FoldCase s => s -> s
    CI.foldCase HeaderValue
    bs HeaderValue -> HeaderValue -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderValue
    "chunked"
    isChunked Maybe HeaderValue
    _         = Bool
    False

    ----------------------------------------------------------------

    timeoutBody :: Maybe (I.IORef Int) -- ^ remaining
                -> Timeout.Handle
                -> IO ByteString
                -> IO ()
                -> IO (IO ByteString)
    timeoutBody :: Maybe (IORef Int)
    -> Handle -> IO HeaderValue -> IO () -> IO (IO HeaderValue)
    timeoutBody Maybe (IORef Int)
    remainingRef Handle
    timeoutHandle IO HeaderValue
    rbody IO ()
    handle100Continue = do
        IORef Bool
    isFirstRef <- Bool -> IO (IORef Bool)
    forall a. a -> IO (IORef a)
    I.newIORef Bool
    True

        let checkEmpty :: HeaderValue -> IO Bool
    checkEmpty =
                case Maybe (IORef Int)
    remainingRef of
                    Maybe (IORef Int)
    Nothing -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool)
    -> (HeaderValue -> Bool) -> HeaderValue -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderValue -> Bool
    S.null
                    Just IORef Int
    ref -> \HeaderValue
    bs -> if HeaderValue -> Bool
    S.null HeaderValue
    bs
                        then Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                        else do
                            Int
    x <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    I.readIORef IORef Int
    ref
                            Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $! Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0

        IO HeaderValue -> IO (IO HeaderValue)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO HeaderValue -> IO (IO HeaderValue))
    -> IO HeaderValue -> IO (IO HeaderValue)
    forall a b. (a -> b) -> a -> b
    $ do
            Bool
    isFirst <- IORef Bool -> IO Bool
    forall a. IORef a -> IO a
    I.readIORef IORef Bool
    isFirstRef

            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isFirst (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                -- Only check if we need to produce the 100 Continue status
                -- when asking for the first chunk of the body
                IO ()
    handle100Continue
                -- Timeout handling was paused after receiving the full request
                -- headers. Now we need to resume it to avoid a slowloris
                -- attack during request body sending.
                Handle -> IO ()
    Timeout.resume Handle
    timeoutHandle
                IORef Bool -> Bool -> IO ()
    forall a. IORef a -> a -> IO ()
    I.writeIORef IORef Bool
    isFirstRef Bool
    False

            HeaderValue
    bs <- IO HeaderValue
    rbody

            -- As soon as we finish receiving the request body, whether
            -- because the application is not interested in more bytes, or
            -- because there is no more data available, pause the timeout
            -- handler again.
            Bool
    isEmpty <- HeaderValue -> IO Bool
    checkEmpty HeaderValue
    bs
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isEmpty (Handle -> IO ()
    Timeout.pause Handle
    timeoutHandle)

            HeaderValue -> IO HeaderValue
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HeaderValue
    bs

    ----------------------------------------------------------------

    type BSEndo = ByteString -> ByteString
    type BSEndoList = [ByteString] -> [ByteString]

    data THStatus = THStatus
        !Int -- running total byte count (excluding current header chunk)
        !Int -- current header chunk byte count
        BSEndoList -- previously parsed lines
        BSEndo -- bytestrings to be prepended

    ----------------------------------------------------------------

    {- FIXME
    close :: Sink ByteString IO a
    close = throwIO IncompleteHeaders
    -}

    push :: Int -> Source -> THStatus -> ByteString -> IO [ByteString]
    push :: Int -> Source -> THStatus -> HeaderValue -> IO [HeaderValue]
    push Int
    maxTotalHeaderLength Source
    src (THStatus Int
    totalLen Int
    chunkLen BSEndoList
    lines BSEndo
    prepend) HeaderValue
    bs'
            -- Too many bytes
            | Int
    currentTotal Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxTotalHeaderLength = InvalidRequest -> IO [HeaderValue]
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO InvalidRequest
    OverLargeHeader
            | Bool
    otherwise = Maybe (Int, Int, Bool) -> IO [HeaderValue]
    push' Maybe (Int, Int, Bool)
    mNL
      where
        currentTotal :: Int
    currentTotal = Int
    totalLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    chunkLen
        -- bs: current header chunk, plus maybe (parts of) next header
        bs :: HeaderValue
    bs = BSEndo
    prepend HeaderValue
    bs'
        bsLen :: Int
    bsLen = HeaderValue -> Int
    S.length HeaderValue
    bs
        -- Maybe newline
        -- Returns: Maybe
        --    ( length of this chunk up to newline
        --    , position of newline in relation to entire current header
        --    , is this part of a multiline header
        --    )
        mNL :: Maybe (Int, Int, Bool)
    mNL = do
            -- 10 is the code point for newline (\n)
            Int
    chunkNL <- Word8 -> HeaderValue -> Maybe Int
    S.elemIndex Word8
    10 HeaderValue
    bs'
            let headerNL :: Int
    headerNL = Int
    chunkNL Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + HeaderValue -> Int
    S.length (BSEndo
    prepend HeaderValue
    "")
                chunkNLlen :: Int
    chunkNLlen = Int
    chunkNL Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
            -- check if there are two more bytes in the bs
            -- if so, see if the second of those is a horizontal space
            if Int
    bsLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    headerNL Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 then
                let c :: Word8
    c = HasCallStack => HeaderValue -> Int -> Word8
    HeaderValue -> Int -> Word8
    S.index HeaderValue
    bs (Int
    headerNL Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                    b :: Bool
    b = case Int
    headerNL of
                          Int
    0 -> Bool
    True
                          Int
    1 -> HasCallStack => HeaderValue -> Int -> Word8
    HeaderValue -> Int -> Word8
    S.index HeaderValue
    bs Int
    0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    13
                          Int
    _ -> Bool
    False
                    isMultiline :: Bool
    isMultiline = Bool -> Bool
    not Bool
    b Bool -> Bool -> Bool
    && (Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    32 Bool -> Bool -> Bool
    || Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    9)
                in (Int, Int, Bool) -> Maybe (Int, Int, Bool)
    forall a. a -> Maybe a
    Just (Int
    chunkNLlen, Int
    headerNL, Bool
    isMultiline)
                else
                (Int, Int, Bool) -> Maybe (Int, Int, Bool)
    forall a. a -> Maybe a
    Just (Int
    chunkNLlen, Int
    headerNL, Bool
    False)

        {-# INLINE push' #-}
        push' :: Maybe (Int, Int, Bool) -> IO [ByteString]
        -- No newline find in this chunk.  Add it to the prepend,
        -- update the length, and continue processing.
        push' :: Maybe (Int, Int, Bool) -> IO [HeaderValue]
    push' Maybe (Int, Int, Bool)
    Nothing = do
            HeaderValue
    bst <- Source -> IO HeaderValue
    readSource' Source
    src
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (HeaderValue -> Bool
    S.null HeaderValue
    bst) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ InvalidRequest -> IO ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO InvalidRequest
    IncompleteHeaders
            Int -> Source -> THStatus -> HeaderValue -> IO [HeaderValue]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status HeaderValue
    bst
          where
            prepend' :: BSEndo
    prepend' = HeaderValue -> BSEndo
    S.append HeaderValue
    bs
            thisChunkLen :: Int
    thisChunkLen = HeaderValue -> Int
    S.length HeaderValue
    bs'
            newChunkLen :: Int
    newChunkLen = Int
    chunkLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    thisChunkLen
            status :: THStatus
    status = Int -> Int -> BSEndoList -> BSEndo -> THStatus
    THStatus Int
    totalLen Int
    newChunkLen BSEndoList
    lines BSEndo
    prepend'
        -- Found a newline, but next line continues as a multiline header
        push' (Just (Int
    chunkNLlen, Int
    end, Bool
    True)) =
            Int -> Source -> THStatus -> HeaderValue -> IO [HeaderValue]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status HeaderValue
    rest
          where
            rest :: HeaderValue
    rest = Int -> BSEndo
    S.drop (Int
    end Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) HeaderValue
    bs
            prepend' :: BSEndo
    prepend' = HeaderValue -> BSEndo
    S.append (Int -> BSEndo
    SU.unsafeTake (HeaderValue -> Int -> Int
    checkCR HeaderValue
    bs Int
    end) HeaderValue
    bs)
            -- If we'd just update the entire current chunk up to newline
            -- we wouldn't count all the dropped newlines in between.
            -- So update 'chunkLen' with current chunk up to newline
            -- and use 'chunkLen' later on to add to 'totalLen'.
            newChunkLen :: Int
    newChunkLen = Int
    chunkLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    chunkNLlen
            status :: THStatus
    status = Int -> Int -> BSEndoList -> BSEndo -> THStatus
    THStatus Int
    totalLen Int
    newChunkLen BSEndoList
    lines BSEndo
    prepend'
        -- Found a newline at position end.
        push' (Just (Int
    chunkNLlen, Int
    end, Bool
    False))
          -- leftover
          | HeaderValue -> Bool
    S.null HeaderValue
    line = do
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    start Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    bsLen) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Source -> HeaderValue -> IO ()
    leftoverSource Source
    src (Int -> BSEndo
    SU.unsafeDrop Int
    start HeaderValue
    bs)
                [HeaderValue] -> IO [HeaderValue]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BSEndoList
    lines [])
          -- more headers
          | Bool
    otherwise   = let lines' :: BSEndoList
    lines' = BSEndoList
    lines BSEndoList -> BSEndoList -> BSEndoList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HeaderValue
    lineHeaderValue -> BSEndoList
    forall a. a -> [a] -> [a]
    :)
                              newTotalLength :: Int
    newTotalLength = Int
    totalLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    chunkLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    chunkNLlen
                              status :: THStatus
    status = Int -> Int -> BSEndoList -> BSEndo -> THStatus
    THStatus Int
    newTotalLength Int
    0 BSEndoList
    lines' BSEndo
    forall a. a -> a
    id
                          in if Int
    start Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    bsLen then
                                 -- more bytes in this chunk, push again
                                 let bs'' :: HeaderValue
    bs'' = Int -> BSEndo
    SU.unsafeDrop Int
    start HeaderValue
    bs
                                  in Int -> Source -> THStatus -> HeaderValue -> IO [HeaderValue]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status HeaderValue
    bs''
                               else do
                                 -- no more bytes in this chunk, ask for more
                                 HeaderValue
    bst <- Source -> IO HeaderValue
    readSource' Source
    src
                                 Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (HeaderValue -> Bool
    S.null HeaderValue
    bs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ InvalidRequest -> IO ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO InvalidRequest
    IncompleteHeaders
                                 Int -> Source -> THStatus -> HeaderValue -> IO [HeaderValue]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status HeaderValue
    bst
          where
            start :: Int
    start = Int
    end Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 -- start of next chunk
            line :: HeaderValue
    line = Int -> BSEndo
    SU.unsafeTake (HeaderValue -> Int -> Int
    checkCR HeaderValue
    bs Int
    end) HeaderValue
    bs

    {-# INLINE checkCR #-}
    checkCR :: ByteString -> Int -> Int
    checkCR :: HeaderValue -> Int -> Int
    checkCR HeaderValue
    bs Int
    pos = if Int
    pos Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 Bool -> Bool -> Bool
    && Word8
    13 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == HasCallStack => HeaderValue -> Int -> Word8
    HeaderValue -> Int -> Word8
    S.index HeaderValue
    bs Int
    p then Int
    p else Int
    pos -- 13 is CR (\r)
      where
        !p :: Int
    p = Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

    pauseTimeoutKey :: Vault.Key (IO ())
    pauseTimeoutKey :: Key (IO ())
    pauseTimeoutKey = IO (Key (IO ())) -> Key (IO ())
    forall a. IO a -> a
    unsafePerformIO IO (Key (IO ()))
    forall a. IO (Key a)
    Vault.newKey
    {-# NOINLINE pauseTimeoutKey #-}

    getFileInfoKey :: Vault.Key (FilePath -> IO FileInfo)
    getFileInfoKey :: Key (FilePath -> IO FileInfo)
    getFileInfoKey = IO (Key (FilePath -> IO FileInfo)) -> Key (FilePath -> IO FileInfo)
    forall a. IO a -> a
    unsafePerformIO IO (Key (FilePath -> IO FileInfo))
    forall a. IO (Key a)
    Vault.newKey
    {-# NOINLINE getFileInfoKey #-}

    #ifdef MIN_VERSION_x509
    getClientCertificateKey :: Vault.Key (Maybe CertificateChain)
    getClientCertificateKey :: Key (Maybe CertificateChain)
    getClientCertificateKey = IO (Key (Maybe CertificateChain)) -> Key (Maybe CertificateChain)
    forall a. IO a -> a
    unsafePerformIO IO (Key (Maybe CertificateChain))
    forall a. IO (Key a)
    Vault.newKey
    {-# NOINLINE getClientCertificateKey #-}
    #endif