    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    module Network.Wai.Handler.Warp.Response (
        sendResponse,
        sanitizeHeaderValue, -- for testing
        --  Provided here for backwards compatibility.
        warpVersion,
        hasBody,
        replaceHeader,
        addServer, -- testing
        addAltSvc,
    ) where

    import qualified Control.Exception as E
    import Data.Array ((!))
    import qualified Data.ByteString as S
    import Data.ByteString.Builder (Builder, byteString)
    import Data.ByteString.Builder.Extra (flush)
    import Data.ByteString.Builder.HTTP.Chunked (
        chunkedTransferEncoding,
        chunkedTransferTerminator,
     )
    import qualified Data.ByteString.Char8 as C8
    import qualified Data.CaseInsensitive as CI
    import Data.Function (on)
    import Data.List (deleteBy)
    import Data.Streaming.ByteString.Builder (
        newByteStringBuilderRecv,
        reuseBufferStrategy,
     )
    import Data.Word8 (_cr, _lf, _space, _tab)
    import qualified Network.HTTP.Types as H
    import qualified Network.HTTP.Types.Header as H
    import Network.Wai
    import Network.Wai.Internal
    import qualified System.TimeManager as T

    import Network.Wai.Handler.Warp.Buffer (toBuilderBuffer)
    import qualified Network.Wai.Handler.Warp.Date as D
    import Network.Wai.Handler.Warp.File
    import Network.Wai.Handler.Warp.Header
    import Network.Wai.Handler.Warp.IO (toBufIOWith)
    import Network.Wai.Handler.Warp.Imports
    import Network.Wai.Handler.Warp.ResponseHeader
    import Network.Wai.Handler.Warp.Settings
    import Network.Wai.Handler.Warp.Types

    -- $setup
    -- >>> :set -XOverloadedStrings

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

    -- | Sending a HTTP response to 'Connection' according to 'Response'.
    --
    --   Applications/middlewares MUST provide a proper 'H.ResponseHeaders'.
    --   so that inconsistency does not happen.
    --   No header is deleted by this function.
    --
    --   Especially, Applications/middlewares MUST provide a proper
    --   Content-Type. They MUST NOT provide
    --   Content-Length, Content-Range, and Transfer-Encoding
    --   because they are inserted, when necessary,
    --   regardless they already exist.
    --   This function does not insert Content-Encoding. It's middleware's
    --   responsibility.
    --
    --   The Date and Server header is added if not exist
    --   in HTTP response header.
    --
    --   There are three basic APIs to create 'Response':
    --
    --   ['responseBuilder' :: 'H.Status' -> 'H.ResponseHeaders' -> 'Builder' -> 'Response']
    --     HTTP response body is created from 'Builder'.
    --     Transfer-Encoding: chunked is used in HTTP/1.1.
    --
    --   ['responseStream' :: 'H.Status' -> 'H.ResponseHeaders' -> 'StreamingBody' -> 'Response']
    --     HTTP response body is created from 'Builder'.
    --     Transfer-Encoding: chunked is used in HTTP/1.1.
    --
    --   ['responseRaw' :: ('IO' 'ByteString' -> ('ByteString' -> 'IO' ()) -> 'IO' ()) -> 'Response' -> 'Response']
    --     No header is added and no Transfer-Encoding: is applied.
    --
    --   ['responseFile' :: 'H.Status' -> 'H.ResponseHeaders' -> 'FilePath' -> 'Maybe' 'FilePart' -> 'Response']
    --     HTTP response body is sent (by sendfile(), if possible) for GET method.
    --     HTTP response body is not sent by HEAD method.
    --     Content-Length and Content-Range are automatically
    --     added into the HTTP response header if necessary.
    --     If Content-Length and Content-Range exist in the HTTP response header,
    --     they would cause inconsistency.
    --     \"Accept-Ranges: bytes\" is also inserted.
    --
    --     Applications are categorized into simple and sophisticated.
    --     Sophisticated applications should specify 'Just' to
    --     'Maybe' 'FilePart'. They should treat the conditional request
    --     by themselves. A proper 'Status' (200 or 206) must be provided.
    --
    --     Simple applications should specify 'Nothing' to
    --     'Maybe' 'FilePart'. The size of the specified file is obtained
    --     by disk access or from the file info cache.
    --     If-Modified-Since, If-Unmodified-Since, If-Range and Range
    --     are processed. Since a proper status is chosen, 'Status' is
    --     ignored. Last-Modified is inserted.
    sendResponse
        :: Settings
        -> Connection
        -> InternalInfo
        -> T.Handle
        -> Request
        -- ^ HTTP request.
        -> IndexedHeader
        -- ^ Indexed header of HTTP request.
        -> IO ByteString
        -- ^ source from client, for raw response
        -> Response
        -- ^ HTTP response including status code and response header.
        -> IO Bool
        -- ^ Returing True if the connection is persistent.
    sendResponse :: Settings
    -> Connection
    -> InternalInfo
    -> Handle
    -> Request
    -> IndexedHeader
    -> IO HeaderValue
    -> Response
    -> IO Bool
    sendResponse Settings
    settings Connection
    conn InternalInfo
    ii Handle
    th Request
    req IndexedHeader
    reqidxhdr IO HeaderValue
    src Response
    response = do
        hs <- Settings -> ResponseHeaders -> ResponseHeaders
    addAltSvc Settings
    settings (ResponseHeaders -> ResponseHeaders)
    -> IO ResponseHeaders -> IO ResponseHeaders
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ResponseHeaders -> IO ResponseHeaders
    addServerAndDate ResponseHeaders
    hs0
        if hasBody s
            then do
                -- The response to HEAD does not have body.
                -- But to handle the conditional requests defined RFC 7232 and
                -- to generate appropriate content-length, content-range,
                -- and status, the response to HEAD is processed here.
                --
                -- See definition of rsp below for proper body stripping.
                (ms, mlen) <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method rsp
                case ms of
                    Maybe Status
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    Just Status
    realStatus -> Request -> Status -> Maybe Integer -> IO ()
    logger Request
    req Status
    realStatus Maybe Integer
    mlen
                T.tickle th
                return ret
            else do
                _ <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method RspNoBody
                logger req s Nothing
                T.tickle th
                return isPersist
      where
        defServer :: HeaderValue
    defServer = Settings -> HeaderValue
    settingsServerName Settings
    settings
        logger :: Request -> Status -> Maybe Integer -> IO ()
    logger = Settings -> Request -> Status -> Maybe Integer -> IO ()
    settingsLogger Settings
    settings
        maxRspBufSize :: Int
    maxRspBufSize = Settings -> Int
    settingsMaxBuilderResponseBufferSize Settings
    settings
        ver :: HttpVersion
    ver = Request -> HttpVersion
    httpVersion Request
    req
        s :: Status
    s = Response -> Status
    responseStatus Response
    response
        hs0 :: ResponseHeaders
    hs0 = ResponseHeaders -> ResponseHeaders
    sanitizeHeaders (ResponseHeaders -> ResponseHeaders)
    -> ResponseHeaders -> ResponseHeaders
    forall a b. (a -> b) -> a -> b
    $ Response -> ResponseHeaders
    responseHeaders Response
    response
        rspidxhdr :: IndexedHeader
    rspidxhdr = ResponseHeaders -> IndexedHeader
    indexResponseHeader ResponseHeaders
    hs0
        getdate :: IO HeaderValue
    getdate = InternalInfo -> IO HeaderValue
    getDate InternalInfo
    ii
        addServerAndDate :: ResponseHeaders -> IO ResponseHeaders
    addServerAndDate = IO HeaderValue
    -> IndexedHeader -> ResponseHeaders -> IO ResponseHeaders
    addDate IO HeaderValue
    getdate IndexedHeader
    rspidxhdr (ResponseHeaders -> IO ResponseHeaders)
    -> (ResponseHeaders -> ResponseHeaders)
    -> ResponseHeaders
    -> IO ResponseHeaders
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderValue -> IndexedHeader -> ResponseHeaders -> ResponseHeaders
    addServer HeaderValue
    defServer IndexedHeader
    rspidxhdr
        (Bool
    isPersist, Bool
    isChunked0) = Request -> IndexedHeader -> (Bool, Bool)
    infoFromRequest Request
    req IndexedHeader
    reqidxhdr
        isChunked :: Bool
    isChunked = Bool -> Bool
    not Bool
    isHead Bool -> Bool -> Bool
    && Bool
    isChunked0
        (Bool
    isKeepAlive, Bool
    needsChunked) = IndexedHeader -> (Bool, Bool) -> (Bool, Bool)
    infoFromResponse IndexedHeader
    rspidxhdr (Bool
    isPersist, Bool
    isChunked)
        method :: HeaderValue
    method = Request -> HeaderValue
    requestMethod Request
    req
        isHead :: Bool
    isHead = HeaderValue
    method HeaderValue -> HeaderValue -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderValue
    H.methodHead
        rsp :: Rsp
    rsp = case Response
    response of
            ResponseFile Status
    _ ResponseHeaders
    _ FilePath
    path Maybe FilePart
    mPart -> FilePath -> Maybe FilePart -> IndexedHeader -> IO () -> Rsp
    RspFile FilePath
    path Maybe FilePart
    mPart IndexedHeader
    reqidxhdr (Handle -> IO ()
    T.tickle Handle
    th)
            ResponseBuilder Status
    _ ResponseHeaders
    _ Builder
    b
                | Bool
    isHead -> Rsp
    RspNoBody
                | Bool
    otherwise -> Builder -> Bool -> Rsp
    RspBuilder Builder
    b Bool
    needsChunked
            ResponseStream Status
    _ ResponseHeaders
    _ StreamingBody
    fb
                | Bool
    isHead -> Rsp
    RspNoBody
                | Bool
    otherwise -> StreamingBody -> Bool -> Rsp
    RspStream StreamingBody
    fb Bool
    needsChunked
            ResponseRaw IO HeaderValue -> (HeaderValue -> IO ()) -> IO ()
    raw Response
    _ -> (IO HeaderValue -> (HeaderValue -> IO ()) -> IO ())
    -> IO HeaderValue -> Rsp
    RspRaw IO HeaderValue -> (HeaderValue -> IO ()) -> IO ()
    raw IO HeaderValue
    src
        -- Make sure we don't hang on to 'response' (avoid space leak)
        !ret :: Bool
    ret = case Response
    response of
            ResponseFile{} -> Bool
    isPersist
            ResponseBuilder{} -> Bool
    isKeepAlive
            ResponseStream{} -> Bool
    isKeepAlive
            ResponseRaw{} -> Bool
    False

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

    sanitizeHeaders :: H.ResponseHeaders -> H.ResponseHeaders
    sanitizeHeaders :: ResponseHeaders -> ResponseHeaders
    sanitizeHeaders = (Header -> Header) -> ResponseHeaders -> ResponseHeaders
    forall a b. (a -> b) -> [a] -> [b]
    map (HeaderValue -> HeaderValue
    sanitize (HeaderValue -> HeaderValue) -> Header -> Header
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)
      where
        sanitize :: HeaderValue -> HeaderValue
    sanitize HeaderValue
    v
            | HeaderValue -> Bool
    containsNewlines HeaderValue
    v = HeaderValue -> HeaderValue
    sanitizeHeaderValue HeaderValue
    v -- slow path
            | Bool
    otherwise = HeaderValue
    v -- fast path

    {-# INLINE containsNewlines #-}
    containsNewlines :: ByteString -> Bool
    containsNewlines :: HeaderValue -> Bool
    containsNewlines = (Word8 -> Bool) -> HeaderValue -> Bool
    S.any (\Word8
    w -> Word8
    w Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _cr Bool -> Bool -> Bool
    || Word8
    w Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _lf)

    {-# INLINE sanitizeHeaderValue #-}
    sanitizeHeaderValue :: ByteString -> ByteString
    sanitizeHeaderValue :: HeaderValue -> HeaderValue
    sanitizeHeaderValue HeaderValue
    v = case HeaderValue -> [HeaderValue]
    C8.lines (HeaderValue -> [HeaderValue]) -> HeaderValue -> [HeaderValue]
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> Bool) -> HeaderValue -> HeaderValue
    S.filter (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    _cr) HeaderValue
    v of
        [] -> HeaderValue
    ""
        HeaderValue
    x : [HeaderValue]
    xs -> HeaderValue -> [HeaderValue] -> HeaderValue
    C8.intercalate HeaderValue
    "\r\n" (HeaderValue
    x HeaderValue -> [HeaderValue] -> [HeaderValue]
    forall a. a -> [a] -> [a]
    : (HeaderValue -> Maybe HeaderValue)
    -> [HeaderValue] -> [HeaderValue]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe HeaderValue -> Maybe HeaderValue
    addSpaceIfMissing [HeaderValue]
    xs)
      where
        addSpaceIfMissing :: HeaderValue -> Maybe HeaderValue
    addSpaceIfMissing HeaderValue
    line = case HeaderValue -> Maybe (Word8, HeaderValue)
    S.uncons HeaderValue
    line of
            Maybe (Word8, HeaderValue)
    Nothing -> Maybe HeaderValue
    forall a. Maybe a
    Nothing
            Just (Word8
    first, HeaderValue
    _)
                | Word8
    first Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _space Bool -> Bool -> Bool
    || Word8
    first Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _tab -> HeaderValue -> Maybe HeaderValue
    forall a. a -> Maybe a
    Just HeaderValue
    line
                | Bool
    otherwise -> HeaderValue -> Maybe HeaderValue
    forall a. a -> Maybe a
    Just (HeaderValue -> Maybe HeaderValue)
    -> HeaderValue -> Maybe HeaderValue
    forall a b. (a -> b) -> a -> b
    $ Word8
    _space Word8 -> HeaderValue -> HeaderValue
    `S.cons` HeaderValue
    line

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

    data Rsp
        = RspNoBody
        | RspFile FilePath (Maybe FilePart) IndexedHeader (IO ())
        | RspBuilder Builder Bool
        | RspStream StreamingBody Bool
        | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString)

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

    sendRsp
        :: Connection
        -> InternalInfo
        -> T.Handle
        -> H.HttpVersion
        -> H.Status
        -> H.ResponseHeaders
        -> IndexedHeader -- Response
        -> Int -- maxBuilderResponseBufferSize
        -> H.Method
        -> Rsp
        -> IO (Maybe H.Status, Maybe Integer)
    ----------------------------------------------------------------

    sendRsp :: Connection
    -> InternalInfo
    -> Handle
    -> HttpVersion
    -> Status
    -> ResponseHeaders
    -> IndexedHeader
    -> Int
    -> HeaderValue
    -> Rsp
    -> IO (Maybe Status, Maybe Integer)
    sendRsp Connection
    conn InternalInfo
    _ Handle
    _ HttpVersion
    ver Status
    s ResponseHeaders
    hs IndexedHeader
    _ Int
    _ HeaderValue
    _ Rsp
    RspNoBody = do
        -- Not adding Content-Length.
        -- User agents treats it as Content-Length: 0.
        HttpVersion -> Status -> ResponseHeaders -> IO HeaderValue
    composeHeader HttpVersion
    ver Status
    s ResponseHeaders
    hs IO HeaderValue -> (HeaderValue -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Connection -> HeaderValue -> IO ()
    connSendAll Connection
    conn
        (Maybe Status, Maybe Integer) -> IO (Maybe Status, Maybe Integer)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Status -> Maybe Status
    forall a. a -> Maybe a
    Just Status
    s, Maybe Integer
    forall a. Maybe a
    Nothing)

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

    sendRsp Connection
    conn InternalInfo
    _ Handle
    th HttpVersion
    ver Status
    s ResponseHeaders
    hs IndexedHeader
    _ Int
    maxRspBufSize HeaderValue
    _ (RspBuilder Builder
    body Bool
    needsChunked) = do
        header <- HttpVersion -> Status -> ResponseHeaders -> Bool -> IO Builder
    composeHeaderBuilder HttpVersion
    ver Status
    s ResponseHeaders
    hs Bool
    needsChunked
        let hdrBdy
                | Bool
    needsChunked =
                    Builder
    header
                        Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder -> Builder
    chunkedTransferEncoding Builder
    body
                        Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    chunkedTransferTerminator
                | Bool
    otherwise = Builder
    header Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    body
            writeBufferRef = Connection -> IORef WriteBuffer
    connWriteBuffer Connection
    conn
        len <-
            toBufIOWith
                maxRspBufSize
                writeBufferRef
                (\HeaderValue
    bs -> Connection -> HeaderValue -> IO ()
    connSendAll Connection
    conn HeaderValue
    bs IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    T.tickle Handle
    th)
                hdrBdy
        return (Just s, Just len)

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

    sendRsp Connection
    conn InternalInfo
    _ Handle
    th HttpVersion
    ver Status
    s ResponseHeaders
    hs IndexedHeader
    _ Int
    _ HeaderValue
    _ (RspStream StreamingBody
    streamingBody Bool
    needsChunked) = do
        header <- HttpVersion -> Status -> ResponseHeaders -> Bool -> IO Builder
    composeHeaderBuilder HttpVersion
    ver Status
    s ResponseHeaders
    hs Bool
    needsChunked
        (recv, finish) <-
            newByteStringBuilderRecv $
                reuseBufferStrategy $
                    toBuilderBuffer $
                        connWriteBuffer conn
        let send Builder
    builder = do
                popper <- BuilderRecv
    recv Builder
    builder
                let loop = do
                        bs <- IO HeaderValue
    popper
                        unless (S.null bs) $ do
                            sendFragment conn th bs
                            loop
                loop
            sendChunk
                | Bool
    needsChunked = Builder -> IO ()
    send (Builder -> IO ()) -> (Builder -> Builder) -> Builder -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    chunkedTransferEncoding
                | Bool
    otherwise = Builder -> IO ()
    send
        send header
        streamingBody sendChunk (sendChunk flush)
        when needsChunked $ send chunkedTransferTerminator
        mbs <- finish
        maybe (return ()) (sendFragment conn th) mbs
        return (Just s, Nothing) -- fixme: can we tell the actual sent bytes?

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

    sendRsp Connection
    conn InternalInfo
    _ Handle
    th HttpVersion
    _ Status
    _ ResponseHeaders
    _ IndexedHeader
    _ Int
    _ HeaderValue
    _ (RspRaw IO HeaderValue -> (HeaderValue -> IO ()) -> IO ()
    withApp IO HeaderValue
    src) = do
        IO HeaderValue -> (HeaderValue -> IO ()) -> IO ()
    withApp IO HeaderValue
    recv HeaderValue -> IO ()
    send
        (Maybe Status, Maybe Integer) -> IO (Maybe Status, Maybe Integer)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Status
    forall a. Maybe a
    Nothing, Maybe Integer
    forall a. Maybe a
    Nothing)
      where
        recv :: IO HeaderValue
    recv = do
            bs <- IO HeaderValue
    src
            unless (S.null bs) $ T.tickle th
            return bs
        send :: HeaderValue -> IO ()
    send HeaderValue
    bs = Connection -> HeaderValue -> IO ()
    connSendAll Connection
    conn HeaderValue
    bs IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    T.tickle Handle
    th

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

    -- Sophisticated WAI applications.
    -- We respect s0. s0 MUST be a proper value.
    sendRsp Connection
    conn InternalInfo
    ii Handle
    th HttpVersion
    ver Status
    s0 ResponseHeaders
    hs0 IndexedHeader
    rspidxhdr Int
    maxRspBufSize HeaderValue
    method (RspFile FilePath
    path (Just FilePart
    part) IndexedHeader
    _ IO ()
    hook) =
        Connection
    -> InternalInfo
    -> Handle
    -> HttpVersion
    -> Status
    -> ResponseHeaders
    -> IndexedHeader
    -> Int
    -> HeaderValue
    -> FilePath
    -> Integer
    -> Integer
    -> IO ()
    -> IO (Maybe Status, Maybe Integer)
    sendRspFile2XX
            Connection
    conn
            InternalInfo
    ii
            Handle
    th
            HttpVersion
    ver
            Status
    s0
            ResponseHeaders
    hs
            IndexedHeader
    rspidxhdr
            Int
    maxRspBufSize
            HeaderValue
    method
            FilePath
    path
            Integer
    beg
            Integer
    len
            IO ()
    hook
      where
        beg :: Integer
    beg = FilePart -> Integer
    filePartOffset FilePart
    part
        len :: Integer
    len = FilePart -> Integer
    filePartByteCount FilePart
    part
        hs :: ResponseHeaders
    hs = ResponseHeaders -> FilePart -> ResponseHeaders
    addContentHeadersForFilePart ResponseHeaders
    hs0 FilePart
    part

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

    -- Simple WAI applications.
    -- Status is ignored
    sendRsp Connection
    conn InternalInfo
    ii Handle
    th HttpVersion
    ver Status
    _ ResponseHeaders
    hs0 IndexedHeader
    rspidxhdr Int
    maxRspBufSize HeaderValue
    method (RspFile FilePath
    path Maybe FilePart
    Nothing IndexedHeader
    reqidxhdr IO ()
    hook) = do
        efinfo <- IO FileInfo -> IO (Either IOException FileInfo)
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO FileInfo -> IO (Either IOException FileInfo))
    -> IO FileInfo -> IO (Either IOException FileInfo)
    forall a b. (a -> b) -> a -> b
    $ InternalInfo -> FilePath -> IO FileInfo
    getFileInfo InternalInfo
    ii FilePath
    path
        case efinfo of
            Left (IOException
    _ex :: E.IOException) ->
    #ifdef WARP_DEBUG
                print _ex >>
    #endif
                Connection
    -> InternalInfo
    -> Handle
    -> HttpVersion
    -> ResponseHeaders
    -> IndexedHeader
    -> Int
    -> HeaderValue
    -> IO (Maybe Status, Maybe Integer)
    sendRspFile404 Connection
    conn InternalInfo
    ii Handle
    th HttpVersion
    ver ResponseHeaders
    hs0 IndexedHeader
    rspidxhdr Int
    maxRspBufSize HeaderValue
    method
            Right FileInfo
    finfo -> case FileInfo
    -> ResponseHeaders
    -> HeaderValue
    -> IndexedHeader
    -> IndexedHeader
    -> RspFileInfo
    conditionalRequest FileInfo
    finfo ResponseHeaders
    hs0 HeaderValue
    method IndexedHeader
    rspidxhdr IndexedHeader
    reqidxhdr of
                WithoutBody Status
    s ->
                    Connection
    -> InternalInfo
    -> Handle
    -> HttpVersion
    -> Status
    -> ResponseHeaders
    -> IndexedHeader
    -> Int
    -> HeaderValue
    -> Rsp
    -> IO (Maybe Status, Maybe Integer)
    sendRsp Connection
    conn InternalInfo
    ii Handle
    th HttpVersion
    ver Status
    s ResponseHeaders
    hs0 IndexedHeader
    rspidxhdr Int
    maxRspBufSize HeaderValue
    method Rsp
    RspNoBody
                WithBody Status
    s ResponseHeaders
    hs Integer
    beg Integer
    len ->
                    Connection
    -> InternalInfo
    -> Handle
    -> HttpVersion
    -> Status
    -> ResponseHeaders
    -> IndexedHeader
    -> Int
    -> HeaderValue
    -> FilePath
    -> Integer
    -> Integer
    -> IO ()
    -> IO (Maybe Status, Maybe Integer)
    sendRspFile2XX
                        Connection
    conn
                        InternalInfo
    ii
                        Handle
    th
                        HttpVersion
    ver
                        Status
    s
                        ResponseHeaders
    hs
                        IndexedHeader
    rspidxhdr
                        Int
    maxRspBufSize
                        HeaderValue
    method
                        FilePath
    path
                        Integer
    beg
                        Integer
    len
                        IO ()
    hook

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

    sendRspFile2XX
        :: Connection
        -> InternalInfo
        -> T.Handle
        -> H.HttpVersion
        -> H.Status
        -> H.ResponseHeaders
        -> IndexedHeader
        -> Int
        -> H.Method
        -> FilePath
        -> Integer
        -> Integer
        -> IO ()
        -> IO (Maybe H.Status, Maybe Integer)
    sendRspFile2XX :: Connection
    -> InternalInfo
    -> Handle
    -> HttpVersion
    -> Status
    -> ResponseHeaders
    -> IndexedHeader
    -> Int
    -> HeaderValue
    -> FilePath
    -> Integer
    -> Integer
    -> IO ()
    -> IO (Maybe Status, Maybe Integer)
    sendRspFile2XX Connection
    conn InternalInfo
    ii Handle
    th HttpVersion
    ver Status
    s ResponseHeaders
    hs IndexedHeader
    rspidxhdr Int
    maxRspBufSize HeaderValue
    method FilePath
    path Integer
    beg Integer
    len IO ()
    hook
        | HeaderValue
    method HeaderValue -> HeaderValue -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderValue
    H.methodHead =
            Connection
    -> InternalInfo
    -> Handle
    -> HttpVersion
    -> Status
    -> ResponseHeaders
    -> IndexedHeader
    -> Int
    -> HeaderValue
    -> Rsp
    -> IO (Maybe Status, Maybe Integer)
    sendRsp Connection
    conn InternalInfo
    ii Handle
    th HttpVersion
    ver Status
    s ResponseHeaders
    hs IndexedHeader
    rspidxhdr Int
    maxRspBufSize HeaderValue
    method Rsp
    RspNoBody
        | Bool
    otherwise = do
            lheader <- HttpVersion -> Status -> ResponseHeaders -> IO HeaderValue
    composeHeader HttpVersion
    ver Status
    s ResponseHeaders
    hs
            (mfd, fresher) <- getFd ii path
            let fid = FilePath -> Maybe Fd -> FileId
    FileId FilePath
    path Maybe Fd
    mfd
                hook' = IO ()
    hook IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    fresher
            connSendFile conn fid beg len hook' [lheader]
            return (Just s, Just len)

    sendRspFile404
        :: Connection
        -> InternalInfo
        -> T.Handle
        -> H.HttpVersion
        -> H.ResponseHeaders
        -> IndexedHeader
        -> Int
        -> H.Method
        -> IO (Maybe H.Status, Maybe Integer)
    sendRspFile404 :: Connection
    -> InternalInfo
    -> Handle
    -> HttpVersion
    -> ResponseHeaders
    -> IndexedHeader
    -> Int
    -> HeaderValue
    -> IO (Maybe Status, Maybe Integer)
    sendRspFile404 Connection
    conn InternalInfo
    ii Handle
    th HttpVersion
    ver ResponseHeaders
    hs0 IndexedHeader
    rspidxhdr Int
    maxRspBufSize HeaderValue
    method =
        Connection
    -> InternalInfo
    -> Handle
    -> HttpVersion
    -> Status
    -> ResponseHeaders
    -> IndexedHeader
    -> Int
    -> HeaderValue
    -> Rsp
    -> IO (Maybe Status, Maybe Integer)
    sendRsp
            Connection
    conn
            InternalInfo
    ii
            Handle
    th
            HttpVersion
    ver
            Status
    s
            ResponseHeaders
    hs
            IndexedHeader
    rspidxhdr
            Int
    maxRspBufSize
            HeaderValue
    method
            (Builder -> Bool -> Rsp
    RspBuilder Builder
    body Bool
    True)
      where
        s :: Status
    s = Status
    H.notFound404
        hs :: ResponseHeaders
    hs = HeaderName -> HeaderValue -> ResponseHeaders -> ResponseHeaders
    replaceHeader HeaderName
    H.hContentType HeaderValue
    "text/plain; charset=utf-8" ResponseHeaders
    hs0
        body :: Builder
    body = HeaderValue -> Builder
    byteString HeaderValue
    "File not found"

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

    -- | Use 'connSendAll' to send this data while respecting timeout rules.
    sendFragment :: Connection -> T.Handle -> ByteString -> IO ()
    sendFragment :: Connection -> Handle -> HeaderValue -> IO ()
    sendFragment Connection{connSendAll :: Connection -> HeaderValue -> IO ()
    connSendAll = HeaderValue -> IO ()
    send} Handle
    th HeaderValue
    bs = do
        Handle -> IO ()
    T.resume Handle
    th
        HeaderValue -> IO ()
    send HeaderValue
    bs
        Handle -> IO ()
    T.pause Handle
    th

    -- We pause timeouts before passing control back to user code. This ensures
    -- that a timeout will only ever be executed when Warp is in control. We
    -- also make sure to resume the timeout after the completion of user code
    -- so that we can kill idle connections.

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

    infoFromRequest
        :: Request
        -> IndexedHeader
        -> ( Bool -- isPersist
           , Bool -- isChunked
           )
    infoFromRequest :: Request -> IndexedHeader -> (Bool, Bool)
    infoFromRequest Request
    req IndexedHeader
    reqidxhdr = (Request -> IndexedHeader -> Bool
    checkPersist Request
    req IndexedHeader
    reqidxhdr, Request -> Bool
    checkChunk Request
    req)

    checkPersist :: Request -> IndexedHeader -> Bool
    checkPersist :: Request -> IndexedHeader -> Bool
    checkPersist Request
    req IndexedHeader
    reqidxhdr
        | HttpVersion
    ver HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == HttpVersion
    H.http11 = Maybe HeaderValue -> Bool
    forall {a}. (Eq a, FoldCase a, IsString a) => Maybe a -> Bool
    checkPersist11 Maybe HeaderValue
    conn
        | Bool
    otherwise = Maybe HeaderValue -> Bool
    forall {a}. (Eq a, FoldCase a, IsString a) => Maybe a -> Bool
    checkPersist10 Maybe HeaderValue
    conn
      where
        ver :: HttpVersion
    ver = Request -> HttpVersion
    httpVersion Request
    req
        conn :: Maybe HeaderValue
    conn = IndexedHeader
    reqidxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqConnection
        checkPersist11 :: Maybe a -> Bool
    checkPersist11 (Just a
    x)
            | a -> a
    forall s. FoldCase s => s -> s
    CI.foldCase a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    "close" = Bool
    False
        checkPersist11 Maybe a
    _ = Bool
    True
        checkPersist10 :: Maybe a -> Bool
    checkPersist10 (Just a
    x)
            | a -> a
    forall s. FoldCase s => s -> s
    CI.foldCase a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    "keep-alive" = Bool
    True
        checkPersist10 Maybe a
    _ = Bool
    False

    checkChunk :: Request -> Bool
    checkChunk :: Request -> Bool
    checkChunk Request
    req = Request -> HttpVersion
    httpVersion Request
    req HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == HttpVersion
    H.http11

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

    -- Used for ResponseBuilder and ResponseSource.
    -- Don't use this for ResponseFile since this logic does not fit
    -- for ResponseFile. For instance, isKeepAlive should be True in some cases
    -- even if the response header does not have Content-Length.
    --
    -- Content-Length is specified by a reverse proxy.
    -- Note that CGI does not specify Content-Length.
    infoFromResponse :: IndexedHeader -> (Bool, Bool) -> (Bool, Bool)
    infoFromResponse :: IndexedHeader -> (Bool, Bool) -> (Bool, Bool)
    infoFromResponse IndexedHeader
    rspidxhdr (Bool
    isPersist, Bool
    isChunked) = (Bool
    isKeepAlive, Bool
    needsChunked)
      where
        needsChunked :: Bool
    needsChunked = Bool
    isChunked Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    hasLength
        isKeepAlive :: Bool
    isKeepAlive = Bool
    isPersist Bool -> Bool -> Bool
    && (Bool
    isChunked Bool -> Bool -> Bool
    || Bool
    hasLength)
        hasLength :: Bool
    hasLength = Maybe HeaderValue -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe HeaderValue -> Bool) -> Maybe HeaderValue -> Bool
    forall a b. (a -> b) -> a -> b
    $ IndexedHeader
    rspidxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! ResponseHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum ResponseHeaderIndex
    ResContentLength

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

    hasBody :: H.Status -> Bool
    hasBody :: Status -> Bool
    hasBody Status
    s =
        Int
    sc Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    204
            Bool -> Bool -> Bool
    && Int
    sc Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    304
            Bool -> Bool -> Bool
    && Int
    sc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    200
      where
        sc :: Int
    sc = Status -> Int
    H.statusCode Status
    s

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

    addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders
    addTransferEncoding :: ResponseHeaders -> ResponseHeaders
    addTransferEncoding ResponseHeaders
    hdrs = (HeaderName
    H.hTransferEncoding, HeaderValue
    "chunked") Header -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    : ResponseHeaders
    hdrs

    addDate
        :: IO D.GMTDate -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders
    addDate :: IO HeaderValue
    -> IndexedHeader -> ResponseHeaders -> IO ResponseHeaders
    addDate IO HeaderValue
    getdate IndexedHeader
    rspidxhdr ResponseHeaders
    hdrs = case IndexedHeader
    rspidxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! ResponseHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum ResponseHeaderIndex
    ResDate of
        Maybe HeaderValue
    Nothing -> do
            gmtdate <- IO HeaderValue
    getdate
            return $ (H.hDate, gmtdate) : hdrs
        Just HeaderValue
    _ -> ResponseHeaders -> IO ResponseHeaders
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ResponseHeaders
    hdrs

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

    {-# INLINE addServer #-}
    addServer
        :: HeaderValue -> IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
    addServer :: HeaderValue -> IndexedHeader -> ResponseHeaders -> ResponseHeaders
    addServer HeaderValue
    "" IndexedHeader
    rspidxhdr ResponseHeaders
    hdrs = case IndexedHeader
    rspidxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! ResponseHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum ResponseHeaderIndex
    ResServer of
        Maybe HeaderValue
    Nothing -> ResponseHeaders
    hdrs
        Maybe HeaderValue
    _ -> (Header -> Bool) -> ResponseHeaders -> ResponseHeaders
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((HeaderName -> HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= HeaderName
    H.hServer) (HeaderName -> Bool) -> (Header -> HeaderName) -> Header -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Header -> HeaderName
    forall a b. (a, b) -> a
    fst) ResponseHeaders
    hdrs
    addServer HeaderValue
    serverName IndexedHeader
    rspidxhdr ResponseHeaders
    hdrs = case IndexedHeader
    rspidxhdr IndexedHeader -> Int -> Maybe HeaderValue
    forall i e. Ix i => Array i e -> i -> e
    ! ResponseHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum ResponseHeaderIndex
    ResServer of
        Maybe HeaderValue
    Nothing -> (HeaderName
    H.hServer, HeaderValue
    serverName) Header -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    : ResponseHeaders
    hdrs
        Maybe HeaderValue
    _ -> ResponseHeaders
    hdrs

    addAltSvc :: Settings -> H.ResponseHeaders -> H.ResponseHeaders
    addAltSvc :: Settings -> ResponseHeaders -> ResponseHeaders
    addAltSvc Settings
    settings ResponseHeaders
    hs = case Settings -> Maybe HeaderValue
    settingsAltSvc Settings
    settings of
        Maybe HeaderValue
    Nothing -> ResponseHeaders
    hs
        Just HeaderValue
    v -> (HeaderName
    "Alt-Svc", HeaderValue
    v) Header -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    : ResponseHeaders
    hs

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

    -- |
    --
    -- >>> replaceHeader "Content-Type" "new" [("content-type","old")]
    -- [("Content-Type","new")]
    replaceHeader
        :: H.HeaderName -> HeaderValue -> H.ResponseHeaders -> H.ResponseHeaders
    replaceHeader :: HeaderName -> HeaderValue -> ResponseHeaders -> ResponseHeaders
    replaceHeader HeaderName
    k HeaderValue
    v ResponseHeaders
    hdrs = (HeaderName
    k, HeaderValue
    v) Header -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    : (Header -> Header -> Bool)
    -> Header -> ResponseHeaders -> ResponseHeaders
    forall a. (a -> a -> Bool) -> a -> [a] -> [a]
    deleteBy (HeaderName -> HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (HeaderName -> HeaderName -> Bool)
    -> (Header -> HeaderName) -> Header -> Header -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Header -> HeaderName
    forall a b. (a, b) -> a
    fst) (HeaderName
    k, HeaderValue
    v) ResponseHeaders
    hdrs

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

    composeHeaderBuilder
        :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
    composeHeaderBuilder :: HttpVersion -> Status -> ResponseHeaders -> Bool -> IO Builder
    composeHeaderBuilder HttpVersion
    ver Status
    s ResponseHeaders
    hs Bool
    True =
        HeaderValue -> Builder
    byteString (HeaderValue -> Builder) -> IO HeaderValue -> IO Builder
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HttpVersion -> Status -> ResponseHeaders -> IO HeaderValue
    composeHeader HttpVersion
    ver Status
    s (ResponseHeaders -> ResponseHeaders
    addTransferEncoding ResponseHeaders
    hs)
    composeHeaderBuilder HttpVersion
    ver Status
    s ResponseHeaders
    hs Bool
    False =
        HeaderValue -> Builder
    byteString (HeaderValue -> Builder) -> IO HeaderValue -> IO Builder
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HttpVersion -> Status -> ResponseHeaders -> IO HeaderValue
    composeHeader HttpVersion
    ver Status
    s ResponseHeaders
    hs