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

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

    import qualified Control.Concurrent as Conc (yield)
    import Control.Exception (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
    import Data.X509
    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, lines)
    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 ByteString)
    recvRequest firstRequest :: Bool
    firstRequest settings :: Settings
    settings conn :: Connection
    conn ii :: InternalInfo
    ii th :: Handle
    th addr :: SockAddr
    addr src :: Source
    src transport :: Transport
    transport = do
        [ByteString]
    hdrlines <- Int -> Bool -> Source -> IO [ByteString]
    headerLines (Settings -> Int
    settingsMaxTotalHeaderLength Settings
    settings) Bool
    firstRequest Source
    src
        (method :: ByteString
    method, unparsedPath :: ByteString
    unparsedPath, path :: ByteString
    path, query :: ByteString
    query, httpversion :: HttpVersion
    httpversion, hdr :: RequestHeaders
    hdr) <- [ByteString]
    -> IO
         (ByteString, ByteString, ByteString, ByteString, HttpVersion,
          RequestHeaders)
    parseHeaderLines [ByteString]
    hdrlines
        let idxhdr :: IndexedHeader
    idxhdr = RequestHeaders -> IndexedHeader
    indexRequestHeader RequestHeaders
    hdr
            expect :: Maybe ByteString
    expect = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe ByteString
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqExpect
            cl :: Maybe ByteString
    cl = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe ByteString
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqContentLength
            te :: Maybe ByteString
    te = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe ByteString
    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 ByteString -> IO ()
    handleExpect Connection
    conn HttpVersion
    httpversion Maybe ByteString
    expect
            rawPath :: ByteString
    rawPath = if Settings -> Bool
    settingsNoParsePath Settings
    settings then ByteString
    unparsedPath else ByteString
    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)
                       (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)
                         Vault
    Vault.empty
        (rbody :: IO ByteString
    rbody, remainingRef :: Maybe (IORef Int)
    remainingRef, bodyLength :: RequestBodyLength
    bodyLength) <- Source
    -> Maybe ByteString
    -> Maybe ByteString
    -> IO (IO ByteString, Maybe (IORef Int), RequestBodyLength)
    bodyAndSource Source
    src Maybe ByteString
    cl Maybe ByteString
    te
        -- body producing function which will produce '100-continue', if needed
        IO ByteString
    rbody' <- Maybe (IORef Int)
    -> Handle -> IO ByteString -> IO () -> IO (IO ByteString)
    timeoutBody Maybe (IORef Int)
    remainingRef Handle
    th IO ByteString
    rbody IO ()
    handle100Continue
        -- body producing function which will never produce 100-continue
        IO ByteString
    rbodyFlush <- Maybe (IORef Int)
    -> Handle -> IO ByteString -> IO () -> IO (IO ByteString)
    timeoutBody Maybe (IORef Int)
    remainingRef Handle
    th IO ByteString
    rbody (() -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
        let req :: Request
    req = Request :: ByteString
    -> HttpVersion
    -> ByteString
    -> ByteString
    -> RequestHeaders
    -> Bool
    -> SockAddr
    -> [Text]
    -> Query
    -> IO ByteString
    -> Vault
    -> RequestBodyLength
    -> Maybe ByteString
    -> Maybe ByteString
    -> Maybe ByteString
    -> Maybe ByteString
    -> Request
    Request {
                requestMethod :: ByteString
    requestMethod     = ByteString
    method
              , httpVersion :: HttpVersion
    httpVersion       = HttpVersion
    httpversion
              , pathInfo :: [Text]
    pathInfo          = ByteString -> [Text]
    H.decodePathSegments ByteString
    path
              , rawPathInfo :: ByteString
    rawPathInfo       = ByteString
    rawPath
              , rawQueryString :: ByteString
    rawQueryString    = ByteString
    query
              , queryString :: Query
    queryString       = ByteString -> Query
    H.parseQuery ByteString
    query
              , requestHeaders :: RequestHeaders
    requestHeaders    = RequestHeaders
    hdr
              , isSecure :: Bool
    isSecure          = Transport -> Bool
    isTransportSecure Transport
    transport
              , remoteHost :: SockAddr
    remoteHost        = SockAddr
    addr
              , requestBody :: IO ByteString
    requestBody       = IO ByteString
    rbody'
              , vault :: Vault
    vault             = Vault
    vaultValue
              , requestBodyLength :: RequestBodyLength
    requestBodyLength = RequestBodyLength
    bodyLength
              , requestHeaderHost :: Maybe ByteString
    requestHeaderHost      = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe ByteString
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqHost
              , requestHeaderRange :: Maybe ByteString
    requestHeaderRange     = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe ByteString
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqRange
              , requestHeaderReferer :: Maybe ByteString
    requestHeaderReferer   = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe ByteString
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqReferer
              , requestHeaderUserAgent :: Maybe ByteString
    requestHeaderUserAgent = IndexedHeader
    idxhdr IndexedHeader -> Int -> Maybe ByteString
    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 ByteString)
    -> IO (Request, Maybe (IORef Int), IndexedHeader, IO ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Request
    req, Maybe (IORef Int)
    remainingRef, IndexedHeader
    idxhdr, IO ByteString
    rbodyFlush)

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

    headerLines :: Int -> Bool -> Source -> IO [ByteString]
    headerLines :: Int -> Bool -> Source -> IO [ByteString]
    headerLines maxTotalHeaderLength :: Int
    maxTotalHeaderLength firstRequest :: Bool
    firstRequest src :: Source
    src = do
        ByteString
    bs <- Source -> IO ByteString
    readSource Source
    src
        if ByteString -> Bool
    S.null ByteString
    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 [ByteString]
    forall e a. Exception e => e -> IO a
    throwIO InvalidRequest
    ConnectionClosedByPeer else NoKeepAliveRequest -> IO [ByteString]
    forall e a. Exception e => e -> IO a
    throwIO NoKeepAliveRequest
    NoKeepAliveRequest
            else Int -> Source -> THStatus -> ByteString -> IO [ByteString]
    push Int
    maxTotalHeaderLength Source
    src (Int -> BSEndoList -> BSEndo -> THStatus
    THStatus 0 BSEndoList
    forall a. a -> a
    id BSEndo
    forall a. a -> a
    id) ByteString
    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
    showList :: [NoKeepAliveRequest] -> ShowS
    $cshowList :: [NoKeepAliveRequest] -> ShowS
    show :: NoKeepAliveRequest -> FilePath
    $cshow :: NoKeepAliveRequest -> FilePath
    showsPrec :: Int -> NoKeepAliveRequest -> ShowS
    $cshowsPrec :: Int -> NoKeepAliveRequest -> ShowS
    Show, Typeable)
    instance Exception NoKeepAliveRequest

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

    handleExpect :: Connection
                 -> H.HttpVersion
                 -> Maybe HeaderValue
                 -> IO ()
    handleExpect :: Connection -> HttpVersion -> Maybe ByteString -> IO ()
    handleExpect conn :: Connection
    conn ver :: HttpVersion
    ver (Just "100-continue") = do
        Connection -> ByteString -> IO ()
    connSendAll Connection
    conn ByteString
    continue
        IO ()
    Conc.yield
      where
        continue :: ByteString
    continue
          | HttpVersion
    ver HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == HttpVersion
    H.http11 = "HTTP/1.1 100 Continue\r\n\r\n"
          | Bool
    otherwise       = "HTTP/1.0 100 Continue\r\n\r\n"
    handleExpect _    _   _                     = () -> IO ()
    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 ByteString
    -> Maybe ByteString
    -> IO (IO ByteString, Maybe (IORef Int), RequestBodyLength)
    bodyAndSource src :: Source
    src cl :: Maybe ByteString
    cl te :: Maybe ByteString
    te
      | Bool
    chunked = do
          CSource
    csrc <- Source -> IO CSource
    mkCSource Source
    src
          (IO ByteString, Maybe (IORef Int), RequestBodyLength)
    -> IO (IO ByteString, Maybe (IORef Int), RequestBodyLength)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CSource -> IO ByteString
    readCSource CSource
    csrc, Maybe (IORef Int)
    forall a. Maybe a
    Nothing, RequestBodyLength
    ChunkedBody)
      | Bool
    otherwise = do
          isrc :: ISource
    isrc@(ISource _ remaining :: IORef Int
    remaining) <- Source -> Int -> IO ISource
    mkISource Source
    src Int
    len
          (IO ByteString, Maybe (IORef Int), RequestBodyLength)
    -> IO (IO ByteString, Maybe (IORef Int), RequestBodyLength)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ISource -> IO ByteString
    readISource ISource
    isrc, IORef Int -> Maybe (IORef Int)
    forall a. a -> Maybe a
    Just IORef Int
    remaining, RequestBodyLength
    bodyLen)
      where
        len :: Int
    len = Maybe ByteString -> Int
    toLength Maybe ByteString
    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 ByteString -> Bool
    isChunked Maybe ByteString
    te

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

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

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

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

        let checkEmpty :: ByteString -> IO Bool
    checkEmpty =
                case Maybe (IORef Int)
    remainingRef of
                    Nothing -> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> (ByteString -> Bool) -> ByteString -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Bool
    S.null
                    Just ref :: IORef Int
    ref -> \bs :: ByteString
    bs -> if ByteString -> Bool
    S.null ByteString
    bs
                        then Bool -> IO Bool
    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 (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
    <= 0

        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
            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

            ByteString
    bs <- IO ByteString
    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 <- ByteString -> IO Bool
    checkEmpty ByteString
    bs
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isEmpty (Handle -> IO ()
    Timeout.pause Handle
    timeoutHandle)

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

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

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

    data THStatus = THStatus
        {-# UNPACK #-} !Int -- running total 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 -> ByteString -> IO [ByteString]
    push maxTotalHeaderLength :: Int
    maxTotalHeaderLength src :: Source
    src (THStatus len :: Int
    len lines :: BSEndoList
    lines prepend :: BSEndo
    prepend) bs' :: ByteString
    bs'
            -- Too many bytes
            | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxTotalHeaderLength = InvalidRequest -> IO [ByteString]
    forall e a. Exception e => e -> IO a
    throwIO InvalidRequest
    OverLargeHeader
            | Bool
    otherwise = Maybe (Int, Bool) -> IO [ByteString]
    push' Maybe (Int, Bool)
    mnl
      where
        bs :: ByteString
    bs = BSEndo
    prepend ByteString
    bs'
        bsLen :: Int
    bsLen = ByteString -> Int
    S.length ByteString
    bs
        mnl :: Maybe (Int, Bool)
    mnl = do
            Int
    nl <- Word8 -> ByteString -> Maybe Int
    S.elemIndex 10 ByteString
    bs
            -- 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
    nl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 then
                let c :: Word8
    c = ByteString -> Int -> Word8
    S.index ByteString
    bs (Int
    nl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1)
                    b :: Bool
    b = case Int
    nl of
                          0 -> Bool
    True
                          1 -> ByteString -> Int -> Word8
    S.index ByteString
    bs 0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 13
                          _ -> Bool
    False
                in (Int, Bool) -> Maybe (Int, Bool)
    forall a. a -> Maybe a
    Just (Int
    nl, Bool -> Bool
    not Bool
    b Bool -> Bool -> Bool
    && (Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 32 Bool -> Bool -> Bool
    || Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 9))
                else
                (Int, Bool) -> Maybe (Int, Bool)
    forall a. a -> Maybe a
    Just (Int
    nl, Bool
    False)

        {-# INLINE push' #-}
        push' :: Maybe (Int, Bool) -> IO [ByteString]
        -- No newline find in this chunk.  Add it to the prepend,
        -- update the length, and continue processing.
        push' :: Maybe (Int, Bool) -> IO [ByteString]
    push' Nothing = do
            ByteString
    bst <- Source -> IO ByteString
    readSource' Source
    src
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ByteString -> Bool
    S.null ByteString
    bst) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ InvalidRequest -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO InvalidRequest
    IncompleteHeaders
            Int -> Source -> THStatus -> ByteString -> IO [ByteString]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status ByteString
    bst
          where
            len' :: Int
    len' = Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    bsLen
            prepend' :: BSEndo
    prepend' = ByteString -> BSEndo
    S.append ByteString
    bs
            status :: THStatus
    status = Int -> BSEndoList -> BSEndo -> THStatus
    THStatus Int
    len' BSEndoList
    lines BSEndo
    prepend'
        -- Found a newline, but next line continues as a multiline header
        push' (Just (end :: Int
    end, True)) = Int -> Source -> THStatus -> ByteString -> IO [ByteString]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status ByteString
    rest
          where
            rest :: ByteString
    rest = Int -> BSEndo
    S.drop (Int
    end Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) ByteString
    bs
            prepend' :: BSEndo
    prepend' = ByteString -> BSEndo
    S.append (Int -> BSEndo
    SU.unsafeTake (ByteString -> Int -> Int
    checkCR ByteString
    bs Int
    end) ByteString
    bs)
            len' :: Int
    len' = Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    end
            status :: THStatus
    status = Int -> BSEndoList -> BSEndo -> THStatus
    THStatus Int
    len' BSEndoList
    lines BSEndo
    prepend'
        -- Found a newline at position end.
        push' (Just (end :: Int
    end, False))
          -- leftover
          | ByteString -> Bool
    S.null ByteString
    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 -> ByteString -> IO ()
    leftoverSource Source
    src (Int -> BSEndo
    SU.unsafeDrop Int
    start ByteString
    bs)
                [ByteString] -> IO [ByteString]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BSEndoList
    lines [])
          -- more headers
          | Bool
    otherwise   = let len' :: Int
    len' = Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    start
                              lines' :: BSEndoList
    lines' = BSEndoList
    lines BSEndoList -> BSEndoList -> BSEndoList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString
    lineByteString -> BSEndoList
    forall a. a -> [a] -> [a]
    :)
                              status :: THStatus
    status = Int -> BSEndoList -> BSEndo -> THStatus
    THStatus Int
    len' 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'' :: ByteString
    bs'' = Int -> BSEndo
    SU.unsafeDrop Int
    start ByteString
    bs
                                  in Int -> Source -> THStatus -> ByteString -> IO [ByteString]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status ByteString
    bs''
                               else do
                                 -- no more bytes in this chunk, ask for more
                                 ByteString
    bst <- Source -> IO ByteString
    readSource' Source
    src
                                 Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ByteString -> Bool
    S.null ByteString
    bs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ InvalidRequest -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO InvalidRequest
    IncompleteHeaders
                                 Int -> Source -> THStatus -> ByteString -> IO [ByteString]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status ByteString
    bst
          where
            start :: Int
    start = Int
    end Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 -- start of next chunk
            line :: ByteString
    line = Int -> BSEndo
    SU.unsafeTake (ByteString -> Int -> Int
    checkCR ByteString
    bs Int
    end) ByteString
    bs

    {-# INLINE checkCR #-}
    checkCR :: ByteString -> Int -> Int
    checkCR :: ByteString -> Int -> Int
    checkCR bs :: ByteString
    bs pos :: Int
    pos = if Int
    pos Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 Bool -> Bool -> Bool
    && 13 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString -> Int -> Word8
    S.index ByteString
    bs Int
    p then Int
    p else Int
    pos -- 13 is CR
      where
        !p :: Int
    p = Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 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 #-}

    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 #-}