@@ -3,7 +3,6 @@
33{-# LANGUAGE TupleSections #-}
44{-# LANGUAGE RankNTypes #-}
55{-# LANGUAGE CPP #-}
6−{-# LANGUAGE ViewPatterns #-}
76
87module Network.Wai.Handler.Warp.Response (
98 sendResponse
@@ -147,7 +146,7 @@ sendResponse :: ByteString -- ^ default server value
147146 -> IO ByteString -- ^ source from client, for raw response
148147 -> Response -- ^ HTTP response including status code and response header.
149148 -> IO Bool -- ^ Returing True if the connection is persistent.
150−sendResponse defServer conn ii req reqidxhdr src (sanitizeHeaders -> response) = do
149+sendResponse defServer conn ii req reqidxhdr src response = do
151150 hs <- addServerAndDate hs0
152151 if hasBody s then do
153152 -- HEAD comes here even if it does not have body.
@@ -161,7 +160,7 @@ sendResponse defServer conn ii req reqidxhdr src (sanitizeHeaders -> response) =
161160 where
162161 ver = httpVersion req
163162 s = responseStatus response
164− hs0 = responseHeaders response
163+ hs0 = sanitizeHeaders $ responseHeaders response
165164 rspidxhdr = indexResponseHeader hs0
166165 th = threadHandle ii
167166 dc = dateCacher ii
@@ -183,22 +182,32 @@ sendResponse defServer conn ii req reqidxhdr src (sanitizeHeaders -> response) =
183182 ResponseStream {} -> isKeepAlive
184183 ResponseRaw {} -> False
185184
186−sanitizeHeaders :: Response -> Response
187−sanitizeHeaders = mapResponseHeaders (map (sanitizeHeaderValue <$>))
185+----------------------------------------------------------------
186+
187+sanitizeHeaders :: H.ResponseHeaders -> H.ResponseHeaders
188+sanitizeHeaders = map (sanitize <$>)
189+ where
190+ sanitize v
191+ | containsNewlines v = sanitizeHeaderValue v -- slow path
192+ | otherwise = v -- fast path
188193
194+{-# INLINE containsNewlines #-}
195+containsNewlines :: ByteString -> Bool
196+containsNewlines = S.any (\w -> w == _cr || w == _lf)
197+
198+{-# INLINE sanitizeHeaderValue #-}
189199sanitizeHeaderValue :: ByteString -> ByteString
190−sanitizeHeaderValue v
191− | containsNewlines v = case S8.lines $ S.filter (/= _cr) v of
192− x : xs -> S.intercalate "\r\n" (x : mapMaybe addSpaceIfMissing xs)
193− [] -> ""
194− | otherwise = v
200+sanitizeHeaderValue v = case S8.lines $ S.filter (/= _cr) v of
201+ [] -> ""
202+ x : xs -> S8.intercalate "\r\n" (x : mapMaybe addSpaceIfMissing xs)
195203 where
196− containsNewlines = S.any (\w -> w == _cr || w == _lf)
197204 addSpaceIfMissing line = case S8.uncons line of
198− Nothing -> Nothing
199− Just (first, _) -> Just $ if first == ' ' || first == '\t'
200− then line
201− else " " <> line
205+ Nothing -> Nothing
206+ Just (first, _)
207+ | first == ' ' || first == '\t' -> Just line
208+ | otherwise -> Just $ " " <> line
209+
210+----------------------------------------------------------------
202211
203212data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) Bool (IO ())
204213 | RspBuilder Builder Bool