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

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

    import qualified Control.Concurrent as Conc (yield)
    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.Word8 (_cr, _lf)
    #ifdef MIN_VERSION_crypton_x509
    import Data.X509
    #endif
    import Control.Exception (Exception, throwIO)
    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 System.IO.Unsafe (unsafePerformIO)
    import qualified System.TimeManager as Timeout
    import Prelude hiding (lines)

    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,
        settingsMaxTotalHeaderLength,
        settingsNoParsePath,
     )

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

    -- | first request on this connection?
    data FirstRequest = FirstRequest | SubsequentRequest

    -- | Receiving a HTTP request from 'Connection' and parsing its header
    --   to create 'Request'.
    recvRequest
        :: FirstRequest
        -> 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 :: FirstRequest
    -> Settings
    -> Connection
    -> InternalInfo
    -> Handle
    -> SockAddr
    -> Source
    -> Transport
    -> IO (Request, Maybe (IORef Int), IndexedHeader, IO HeaderValue)
    recvRequest FirstRequest
    firstRequest Settings
    settings Connection
    conn InternalInfo
    ii Handle
    th SockAddr
    addr Source
    src Transport
    transport = do
        hdrlines <- Int -> FirstRequest -> Source -> IO [HeaderValue]
    headerLines (Settings -> Int
    settingsMaxTotalHeaderLength Settings
    settings) FirstRequest
    firstRequest Source
    src
        (method, unparsedPath, path, query, httpversion, hdr) <-
            parseHeaderLines hdrlines
        let idxhdr = RequestHeaders -> IndexedHeader
    indexRequestHeader RequestHeaders
    hdr
            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
            handle100Continue = Connection -> HttpVersion -> Maybe HeaderValue -> IO ()
    handleExpect Connection
    conn HttpVersion
    httpversion Maybe HeaderValue
    expect
        (rbody, remainingRef, bodyLength) <- bodyAndSource src idxhdr
        -- body producing function which will produce '100-continue', if needed
        rbody' <- timeoutBody remainingRef th rbody handle100Continue
        -- body producing function which will never produce 100-continue
        rbodyFlush <- timeoutBody remainingRef th rbody (return ())
        let rawPath = if Settings -> Bool
    settingsNoParsePath Settings
    settings then HeaderValue
    unparsedPath else HeaderValue
    path
            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) -> Vault -> Vault
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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_crypton_x509
                    (Vault -> Vault) -> (Vault -> Vault) -> Vault -> Vault
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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) -> Vault -> Vault
    forall a b. (a -> b) -> a -> b
    $ Vault
    Vault.empty
            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
                    }
        return (req, remainingRef, idxhdr, rbodyFlush)

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

    headerLines :: Int -> FirstRequest -> Source -> IO [ByteString]
    headerLines :: Int -> FirstRequest -> Source -> IO [HeaderValue]
    headerLines Int
    maxTotalHeaderLength FirstRequest
    firstRequest Source
    src = do
        bs <- Source -> IO HeaderValue
    readSource Source
    src
        if S.null bs
            then -- 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.

                case firstRequest of
                  FirstRequest
    FirstRequest -> InvalidRequest -> IO [HeaderValue]
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO InvalidRequest
    ConnectionClosedByPeer
                  FirstRequest
    SubsequentRequest -> NoKeepAliveRequest -> IO [HeaderValue]
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO NoKeepAliveRequest
    NoKeepAliveRequest
            else push maxTotalHeaderLength src (THStatus 0 0 id id) 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
        -> IndexedHeader
        -> IO
            ( IO ByteString
            , Maybe (I.IORef Int)
            , RequestBodyLength
            )
    bodyAndSource :: Source
    -> IndexedHeader
    -> IO (IO HeaderValue, Maybe (IORef Int), RequestBodyLength)
    bodyAndSource Source
    src IndexedHeader
    idxhdr
        | Bool
    chunked = do
            csrc <- Source -> IO CSource
    mkCSource Source
    src
            return (readCSource csrc, Nothing, ChunkedBody)
        | Bool
    otherwise = do
            let len :: Int
    len = Maybe HeaderValue -> Int
    toLength (Maybe HeaderValue -> Int) -> Maybe HeaderValue -> Int
    forall a b. (a -> b) -> a -> b
    $ 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
                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
            isrc@(ISource _ remaining) <- Source -> Int -> IO ISource
    mkISource Source
    src Int
    len
            return (readISource isrc, Just remaining, bodyLen)
      where
        chunked :: Bool
    chunked = Maybe HeaderValue -> Bool
    isChunked (Maybe HeaderValue -> Bool) -> Maybe HeaderValue -> Bool
    forall a b. (a -> b) -> a -> b
    $ 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

    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
        isFirstRef <- Bool -> IO (IORef Bool)
    forall a. a -> IO (IORef a)
    I.newIORef Bool
    True

        let 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
                                x <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    I.readIORef IORef Int
    ref
                                return $! x <= 0

        return $ do
            isFirst <- I.readIORef isFirstRef

            when isFirst $ do
                -- Only check if we need to produce the 100 Continue status
                -- when asking for the first chunk of the body
                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.
                Timeout.resume timeoutHandle
                I.writeIORef isFirstRef False

            bs <- 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.
            isEmpty <- checkEmpty bs
            when isEmpty (Timeout.pause timeoutHandle)

            return bs

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

    type BSEndo = S.ByteString -> S.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
    -}

    -- | Assumes the 'ByteString' is never 'S.null'
    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
    reqLines BSEndo
    prepend) HeaderValue
    bs
        -- Newline found at index 'ix'
        | Just Int
    ix <- Word8 -> HeaderValue -> Maybe Int
    S.elemIndex Word8
    _lf HeaderValue
    bs = do
            -- Too many bytes
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    currentTotal Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxTotalHeaderLength) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ InvalidRequest -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO InvalidRequest
    OverLargeHeader
            Int -> IO [HeaderValue]
    newlineFound Int
    ix
        -- No newline found
        | Bool
    otherwise = do
            -- Early easy abort
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    currentTotal Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    bsLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxTotalHeaderLength) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ InvalidRequest -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO InvalidRequest
    OverLargeHeader
            (HeaderValue -> IO [HeaderValue]) -> IO [HeaderValue]
    forall a. (HeaderValue -> IO a) -> IO a
    withNewChunk HeaderValue -> IO [HeaderValue]
    noNewlineFound
      where
        bsLen :: Int
    bsLen = HeaderValue -> Int
    S.length HeaderValue
    bs
        currentTotal :: Int
    currentTotal = Int
    totalLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    chunkLen
        {-# INLINE withNewChunk #-}
        withNewChunk :: (S.ByteString -> IO a) -> IO a
        withNewChunk :: forall a. (HeaderValue -> IO a) -> IO a
    withNewChunk HeaderValue -> IO a
    f = do
            newChunk <- Source -> IO HeaderValue
    readSource' Source
    src
            when (S.null newChunk) $ throwIO IncompleteHeaders
            f newChunk
        {-# INLINE noNewlineFound #-}
        noNewlineFound :: HeaderValue -> IO [HeaderValue]
    noNewlineFound HeaderValue
    newChunk
            -- The chunk split the CRLF in half
            | HeaderValue -> Word8
    SU.unsafeLast HeaderValue
    bs Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _cr Bool -> Bool -> Bool
    && HasCallStack => HeaderValue -> Word8
    HeaderValue -> Word8
    S.head HeaderValue
    newChunk Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _lf =
                let bs' :: HeaderValue
    bs' = Int -> BSEndo
    SU.unsafeDrop Int
    1 HeaderValue
    newChunk
                 in if Int
    bsLen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 Bool -> Bool -> Bool
    && Int
    chunkLen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
                    -- first part is only CRLF, we're done
                    then do
                        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ HeaderValue -> Bool
    S.null HeaderValue
    bs') (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Source -> HeaderValue -> IO ()
    leftoverSource Source
    src HeaderValue
    bs'
                        [HeaderValue] -> IO [HeaderValue]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([HeaderValue] -> IO [HeaderValue])
    -> [HeaderValue] -> IO [HeaderValue]
    forall a b. (a -> b) -> a -> b
    $ BSEndoList
    reqLines []
                    else do
                        rest <- if HeaderValue -> Bool
    S.null HeaderValue
    bs'
                            -- new chunk is only LF, we need more to check for multiline
                            then (HeaderValue -> IO HeaderValue) -> IO HeaderValue
    forall a. (HeaderValue -> IO a) -> IO a
    withNewChunk HeaderValue -> IO HeaderValue
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
                            else HeaderValue -> IO HeaderValue
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure HeaderValue
    bs'
                        let status = Int -> HeaderValue -> THStatus
    addLine (Int
    bsLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> BSEndo
    SU.unsafeTake (Int
    bsLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) HeaderValue
    bs)
                        push maxTotalHeaderLength src status rest
            -- chunk and keep going
            | Bool
    otherwise = do
                let newChunkTotal :: Int
    newChunkTotal = Int
    chunkLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    bsLen
                    newPrepend :: BSEndo
    newPrepend = BSEndo
    prepend BSEndo -> BSEndo -> BSEndo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HeaderValue
    bs HeaderValue -> BSEndo
    forall a. Semigroup a => a -> a -> a
    <>)
                    status :: THStatus
    status = Int -> Int -> BSEndoList -> BSEndo -> THStatus
    THStatus Int
    totalLen Int
    newChunkTotal BSEndoList
    reqLines BSEndo
    newPrepend
                Int -> Source -> THStatus -> HeaderValue -> IO [HeaderValue]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status HeaderValue
    newChunk
        {-# INLINE newlineFound #-}
        newlineFound :: Int -> IO [HeaderValue]
    newlineFound Int
    ix
            -- Is end of headers
            | Int
    chunkLen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && Bool
    startsWithLF =  do
                let rest :: HeaderValue
    rest = Int -> BSEndo
    SU.unsafeDrop Int
    end HeaderValue
    bs
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ HeaderValue -> Bool
    S.null HeaderValue
    rest) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Source -> HeaderValue -> IO ()
    leftoverSource Source
    src HeaderValue
    rest
                [HeaderValue] -> IO [HeaderValue]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([HeaderValue] -> IO [HeaderValue])
    -> [HeaderValue] -> IO [HeaderValue]
    forall a b. (a -> b) -> a -> b
    $ BSEndoList
    reqLines []
            | Bool
    otherwise = do
                -- LF is on last byte
                let p :: Int
    p = Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                    chunk :: Int
    chunk =
                        if Int
    ix Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 Bool -> Bool -> Bool
    && HeaderValue -> Int -> Word8
    SU.unsafeIndex HeaderValue
    bs Int
    p Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _cr then Int
    p else Int
    ix
                    status :: THStatus
    status = Int -> HeaderValue -> THStatus
    addLine Int
    end (Int -> BSEndo
    SU.unsafeTake Int
    chunk HeaderValue
    bs)
                    continue :: HeaderValue -> IO [HeaderValue]
    continue = Int -> Source -> THStatus -> HeaderValue -> IO [HeaderValue]
    push Int
    maxTotalHeaderLength Source
    src THStatus
    status
                if Int
    end Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    bsLen
                    then (HeaderValue -> IO [HeaderValue]) -> IO [HeaderValue]
    forall a. (HeaderValue -> IO a) -> IO a
    withNewChunk HeaderValue -> IO [HeaderValue]
    continue
                    else HeaderValue -> IO [HeaderValue]
    continue (HeaderValue -> IO [HeaderValue])
    -> HeaderValue -> IO [HeaderValue]
    forall a b. (a -> b) -> a -> b
    $ Int -> BSEndo
    SU.unsafeDrop Int
    end HeaderValue
    bs
          where
            end :: Int
    end = Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
            startsWithLF :: Bool
    startsWithLF =
                case Int
    ix of
                    Int
    0 -> Bool
    True
                    Int
    1 -> HeaderValue -> Word8
    SU.unsafeHead HeaderValue
    bs Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _cr
                    Int
    _ -> Bool
    False
        -- addLine: take the current chunk and, if there's nothing to prepend,
        -- add straight to 'reqLines', otherwise first prepend then add.
        {-# INLINE addLine #-}
        addLine :: Int -> HeaderValue -> THStatus
    addLine Int
    len HeaderValue
    chunk =
            let newTotal :: Int
    newTotal = Int
    currentTotal Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len
                newLine :: HeaderValue
    newLine =
                    if Int
    chunkLen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then HeaderValue
    chunk else BSEndo
    prepend HeaderValue
    chunk
            in Int -> Int -> BSEndoList -> BSEndo -> THStatus
    THStatus Int
    newTotal Int
    0 (BSEndoList
    reqLines BSEndoList -> BSEndoList -> BSEndoList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HeaderValue
    newLineHeaderValue -> BSEndoList
    forall a. a -> [a] -> [a]
    :)) BSEndo
    forall a. a -> a
    id
    {- HLint ignore push "Use unless" -}

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