Implemented fallback handler.

[Lucu.git] / Network / HTTP / Lucu / ResponseWriter.hs

diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs
index be9f37088143ebc3e92eb73771b9dd3c1733df92..52f6cf3476e1613c3e99c07805b1b467d33ccf85 100644 (file)
--- 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