X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponseWriter.hs;h=52f6cf3476e1613c3e99c07805b1b467d33ccf85;hb=50e8fe7af585a8d33d93b3721be8f8f01905b891;hp=be9f37088143ebc3e92eb73771b9dd3c1733df92;hpb=47206637d664f163316dc9bb20983440ae4b138f;p=Lucu.git diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs index be9f370..52f6cf3 100644 --- a/Network/HTTP/Lucu/ResponseWriter.hs +++ b/Network/HTTP/Lucu/ResponseWriter.hs @@ -3,7 +3,7 @@ module Network.HTTP.Lucu.ResponseWriter ) where -import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as C8 import Control.Concurrent import Control.Concurrent.STM import Control.Exception @@ -12,6 +12,7 @@ import qualified Data.Sequence as S import Data.Sequence (ViewR(..)) import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.Format +import Network.HTTP.Lucu.Headers import Network.HTTP.Lucu.HttpVersion import Network.HTTP.Lucu.Interaction import Network.HTTP.Lucu.Postprocess @@ -89,7 +90,7 @@ responseWriter cnf h tQueue readerTID else do bodyToSend <- readItr itr itrBodyToSend id - if B.null bodyToSend then + if C8.null bodyToSend then do state <- readItr itr itrState id if state == Done then @@ -106,7 +107,7 @@ responseWriter cnf h tQueue readerTID do let cont = Response { resVersion = HttpVersion 1 1 , resStatus = Continue - , resHeaders = [] + , resHeaders = emptyHeaders } cont' <- completeUnconditionalHeaders cnf cont hPutResponse h cont' @@ -131,16 +132,16 @@ responseWriter cnf h tQueue readerTID do willDiscardBody <- atomically $! readItr itr itrWillDiscardBody id willChunkBody <- atomically $! readItr itr itrWillChunkBody id chunk <- atomically $! do chunk <- readItr itr itrBodyToSend id - writeItr itr itrBodyToSend B.empty + writeItr itr itrBodyToSend C8.empty return chunk unless willDiscardBody $ do if willChunkBody then - do hPutStr h (fmtHex False 0 $! fromIntegral $! B.length chunk) - hPutStr h "\r\n" - B.hPut h chunk - hPutStr h "\r\n" + do hPutStr h (fmtHex False 0 $! fromIntegral $! C8.length chunk) + C8.hPut h (C8.pack "\r\n") + C8.hPut h chunk + C8.hPut h (C8.pack "\r\n") else - B.hPut h chunk + C8.hPut h chunk hFlush h awaitSomethingToWrite @@ -151,7 +152,7 @@ responseWriter cnf h tQueue readerTID do willDiscardBody <- atomically $! readItr itr itrWillDiscardBody id willChunkBody <- atomically $! readItr itr itrWillChunkBody id when (not willDiscardBody && willChunkBody) - $ hPutStr h "0\r\n\r\n" >> hFlush h + $ C8.hPut h (C8.pack "0\r\n\r\n") >> hFlush h finalize :: Interaction -> IO () finalize itr