@@ -15,6 +15,7 @@ import Data.Conduit
1515import qualified Data.IORef as I
1616import Data.Maybe (fromMaybe)
1717import Data.Monoid (mempty)
18+import Data.Void (Void)
1819import Data.Word (Word8)
1920import qualified Network.HTTP.Types as H
2021import Network.Socket (SockAddr)
@@ -142,68 +143,69 @@ data THStatus = THStatus
142143takeHeaders :: Sink ByteString (ResourceT IO) [ByteString]
143144takeHeaders =
144145 await >>= maybe (throwIO ConnectionClosedByPeer) (push (THStatus 0 id id))
145− where
146− close :: Sink ByteString (ResourceT IO) a
147− close = throwIO IncompleteHeaders
148146
149− push (THStatus len lines prepend) bs
147+close :: Sink ByteString (ResourceT IO) a
148+close = throwIO IncompleteHeaders
149+
150+push :: THStatus -> ByteString -> Pipe ByteString ByteString Void () (ResourceT IO) [ByteString]
151+push (THStatus len lines prepend) bs
150152 -- Too many bytes
151153 | len > maxTotalHeaderLength = throwIO OverLargeHeader
152− | otherwise =
153− case mnl of
154− -- No newline find in this chunk. Add it to the prepend,
155− -- update the length, and continue processing.
156− Nothing ->
157− let len' = len + bsLen
158− prepend' = prepend . S.append bs
159− status = THStatus len' lines prepend'
160− in await >>= maybe close (push status)
161− -- Found a newline, but next line continues as a multiline header
162− Just (end, True) ->
163− let rest = S.drop (end + 1) bs
164− prepend' = prepend . S.append (SU.unsafeTake (checkCR bs end) bs)
165− len' = len + end
166− status = THStatus len' lines prepend'
167− in push status rest
168− -- Found a newline at position end.
169− Just (end, False) ->
170− let start = end + 1 -- start of next chunk
171− line
172− -- There were some bytes before the newline, get them
173− | end > 0 = prepend $ SU.unsafeTake (checkCR bs end) bs
174− -- No bytes before the newline
175− | otherwise = prepend S.empty
176− in if S.null line
177− -- no more headers
178− then
179− let lines' = lines []
180− -- leftover
181− rest = if start < bsLen
182− then Just (SU.unsafeDrop start bs)
183− else Nothing
184− in maybe (return ()) leftover rest >> return lines'
185− -- more headers
186− else
187− let len' = len + start
188− lines' = lines . (line:)
189− status = THStatus len' lines' id
190− in if start < bsLen
191− -- more bytes in this chunk, push again
192− then let bs' = SU.unsafeDrop start bs
193− in push status bs'
194− -- no more bytes in this chunk, ask for more
195− else await >>= maybe close (push status)
154+ | otherwise = push' mnl
155+ where
156+ bsLen = S.length bs
157+ mnl = do
158+ nl <- S.elemIndex 10 bs
159+ -- check if there are two more bytes in the bs
160+ -- if so, see if the second of those is a horizontal space
161+ if bsLen > nl + 1 then
162+ let c = S.index bs (nl + 1)
163+ in Just (nl, c == 32 || c == 9)
164+ else
165+ Just (nl, False)
166+
167+ {-# INLINE push' #-}
168+ -- No newline find in this chunk. Add it to the prepend,
169+ -- update the length, and continue processing.
170+ push' Nothing = await >>= maybe close (push status)
171+ where
172+ len' = len + bsLen
173+ prepend' = prepend . S.append bs
174+ status = THStatus len' lines prepend'
175+ -- Found a newline, but next line continues as a multiline header
176+ push' (Just (end, True)) = push status rest
177+ where
178+ rest = S.drop (end + 1) bs
179+ prepend' = prepend . S.append (SU.unsafeTake (checkCR bs end) bs)
180+ len' = len + end
181+ status = THStatus len' lines prepend'
182+ -- Found a newline at position end.
183+ push' (Just (end, False))
184+ -- leftover
185+ | S.null line = let lines' = lines []
186+ rest = if start < bsLen then
187+ Just (SU.unsafeDrop start bs)
188+ else
189+ Nothing
190+ in maybe (return ()) leftover rest >> return lines'
191+ -- more headers
192+ | otherwise = let len' = len + start
193+ lines' = lines . (line:)
194+ status = THStatus len' lines' id
195+ in if start < bsLen then
196+ -- more bytes in this chunk, push again
197+ let bs' = SU.unsafeDrop start bs
198+ in push status bs'
199+ else
200+ -- no more bytes in this chunk, ask for more
201+ await >>= maybe close (push status)
196202 where
197− bsLen = S.length bs
198− mnl = do
199− nl <- S.elemIndex 10 bs
200− -- check if there are two more bytes in the bs
201− -- if so, see if the second of those is a horizontal space
202− if bsLen > nl + 1 then
203− let c = S.index bs (nl + 1)
204− in Just (nl, c == 32 || c == 9)
205− else
206− Just (nl, False)
203+ start = end + 1 -- start of next chunk
204+ line
205+ -- There were some bytes before the newline, get them
206+ | end > 0 = prepend $ SU.unsafeTake (checkCR bs end) bs
207+ -- No bytes before the newline
208+ | otherwise = prepend S.empty
207209
208210{-# INLINE checkCR #-}
209211checkCR :: ByteString -> Int -> Int