@@ -209,7 +209,7 @@ serveConnection settings th onException port app conn remoteHost' = do
209209 fromClient = sourceSocket th bytesPerRead conn
210210 serveConnection' :: ResourceT IO ()
211211 serveConnection' = do
212− (len, env) <- fromClient C.$$ parseRequest port remoteHost'
212+ (len, env) <- parseRequest port remoteHost' fromClient
213213 case settingsIntercept settings env of
214214 Nothing -> do
215215 -- Let the application run for as long as it wants
@@ -218,14 +218,16 @@ serveConnection settings th onException port app conn remoteHost' = do
218218 liftIO $ T.resume th
219219 keepAlive <- liftIO $ sendResponse th env conn res
220220 if keepAlive then serveConnection' else return ()
221− Just intercept -> undefined {-do
221+ Just intercept -> error "intercept" {-do
222222 liftIO $ T.pause th
223223 intercept conn-}
224224
225−parseRequest :: Port -> SockAddr -> C.Sink S.ByteString IO (Integer, Request)
226−parseRequest port remoteHost' = do
227− headers' <- takeHeaders
228− parseRequest' port headers' remoteHost'
225+parseRequest :: Port -> SockAddr
226+ -> C.Source IO S.ByteString
227+ -> ResourceT IO (Integer, Request)
228+parseRequest port remoteHost' src = do
229+ headers' <- takeHeaders src
230+ parseRequest' port headers' remoteHost' src
229231
230232-- FIXME come up with good values here
231233bytesPerRead, maxTotalHeaderLength :: Int
@@ -246,9 +248,10 @@ instance Exception InvalidRequest
246248parseRequest' :: Port
247249 -> [ByteString]
248250 -> SockAddr
249− -> C.Sink S.ByteString IO (Integer, Request)
250−parseRequest' _ [] _ = throwIO $ NotEnoughLines []
251−parseRequest' port (firstLine:otherLines) remoteHost' = do
251+ -> C.Source IO S.ByteString
252+ -> ResourceT IO (Integer, Request)
253+parseRequest' _ [] _ _ = throwIO $ NotEnoughLines []
254+parseRequest' port (firstLine:otherLines) remoteHost' src = do
252255 (method, rpath', gets, httpversion) <- parseFirst firstLine
253256 let (host',rpath) =
254257 if S.null rpath'
@@ -277,6 +280,7 @@ parseRequest' port (firstLine:otherLines) remoteHost' = do
277280 , requestHeaders = heads
278281 , isSecure = False
279282 , remoteHost = remoteHost'
283+ , requestBody = src -- FIXME isolate
280284 })
281285
282286
@@ -288,7 +292,7 @@ takeUntil c bs =
288292{-# INLINE takeUntil #-}
289293
290294parseFirst :: ByteString
291− -> C.Sink S.ByteString IO (ByteString, ByteString, ByteString, H.HttpVersion)
295+ -> ResourceT IO (ByteString, ByteString, ByteString, H.HttpVersion)
292296parseFirst s =
293297 case S.split 32 s of -- ' '
294298 [method, query, http'] -> do
@@ -420,7 +424,7 @@ sendResponse th req socket r = sendResponse' r
420424 `mappend` chunkedTransferTerminator
421425 else (headers' False) `mappend` b
422426
423− sendResponse' (ResponseEnumerator res) = undefined {-res enumResponse
427+ sendResponse' (ResponseEnumerator res) = error "sendResponse'" {-res enumResponse
424428 where
425429 enumResponse s hs = response True
426430 where
@@ -522,10 +526,10 @@ defaultSettings = Settings
522526 go' (Just ThreadKilled) = False
523527 go' _ = True
524528
525−takeHeaders :: C.Sink ByteString IO [ByteString]
526−takeHeaders = do
527− !x <- forceHead ConnectionClosedByPeer
528− takeHeaders' 0 id id x
529+takeHeaders :: C.Source IO ByteString -> ResourceT IO [ByteString]
530+takeHeaders src = do
531+ !x <- forceHead ConnectionClosedByPeer src
532+ takeHeaders' 0 id id x src
529533
530534{-# INLINE takeHeaders #-}
531535
@@ -533,17 +537,18 @@ takeHeaders' :: Int
533537 -> ([ByteString] -> [ByteString])
534538 -> ([ByteString] -> [ByteString])
535539 -> ByteString
536− -> C.Sink S.ByteString IO [ByteString]
537−takeHeaders' !len _ _ _ | len > maxTotalHeaderLength = throwIO OverLargeHeader
538−takeHeaders' !len !lines !prepend !bs = do
540+ -> C.Source IO ByteString
541+ -> ResourceT IO [ByteString]
542+takeHeaders' !len _ _ _ _ | len > maxTotalHeaderLength = throwIO OverLargeHeader
543+takeHeaders' !len !lines !prepend !bs src = do
539544 let !bsLen = {-# SCC "takeHeaders'.bsLen" #-} S.length bs
540545 !mnl = {-# SCC "takeHeaders'.mnl" #-} S.elemIndex 10 bs
541546 case mnl of
542547 -- no newline. prepend entire bs to next line
543548 !Nothing -> {-# SCC "takeHeaders'.noNewline" #-} do
544549 let !len' = len + bsLen
545− !more <- forceHead IncompleteHeaders
546− takeHeaders' len' lines (prepend . (:) bs) more
550+ !more <- forceHead IncompleteHeaders src
551+ takeHeaders' len' lines (prepend . (:) bs) more src
547552 Just !nl -> {-# SCC "takeHeaders'.newline" #-} do
548553 let !end = nl
549554 !start = nl + 1
@@ -561,7 +566,7 @@ takeHeaders' !len !lines !prepend !bs = do
561566 if start < bsLen
562567 then {-# SCC "takeHeaders'.noMoreHeaders.yield" #-} do
563568 let !rest = {-# SCC "takeHeaders'.noMoreHeaders.yield.rest" #-} SU.unsafeDrop start bs
564− undefined -- E.yield lines' $! E.Chunks [rest]
569+ error "yield" -- E.yield lines' $! E.Chunks [rest]
565570 else return lines'
566571
567572 -- more headers
@@ -571,19 +576,18 @@ takeHeaders' !len !lines !prepend !bs = do
571576 !more <- {-# SCC "takeHeaders'.more" #-}
572577 if start < bsLen
573578 then return $! SU.unsafeDrop start bs
574− else forceHead IncompleteHeaders
575− {-# SCC "takeHeaders'.takeMore" #-} takeHeaders' len' lines' id more
579+ else forceHead IncompleteHeaders src
580+ {-# SCC "takeHeaders'.takeMore" #-} takeHeaders' len' lines' id more src
576581{-# INLINE takeHeaders' #-}
577582
578−forceHead :: InvalidRequest -> C.Sink ByteString IO ByteString
579−forceHead err = do
580− undefined
581− {-
582− !mx <- EL.head
583+forceHead :: InvalidRequest
584+ -> C.Source IO ByteString
585+ -> ResourceT IO ByteString
586+forceHead err src = do
587+ !mx <- src C.$$ CL.head
583588 case mx of
584− !Nothing -> E.throwError err
585589 Just !x -> return x
586− -}
590+ Nothing -> throwIO err
587591{-# INLINE forceHead #-}
588592
589593checkCR :: ByteString -> Int -> Int