git.iko.soy/typeable/wai
on master help sign in
removing lookup with IndexedHeader.
a657107Kazu Yamamoto
warp/Network/Wai/Handler/Warp/Response.hs+16−22
compare with master
unifiedsplit
@@ -25,7 +25,7 @@ import Network.HTTP.Attoparsec (parseByteRanges)
25import qualified Network.HTTP.Types as H
25import qualified Network.HTTP.Types as H
26import Network.Wai
26import Network.Wai
27import Network.Wai.Handler.Warp.Header
27import Network.Wai.Handler.Warp.Header
28−import qualified Network.Wai.Handler.Warp.ResponseHeader as RH
28+import Network.Wai.Handler.Warp.ResponseHeader
29import qualified Network.Wai.Handler.Warp.Timeout as T
29import qualified Network.Wai.Handler.Warp.Timeout as T
30import Network.Wai.Handler.Warp.Types
30import Network.Wai.Handler.Warp.Types
31import Network.Wai.Internal
31import Network.Wai.Internal
@@ -114,9 +114,9 @@ sendResponse :: Connection
114sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart) =
114sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart) =
115 restore $ fileRange reqidxhdr rspidxhdr s0 hs path mpart >>= sendResponseEither
115 restore $ fileRange reqidxhdr rspidxhdr s0 hs path mpart >>= sendResponseEither
116 where
116 where
117− hs = addAcceptRanges hs0
118− th = threadHandle ii
119 rspidxhdr = indexResponseHeader hs0
117 rspidxhdr = indexResponseHeader hs0
118+ hs = addServer rspidxhdr $ addAcceptRanges hs0
119+ th = threadHandle ii
120 sendResponseEither (Right (s, lengthyHeaders, beg, len))
120 sendResponseEither (Right (s, lengthyHeaders, beg, len))
121 | hasBody s req = liftIO $ do
121 | hasBody s req = liftIO $ do
122 lheader <- composeHeader version s lengthyHeaders
122 lheader <- composeHeader version s lengthyHeaders
@@ -138,7 +138,7 @@ sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart) =
138
138
139----------------------------------------------------------------
139----------------------------------------------------------------
140
140
141−sendResponse conn ii restore req reqidxhdr (ResponseBuilder s hs b)
141+sendResponse conn ii restore req reqidxhdr (ResponseBuilder s hs0 b)
142 | hasBody s req = restore $ do
142 | hasBody s req = restore $ do
143 header <- composeHeaderBuilder version s hs needsChunked
143 header <- composeHeaderBuilder version s hs needsChunked
144 let body
144 let body
@@ -154,14 +154,16 @@ sendResponse conn ii restore req reqidxhdr (ResponseBuilder s hs b)
154 T.tickle th
154 T.tickle th
155 return isPersist
155 return isPersist
156 where
156 where
157+ rspidxhdr = indexResponseHeader hs0
158+ hs = addServer rspidxhdr hs0
157 th = threadHandle ii
159 th = threadHandle ii
158 version = httpVersion req
160 version = httpVersion req
159 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
161 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
160− (isKeepAlive, needsChunked) = infoFromResponse hs reqinfo
162+ (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo
161
163
162----------------------------------------------------------------
164----------------------------------------------------------------
163
165
164−sendResponse conn ii restore req reqidxhdr (ResponseSource s hs withBodyFlush)
166+sendResponse conn ii restore req reqidxhdr (ResponseSource s hs0 withBodyFlush)
165 | hasBody s req = withBodyFlush $ \bodyFlush -> restore $ do
167 | hasBody s req = withBodyFlush $ \bodyFlush -> restore $ do
166 header <- liftIO $ composeHeaderBuilder version s hs needsChunked
168 header <- liftIO $ composeHeaderBuilder version s hs needsChunked
167 let src = CL.sourceList [header] `mappend` cbody bodyFlush
169 let src = CL.sourceList [header] `mappend` cbody bodyFlush
@@ -172,6 +174,8 @@ sendResponse conn ii restore req reqidxhdr (ResponseSource s hs withBodyFlush)
172 T.tickle th
174 T.tickle th
173 return isPersist
175 return isPersist
174 where
176 where
177+ rspidxhdr = indexResponseHeader hs0
178+ hs = addServer rspidxhdr hs0
175 th = threadHandle ii
179 th = threadHandle ii
176 cbody bodyFlush = if needsChunked then body $= chunk else body
180 cbody bodyFlush = if needsChunked then body $= chunk else body
177 where
181 where
@@ -185,7 +189,7 @@ sendResponse conn ii restore req reqidxhdr (ResponseSource s hs withBodyFlush)
185 chunk = await >>= maybe (yield chunkedTransferTerminator) (\x -> yield (chunkedTransferEncoding x) >> chunk)
189 chunk = await >>= maybe (yield chunkedTransferTerminator) (\x -> yield (chunkedTransferEncoding x) >> chunk)
186 version = httpVersion req
190 version = httpVersion req
187 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
191 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
188− (isKeepAlive, needsChunked) = infoFromResponse hs reqinfo
192+ (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo
189
193
190----------------------------------------------------------------
194----------------------------------------------------------------
191----------------------------------------------------------------
195----------------------------------------------------------------
@@ -235,15 +239,12 @@ checkChunk req = httpVersion req == H.http11
235-- Don't use this for ResponseFile since this logic does not fit
239-- Don't use this for ResponseFile since this logic does not fit
236-- for ResponseFile. For instance, isKeepAlive should be True in some cases
240-- for ResponseFile. For instance, isKeepAlive should be True in some cases
237-- even if the response header does not have Content-Length.
241-- even if the response header does not have Content-Length.
238−infoFromResponse :: H.ResponseHeaders -> (Bool,Bool) -> (Bool,Bool)
242+infoFromResponse :: IndexedHeader -> (Bool,Bool) -> (Bool,Bool)
239−infoFromResponse hs (isPersist,isChunked) = (isKeepAlive, needsChunked)
243+infoFromResponse rspidxhdr (isPersist,isChunked) = (isKeepAlive, needsChunked)
240 where
244 where
241 needsChunked = isChunked && not hasLength
245 needsChunked = isChunked && not hasLength
242 isKeepAlive = isPersist && (isChunked || hasLength)
246 isKeepAlive = isPersist && (isChunked || hasLength)
243− hasLength = isJust $ checkLength hs
247+ hasLength = isJust $ rspidxhdr ! idxContentLength
244−
245−checkLength :: H.ResponseHeaders -> Maybe ByteString
246−checkLength = lookup H.hContentLength
247
248
248----------------------------------------------------------------
249----------------------------------------------------------------
249
250
@@ -267,8 +268,8 @@ addAcceptRanges hdrs = (hAcceptRanges, "bytes") : hdrs
267addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders
268addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders
268addTransferEncoding hdrs = (hTransferEncoding, "chunked") : hdrs
269addTransferEncoding hdrs = (hTransferEncoding, "chunked") : hdrs
269
270
270−addServer :: H.ResponseHeaders -> H.ResponseHeaders
271+addServer :: IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
271−addServer hdrs = case lookup hServer hdrs of
272+addServer rspidxhdr hdrs = case rspidxhdr ! idxServer of
272 Nothing -> (hServer, defaultServerValue) : hdrs
273 Nothing -> (hServer, defaultServerValue) : hdrs
273 Just _ -> hdrs
274 Just _ -> hdrs
274
275
@@ -286,13 +287,6 @@ addContentRange total from to hdrs = (hContentRange, range) : hdrs
286
287
287----------------------------------------------------------------
288----------------------------------------------------------------
288
289
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−
296composeHeaderBuilder :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
290composeHeaderBuilder :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
297composeHeaderBuilder ver s hs True =
291composeHeaderBuilder ver s hs True =
298 fromByteString <$> composeHeader ver s (addTransferEncoding hs)
292 fromByteString <$> composeHeader ver s (addTransferEncoding hs)