@@ -356,20 +356,30 @@ hasBody s req = s /= (H.Status 204 "") && s /= H.status304 &&
356356
357357sendResponse :: T.Handle
358358 -> Request -> Socket -> Response -> IO Bool
359−sendResponse th req socket (ResponseFile s hs fp mpart) = do
360− (hs', cl) <-
361− case (readInt `fmap` lookup "content-length" hs, mpart) of
362− (Just cl, _) -> return (hs, cl)
363− (Nothing, Nothing) -> do
364− cl <- P.fileSize `fmap` P.getFileStatus fp
365− return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
366− (Nothing, Just part) -> do
367− let cl = filePartByteCount part
368− return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
369− Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers (httpVersion req) s hs' False
370− let isPersist= checkPersist req
371− if hasBody s req
372− then do
359+sendResponse th req socket r = sendResponse' r
360+ where
361+ version = httpVersion req
362+ isPersist = checkPersist req
363+ isChunked' = isChunked version
364+ needsChunked hs = isChunked' && not (hasLength hs)
365+ isKeepAlive hs = isPersist && (isChunked' || hasLength hs)
366+ hasLength hs = lookup "content-length" hs /= Nothing
367+
368+ sendResponse' :: Response -> IO Bool
369+ sendResponse' (ResponseFile s hs fp mpart) = do
370+ (lengthyHeaders, cl) <-
371+ case (readInt `fmap` lookup "content-length" hs, mpart) of
372+ (Just cl, _) -> return (hs, cl)
373+ (Nothing, Nothing) -> do
374+ cl <- P.fileSize `fmap` P.getFileStatus fp
375+ return $ addClToHeaders cl
376+ (Nothing, Just part) -> do
377+ let cl = filePartByteCount part
378+ return $ addClToHeaders cl
379+ Sock.sendMany socket $ L.toChunks $ toLazyByteString $
380+ headers version s lengthyHeaders False
381+
382+ if not (hasBody s req) then return isPersist else do
373383 case mpart of
374384 Nothing -> sendfile socket fp PartOfFile {
375385 rangeOffset = 0
@@ -381,58 +391,57 @@ sendResponse th req socket (ResponseFile s hs fp mpart) = do
381391 } (T.tickle th)
382392 T.tickle th
383393 return isPersist
384− else return isPersist
385−sendResponse th req socket (ResponseBuilder s hs b)
386− | hasBody s req = do
387− toByteStringIO (\bs -> do
388− Sock.sendAll socket bs
389− T.tickle th) b'
390− return isKeepAlive
391− | otherwise = do
392− Sock.sendMany socket
393− $ L.toChunks
394− $ toLazyByteString
395− $ headers (httpVersion req) s hs False
396− T.tickle th
397− return isPersist
398− where
399− headers' = headers (httpVersion req) s hs isChunked'
400− b' = if isChunked'
401− then headers'
402− `mappend` chunkedTransferEncoding b
403− `mappend` chunkedTransferTerminator
404− else headers (httpVersion req) s hs False `mappend` b
405− hasLength = lookup "content-length" hs /= Nothing
406− isChunked' = isChunked (httpVersion req) && not hasLength
407− isPersist = checkPersist req
408− isKeepAlive = isPersist && (isChunked' || hasLength)
409−sendResponse th req socket (ResponseEnumerator res) =
410− res go
411− where
412− -- FIXME perhaps alloca a buffer per thread and reuse that in all functiosn below. Should lessen greatly the GC burden (I hope)
413− go s hs | not (hasBody s req) = do
414− liftIO $ Sock.sendMany socket
415− $ L.toChunks $ toLazyByteString
416− $ headers (httpVersion req) s hs False
417− return (checkPersist req)
418− go s hs = chunk'
419− $ E.enumList 1 [headers (httpVersion req) s hs isChunked']
420− $$ E.joinI $ builderToByteString -- FIXME unsafeBuilderToByteString
421− $$ (iterSocket th socket >> return isKeepAlive)
422394 where
423− hasLength = lookup "content-length" hs /= Nothing
424− isChunked' = isChunked (httpVersion req) && not hasLength
425− isPersist = checkPersist req
426− isKeepAlive = isPersist && (isChunked' || hasLength)
427− chunk' i = if isChunked'
428− then E.joinI $ chunk $$ i
429− else i
430− chunk :: E.Enumeratee Builder Builder IO Bool
431− chunk = E.checkDone $ E.continue . step
432− step k E.EOF = k (E.Chunks [chunkedTransferTerminator]) >>== return
433− step k (E.Chunks []) = E.continue $ step k
434− step k (E.Chunks [x]) = k (E.Chunks [chunkedTransferEncoding x]) >>== chunk
435− step k (E.Chunks xs) = k (E.Chunks [chunkedTransferEncoding $ mconcat xs]) >>== chunk
395+ addClToHeaders cl = (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
396+
397+ sendResponse' (ResponseBuilder s hs b)
398+ | hasBody s req = do
399+ toByteStringIO (\bs -> do
400+ Sock.sendAll socket bs
401+ T.tickle th) body
402+ return (isKeepAlive hs)
403+ | otherwise = do
404+ Sock.sendMany socket
405+ $ L.toChunks
406+ $ toLazyByteString
407+ $ headers' False
408+ T.tickle th
409+ return isPersist
410+ where
411+ headers' = headers version s hs
412+ needsChunked' = needsChunked hs
413+ body = if needsChunked'
414+ then (headers' needsChunked')
415+ `mappend` chunkedTransferEncoding b
416+ `mappend` chunkedTransferTerminator
417+ else (headers' False) `mappend` b
418+
419+ sendResponse' (ResponseEnumerator res) = res enumResponse
420+ where
421+ enumResponse s hs = response True
422+ where
423+ headers' = headers version s hs
424+ -- FIXME perhaps alloca a buffer per thread and reuse that in all functiosn below. Should lessen greatly the GC burden (I hope)
425+ response _ | not (hasBody s req) = do
426+ liftIO $ Sock.sendMany socket
427+ $ L.toChunks $ toLazyByteString
428+ $ headers' False
429+ return (checkPersist req)
430+ response _ = chunk'
431+ $ E.enumList 1 [headers' needsChunked']
432+ $$ E.joinI $ builderToByteString -- FIXME unsafeBuilderToByteString
433+ $$ (iterSocket th socket >> return (isKeepAlive hs))
434+ where
435+ needsChunked' = needsChunked hs
436+ chunk' i = if needsChunked'
437+ then E.joinI $ chunk $$ i
438+ else i
439+ chunk :: E.Enumeratee Builder Builder IO Bool
440+ chunk = E.checkDone $ E.continue . step
441+ step k E.EOF = k (E.Chunks [chunkedTransferTerminator]) >>== return
442+ step k (E.Chunks []) = E.continue $ step k
443+ step k (E.Chunks [x]) = k (E.Chunks [chunkedTransferEncoding x]) >>== chunk
444+ step k (E.Chunks xs) = k (E.Chunks [chunkedTransferEncoding $ mconcat xs]) >>== chunk
436445
437446parseHeaderNoAttr :: ByteString -> H.Header
438447parseHeaderNoAttr s =