@@ -25,7 +25,7 @@ import Network.HTTP.Attoparsec (parseByteRanges)
2525import qualified Network.HTTP.Types as H
2626import Network.Wai
2727import Network.Wai.Handler.Warp.Header
28−import qualified Network.Wai.Handler.Warp.ResponseHeader as RH
28+import Network.Wai.Handler.Warp.ResponseHeader
2929import qualified Network.Wai.Handler.Warp.Timeout as T
3030import Network.Wai.Handler.Warp.Types
3131import Network.Wai.Internal
@@ -114,9 +114,9 @@ sendResponse :: Connection
114114sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart) =
115115 restore $ fileRange reqidxhdr rspidxhdr s0 hs path mpart >>= sendResponseEither
116116 where
117− hs = addAcceptRanges hs0
118− th = threadHandle ii
119117 rspidxhdr = indexResponseHeader hs0
118+ hs = addServer rspidxhdr $ addAcceptRanges hs0
119+ th = threadHandle ii
120120 sendResponseEither (Right (s, lengthyHeaders, beg, len))
121121 | hasBody s req = liftIO $ do
122122 lheader <- composeHeader version s lengthyHeaders
@@ -138,7 +138,7 @@ sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart) =
138138
139139----------------------------------------------------------------
140140
141−sendResponse conn ii restore req reqidxhdr (ResponseBuilder s hs b)
141+sendResponse conn ii restore req reqidxhdr (ResponseBuilder s hs0 b)
142142 | hasBody s req = restore $ do
143143 header <- composeHeaderBuilder version s hs needsChunked
144144 let body
@@ -154,14 +154,16 @@ sendResponse conn ii restore req reqidxhdr (ResponseBuilder s hs b)
154154 T.tickle th
155155 return isPersist
156156 where
157+ rspidxhdr = indexResponseHeader hs0
158+ hs = addServer rspidxhdr hs0
157159 th = threadHandle ii
158160 version = httpVersion req
159161 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
160− (isKeepAlive, needsChunked) = infoFromResponse hs reqinfo
162+ (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo
161163
162164----------------------------------------------------------------
163165
164−sendResponse conn ii restore req reqidxhdr (ResponseSource s hs withBodyFlush)
166+sendResponse conn ii restore req reqidxhdr (ResponseSource s hs0 withBodyFlush)
165167 | hasBody s req = withBodyFlush $ \bodyFlush -> restore $ do
166168 header <- liftIO $ composeHeaderBuilder version s hs needsChunked
167169 let src = CL.sourceList [header] `mappend` cbody bodyFlush
@@ -172,6 +174,8 @@ sendResponse conn ii restore req reqidxhdr (ResponseSource s hs withBodyFlush)
172174 T.tickle th
173175 return isPersist
174176 where
177+ rspidxhdr = indexResponseHeader hs0
178+ hs = addServer rspidxhdr hs0
175179 th = threadHandle ii
176180 cbody bodyFlush = if needsChunked then body $= chunk else body
177181 where
@@ -185,7 +189,7 @@ sendResponse conn ii restore req reqidxhdr (ResponseSource s hs withBodyFlush)
185189 chunk = await >>= maybe (yield chunkedTransferTerminator) (\x -> yield (chunkedTransferEncoding x) >> chunk)
186190 version = httpVersion req
187191 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
188− (isKeepAlive, needsChunked) = infoFromResponse hs reqinfo
192+ (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo
189193
190194----------------------------------------------------------------
191195----------------------------------------------------------------
@@ -235,15 +239,12 @@ checkChunk req = httpVersion req == H.http11
235239-- Don't use this for ResponseFile since this logic does not fit
236240-- for ResponseFile. For instance, isKeepAlive should be True in some cases
237241-- even if the response header does not have Content-Length.
238−infoFromResponse :: H.ResponseHeaders -> (Bool,Bool) -> (Bool,Bool)
239−infoFromResponse hs (isPersist,isChunked) = (isKeepAlive, needsChunked)
242+infoFromResponse :: IndexedHeader -> (Bool,Bool) -> (Bool,Bool)
243+infoFromResponse rspidxhdr (isPersist,isChunked) = (isKeepAlive, needsChunked)
240244 where
241245 needsChunked = isChunked && not hasLength
242246 isKeepAlive = isPersist && (isChunked || hasLength)
243− hasLength = isJust $ checkLength hs
244−
245−checkLength :: H.ResponseHeaders -> Maybe ByteString
246−checkLength = lookup H.hContentLength
247+ hasLength = isJust $ rspidxhdr ! idxContentLength
247248
248249----------------------------------------------------------------
249250
@@ -267,8 +268,8 @@ addAcceptRanges hdrs = (hAcceptRanges, "bytes") : hdrs
267268addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders
268269addTransferEncoding hdrs = (hTransferEncoding, "chunked") : hdrs
269270
270−addServer :: H.ResponseHeaders -> H.ResponseHeaders
271−addServer hdrs = case lookup hServer hdrs of
271+addServer :: IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
272+addServer rspidxhdr hdrs = case rspidxhdr ! idxServer of
272273 Nothing -> (hServer, defaultServerValue) : hdrs
273274 Just _ -> hdrs
274275
@@ -286,13 +287,6 @@ addContentRange total from to hdrs = (hContentRange, range) : hdrs
286287
287288----------------------------------------------------------------
288289
289−composeHeader :: H.HttpVersion
290− -> H.Status
291− -> H.ResponseHeaders
292− -> IO ByteString
293−composeHeader version s hs =
294− RH.composeHeader version s $ addServer hs
295−
296290composeHeaderBuilder :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
297291composeHeaderBuilder ver s hs True =
298292 fromByteString <$> composeHeader ver s (addTransferEncoding hs)