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

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

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.Version (showVersion)
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 Paths_warp
import qualified System.TimeManager as T
import qualified UnliftIO

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
    [(HeaderName, HeaderValue)]
hs <- [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
forall {b}. IsString b => [(HeaderName, b)] -> [(HeaderName, b)]
addConnection ([(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)])
-> ([(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)])
-> [(HeaderName, HeaderValue)]
-> [(HeaderName, HeaderValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings
-> [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
addAltSvc Settings
settings ([(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)])
-> IO [(HeaderName, HeaderValue)] -> IO [(HeaderName, HeaderValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(HeaderName, HeaderValue)] -> IO [(HeaderName, HeaderValue)]
addServerAndDate [(HeaderName, HeaderValue)]
hs0
    if Status -> Bool
hasBody Status
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.
            (Maybe Status
ms, Maybe Integer
mlen) <- Connection
-> InternalInfo
-> Handle
-> HttpVersion
-> Status
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> Rsp
-> IO (Maybe Status, Maybe Integer)
sendRsp Connection
conn InternalInfo
ii Handle
th HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs IndexedHeader
rspidxhdr Int
maxRspBufSize HeaderValue
method Rsp
rsp
            case Maybe Status
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
            Handle -> IO ()
T.tickle Handle
th
            Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
ret
        else do
            (Maybe Status, Maybe Integer)
_ <- Connection
-> InternalInfo
-> Handle
-> HttpVersion
-> Status
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> Rsp
-> IO (Maybe Status, Maybe Integer)
sendRsp Connection
conn InternalInfo
ii Handle
th HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs IndexedHeader
rspidxhdr Int
maxRspBufSize HeaderValue
method Rsp
RspNoBody
            Request -> Status -> Maybe Integer -> IO ()
logger Request
req Status
s Maybe Integer
forall a. Maybe a
Nothing
            Handle -> IO ()
T.tickle Handle
th
            Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: [(HeaderName, HeaderValue)]
hs0 = [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
sanitizeHeaders ([(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)])
-> [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
forall a b. (a -> b) -> a -> b
$ Response -> [(HeaderName, HeaderValue)]
responseHeaders Response
response
    rspidxhdr :: IndexedHeader
rspidxhdr = [(HeaderName, HeaderValue)] -> IndexedHeader
indexResponseHeader [(HeaderName, HeaderValue)]
hs0
    addConnection :: [(HeaderName, b)] -> [(HeaderName, b)]
addConnection [(HeaderName, b)]
hs = if (Status -> Bool
hasBody Status
s Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ret) Bool -> Bool -> Bool
|| (Bool -> Bool
not (Status -> Bool
hasBody Status
s) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isPersist)
                       then (HeaderName
H.hConnection, b
"close") (HeaderName, b) -> [(HeaderName, b)] -> [(HeaderName, b)]
forall a. a -> [a] -> [a]
: [(HeaderName, b)]
hs
                       else [(HeaderName, b)]
hs
    getdate :: IO HeaderValue
getdate = InternalInfo -> IO HeaderValue
getDate InternalInfo
ii
    addServerAndDate :: [(HeaderName, HeaderValue)] -> IO [(HeaderName, HeaderValue)]
addServerAndDate = IO HeaderValue
-> IndexedHeader
-> [(HeaderName, HeaderValue)]
-> IO [(HeaderName, HeaderValue)]
addDate IO HeaderValue
getdate IndexedHeader
rspidxhdr ([(HeaderName, HeaderValue)] -> IO [(HeaderName, HeaderValue)])
-> ([(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)])
-> [(HeaderName, HeaderValue)]
-> IO [(HeaderName, HeaderValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderValue
-> IndexedHeader
-> [(HeaderName, HeaderValue)]
-> [(HeaderName, HeaderValue)]
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
_ [(HeaderName, HeaderValue)]
_ 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
_ [(HeaderName, HeaderValue)]
_ Builder
b
            | Bool
isHead -> Rsp
RspNoBody
            | Bool
otherwise -> Builder -> Bool -> Rsp
RspBuilder Builder
b Bool
needsChunked
        ResponseStream Status
_ [(HeaderName, HeaderValue)]
_ 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 :: [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
sanitizeHeaders = ((HeaderName, HeaderValue) -> (HeaderName, HeaderValue))
-> [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderValue -> HeaderValue
sanitize (HeaderValue -> HeaderValue)
-> (HeaderName, HeaderValue) -> (HeaderName, HeaderValue)
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
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> Rsp
-> IO (Maybe Status, Maybe Integer)
sendRsp Connection
conn InternalInfo
_ Handle
_ HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs IndexedHeader
_ Int
_ HeaderValue
_ Rsp
RspNoBody = do
    -- Not adding Content-Length.
    -- User agents treats it as Content-Length: 0.
    HttpVersion
-> Status -> [(HeaderName, HeaderValue)] -> IO HeaderValue
composeHeader HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
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 [(HeaderName, HeaderValue)]
hs IndexedHeader
_ Int
maxRspBufSize HeaderValue
_ (RspBuilder Builder
body Bool
needsChunked) = do
    Builder
header <- HttpVersion
-> Status -> [(HeaderName, HeaderValue)] -> Bool -> IO Builder
composeHeaderBuilder HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs Bool
needsChunked
    let hdrBdy :: Builder
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 :: IORef WriteBuffer
writeBufferRef = Connection -> IORef WriteBuffer
connWriteBuffer Connection
conn
    Integer
len <-
        Int
-> IORef WriteBuffer
-> (HeaderValue -> IO ())
-> Builder
-> IO Integer
toBufIOWith
            Int
maxRspBufSize
            IORef WriteBuffer
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)
            Builder
hdrBdy
    (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, Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
len)

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

sendRsp Connection
conn InternalInfo
_ Handle
th HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs IndexedHeader
_ Int
_ HeaderValue
_ (RspStream StreamingBody
streamingBody Bool
needsChunked) = do
    Builder
header <- HttpVersion
-> Status -> [(HeaderName, HeaderValue)] -> Bool -> IO Builder
composeHeaderBuilder HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs Bool
needsChunked
    (BuilderRecv
recv, BuilderFinish
finish) <-
        BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish)
newByteStringBuilderRecv (BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish))
-> BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish)
forall a b. (a -> b) -> a -> b
$
            IO Buffer -> BufferAllocStrategy
reuseBufferStrategy (IO Buffer -> BufferAllocStrategy)
-> IO Buffer -> BufferAllocStrategy
forall a b. (a -> b) -> a -> b
$
                IORef WriteBuffer -> IO Buffer
toBuilderBuffer (IORef WriteBuffer -> IO Buffer) -> IORef WriteBuffer -> IO Buffer
forall a b. (a -> b) -> a -> b
$
                    Connection -> IORef WriteBuffer
connWriteBuffer Connection
conn
    let send :: Builder -> IO ()
send Builder
builder = do
            IO HeaderValue
popper <- BuilderRecv
recv Builder
builder
            let loop :: IO ()
loop = do
                    HeaderValue
bs <- IO HeaderValue
popper
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HeaderValue -> Bool
S.null HeaderValue
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        Connection -> Handle -> HeaderValue -> IO ()
sendFragment Connection
conn Handle
th HeaderValue
bs
                        IO ()
loop
            IO ()
loop
        sendChunk :: Builder -> IO ()
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
    Builder -> IO ()
send Builder
header
    StreamingBody
streamingBody Builder -> IO ()
sendChunk (Builder -> IO ()
sendChunk Builder
flush)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsChunked (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> IO ()
send Builder
chunkedTransferTerminator
    Maybe HeaderValue
mbs <- BuilderFinish
finish
    IO () -> (HeaderValue -> IO ()) -> Maybe HeaderValue -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Connection -> Handle -> HeaderValue -> IO ()
sendFragment Connection
conn Handle
th) Maybe HeaderValue
mbs
    (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) -- fixme: can we tell the actual sent bytes?

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

sendRsp Connection
conn InternalInfo
_ Handle
th HttpVersion
_ Status
_ [(HeaderName, HeaderValue)]
_ 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
        HeaderValue
bs <- IO HeaderValue
src
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HeaderValue -> Bool
S.null HeaderValue
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
T.tickle Handle
th
        HeaderValue -> IO HeaderValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HeaderValue
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 [(HeaderName, HeaderValue)]
hs0 IndexedHeader
rspidxhdr Int
maxRspBufSize HeaderValue
method (RspFile FilePath
path (Just FilePart
part) IndexedHeader
_ IO ()
hook) =
    Connection
-> InternalInfo
-> Handle
-> HttpVersion
-> Status
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> FilePath
-> Integer
-> Integer
-> IO ()
-> IO (Maybe Status, Maybe Integer)
sendRspFile2XX
        Connection
conn
        InternalInfo
ii
        Handle
th
        HttpVersion
ver
        Status
s0
        [(HeaderName, HeaderValue)]
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 :: [(HeaderName, HeaderValue)]
hs = [(HeaderName, HeaderValue)]
-> FilePart -> [(HeaderName, HeaderValue)]
addContentHeadersForFilePart [(HeaderName, HeaderValue)]
hs0 FilePart
part

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

-- Simple WAI applications.
-- Status is ignored
sendRsp Connection
conn InternalInfo
ii Handle
th HttpVersion
ver Status
_ [(HeaderName, HeaderValue)]
hs0 IndexedHeader
rspidxhdr Int
maxRspBufSize HeaderValue
method (RspFile FilePath
path Maybe FilePart
Nothing IndexedHeader
reqidxhdr IO ()
hook) = do
    Either IOException FileInfo
efinfo <- IO FileInfo -> IO (Either IOException FileInfo)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
UnliftIO.tryIO (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 Either IOException FileInfo
efinfo of
        Left (IOException
_ex :: UnliftIO.IOException) ->
#ifdef WARP_DEBUG
            print _ex >>
#endif
            Connection
-> InternalInfo
-> Handle
-> HttpVersion
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> IO (Maybe Status, Maybe Integer)
sendRspFile404 Connection
conn InternalInfo
ii Handle
th HttpVersion
ver [(HeaderName, HeaderValue)]
hs0 IndexedHeader
rspidxhdr Int
maxRspBufSize HeaderValue
method
        Right FileInfo
finfo -> case FileInfo
-> [(HeaderName, HeaderValue)]
-> HeaderValue
-> IndexedHeader
-> IndexedHeader
-> RspFileInfo
conditionalRequest FileInfo
finfo [(HeaderName, HeaderValue)]
hs0 HeaderValue
method IndexedHeader
rspidxhdr IndexedHeader
reqidxhdr of
            WithoutBody Status
s ->
                Connection
-> InternalInfo
-> Handle
-> HttpVersion
-> Status
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> Rsp
-> IO (Maybe Status, Maybe Integer)
sendRsp Connection
conn InternalInfo
ii Handle
th HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs0 IndexedHeader
rspidxhdr Int
maxRspBufSize HeaderValue
method Rsp
RspNoBody
            WithBody Status
s [(HeaderName, HeaderValue)]
hs Integer
beg Integer
len ->
                Connection
-> InternalInfo
-> Handle
-> HttpVersion
-> Status
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> FilePath
-> Integer
-> Integer
-> IO ()
-> IO (Maybe Status, Maybe Integer)
sendRspFile2XX
                    Connection
conn
                    InternalInfo
ii
                    Handle
th
                    HttpVersion
ver
                    Status
s
                    [(HeaderName, HeaderValue)]
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
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> FilePath
-> Integer
-> Integer
-> IO ()
-> IO (Maybe Status, Maybe Integer)
sendRspFile2XX Connection
conn InternalInfo
ii Handle
th HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
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
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> Rsp
-> IO (Maybe Status, Maybe Integer)
sendRsp Connection
conn InternalInfo
ii Handle
th HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs IndexedHeader
rspidxhdr Int
maxRspBufSize HeaderValue
method Rsp
RspNoBody
    | Bool
otherwise = do
        HeaderValue
lheader <- HttpVersion
-> Status -> [(HeaderName, HeaderValue)] -> IO HeaderValue
composeHeader HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs
        (Maybe Fd
mfd, IO ()
fresher) <- InternalInfo -> FilePath -> IO (Maybe Fd, IO ())
getFd InternalInfo
ii FilePath
path
        let fid :: FileId
fid = FilePath -> Maybe Fd -> FileId
FileId FilePath
path Maybe Fd
mfd
            hook' :: IO ()
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
        Connection -> SendFile
connSendFile Connection
conn FileId
fid Integer
beg Integer
len IO ()
hook' [HeaderValue
lheader]
        (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, Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
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
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> IO (Maybe Status, Maybe Integer)
sendRspFile404 Connection
conn InternalInfo
ii Handle
th HttpVersion
ver [(HeaderName, HeaderValue)]
hs0 IndexedHeader
rspidxhdr Int
maxRspBufSize HeaderValue
method =
    Connection
-> InternalInfo
-> Handle
-> HttpVersion
-> Status
-> [(HeaderName, HeaderValue)]
-> IndexedHeader
-> Int
-> HeaderValue
-> Rsp
-> IO (Maybe Status, Maybe Integer)
sendRsp
        Connection
conn
        InternalInfo
ii
        Handle
th
        HttpVersion
ver
        Status
s
        [(HeaderName, HeaderValue)]
hs
        IndexedHeader
rspidxhdr
        Int
maxRspBufSize
        HeaderValue
method
        (Builder -> Bool -> Rsp
RspBuilder Builder
body Bool
True)
  where
    s :: Status
s = Status
H.notFound404
    hs :: [(HeaderName, HeaderValue)]
hs = HeaderName
-> HeaderValue
-> [(HeaderName, HeaderValue)]
-> [(HeaderName, HeaderValue)]
replaceHeader HeaderName
H.hContentType HeaderValue
"text/plain; charset=utf-8" [(HeaderName, HeaderValue)]
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 :: [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
addTransferEncoding [(HeaderName, HeaderValue)]
hdrs = (HeaderName
H.hTransferEncoding, HeaderValue
"chunked") (HeaderName, HeaderValue)
-> [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
forall a. a -> [a] -> [a]
: [(HeaderName, HeaderValue)]
hdrs

addDate
    :: IO D.GMTDate -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders
addDate :: IO HeaderValue
-> IndexedHeader
-> [(HeaderName, HeaderValue)]
-> IO [(HeaderName, HeaderValue)]
addDate IO HeaderValue
getdate IndexedHeader
rspidxhdr [(HeaderName, HeaderValue)]
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
        HeaderValue
gmtdate <- IO HeaderValue
getdate
        [(HeaderName, HeaderValue)] -> IO [(HeaderName, HeaderValue)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(HeaderName, HeaderValue)] -> IO [(HeaderName, HeaderValue)])
-> [(HeaderName, HeaderValue)] -> IO [(HeaderName, HeaderValue)]
forall a b. (a -> b) -> a -> b
$ (HeaderName
H.hDate, HeaderValue
gmtdate) (HeaderName, HeaderValue)
-> [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
forall a. a -> [a] -> [a]
: [(HeaderName, HeaderValue)]
hdrs
    Just HeaderValue
_ -> [(HeaderName, HeaderValue)] -> IO [(HeaderName, HeaderValue)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(HeaderName, HeaderValue)]
hdrs

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

-- | The version of Warp.
warpVersion :: String
warpVersion :: FilePath
warpVersion = Version -> FilePath
showVersion Version
Paths_warp.version

{-# INLINE addServer #-}
addServer
    :: HeaderValue -> IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
addServer :: HeaderValue
-> IndexedHeader
-> [(HeaderName, HeaderValue)]
-> [(HeaderName, HeaderValue)]
addServer HeaderValue
"" IndexedHeader
rspidxhdr [(HeaderName, HeaderValue)]
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, HeaderValue)]
hdrs
    Maybe HeaderValue
_ -> ((HeaderName, HeaderValue) -> Bool)
-> [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
H.hServer) (HeaderName -> Bool)
-> ((HeaderName, HeaderValue) -> HeaderName)
-> (HeaderName, HeaderValue)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, HeaderValue) -> HeaderName
forall a b. (a, b) -> a
fst) [(HeaderName, HeaderValue)]
hdrs
addServer HeaderValue
serverName IndexedHeader
rspidxhdr [(HeaderName, HeaderValue)]
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) (HeaderName, HeaderValue)
-> [(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
forall a. a -> [a] -> [a]
: [(HeaderName, HeaderValue)]
hdrs
    Maybe HeaderValue
_ -> [(HeaderName, HeaderValue)]
hdrs

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

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

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

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

composeHeaderBuilder
    :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
composeHeaderBuilder :: HttpVersion
-> Status -> [(HeaderName, HeaderValue)] -> Bool -> IO Builder
composeHeaderBuilder HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
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 -> [(HeaderName, HeaderValue)] -> IO HeaderValue
composeHeader HttpVersion
ver Status
s ([(HeaderName, HeaderValue)] -> [(HeaderName, HeaderValue)]
addTransferEncoding [(HeaderName, HeaderValue)]
hs)
composeHeaderBuilder HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
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 -> [(HeaderName, HeaderValue)] -> IO HeaderValue
composeHeader HttpVersion
ver Status
s [(HeaderName, HeaderValue)]
hs