Optimization

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

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 468ef1179c78d5e9405f73b7f73879476c18d5fa..34452196a6148f0e0ac147c1c42174b6f78d21eb 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -1,4 +1,3 @@
--- #hide
 module Network.HTTP.Lucu.Interaction
     ( Interaction(..)
     , InteractionState(..)
@@ -16,12 +15,14 @@ module Network.HTTP.Lucu.Interaction
     where
 
 import           Control.Concurrent.STM
-import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.ByteString.Lazy.Char8 (ByteString)
+import           Data.ByteString.Base (ByteString, LazyByteString)
+import           Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.Sequence as S
 import           Data.Sequence (Seq)
 import           Network.Socket
 import           Network.HTTP.Lucu.Config
+import           Network.HTTP.Lucu.Headers
 import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
@@ -34,9 +35,7 @@ data Interaction = Interaction {
     , itrResponse     :: !(TVar Response)
 
     -- FIXME: この三つは本來 TVar であるべきでないので、唯の Bool にす
-    -- るに越した事は無いが、それは重要でない。そんな golf で自分の貴重
-    -- な時間を /dev/null に突っ込むのは、他にしたい事が何も無くなって
-    -- からにすべき。
+    -- るに越した事は無いが、それは重要でない。
     , itrRequestHasBody    :: !(TVar Bool)
     , itrRequestIsChunked  :: !(TVar Bool)
     , itrExpectedContinue  :: !(TVar Bool)
@@ -46,14 +45,14 @@ data Interaction = Interaction {
     , itrReqChunkIsOver    :: !(TVar Bool)
     , itrReqBodyWanted     :: !(TVar (Maybe Int))
     , itrReqBodyWasteAll   :: !(TVar Bool)
-    , itrReceivedBody      :: !(TVar ByteString) -- Resource が受領した部分は削除される
+    , itrReceivedBody      :: !(TVar LazyByteString) -- Resource が受領した部分は削除される
 
     , itrWillReceiveBody   :: !(TVar Bool)
     , itrWillChunkBody     :: !(TVar Bool)
     , itrWillDiscardBody   :: !(TVar Bool)
     , itrWillClose         :: !(TVar Bool)
 
-    , itrBodyToSend :: !(TVar ByteString)
+    , itrBodyToSend :: !(TVar LazyByteString)
     , itrBodyIsNull :: !(TVar Bool)
 
     , itrState :: !(TVar InteractionState)
@@ -78,8 +77,8 @@ newInteractionQueue :: IO InteractionQueue
 newInteractionQueue = newTVarIO S.empty
 
 
-defaultPageContentType :: String
-defaultPageContentType = "application/xhtml+xml"
+defaultPageContentType :: ByteString
+defaultPageContentType = C8.pack "application/xhtml+xml"
 
 
 newInteraction :: Config -> SockAddr -> Maybe Request -> IO Interaction
@@ -89,7 +88,7 @@ newInteraction conf addr req
          responce <- newTVarIO $ Response {
                        resVersion = HttpVersion 1 1
                      , resStatus  = Ok
-                     , resHeaders = [("Content-Type", defaultPageContentType)]
+                     , resHeaders = toHeaders [(C8.pack "Content-Type", defaultPageContentType)]
                      }
 
          requestHasBody     <- newTVarIO False
@@ -101,14 +100,14 @@ newInteraction conf addr req
          reqChunkIsOver     <- newTVarIO False   -- 最後のチャンクを讀み終へた
          reqBodyWanted      <- newTVarIO Nothing -- Resource が要求してゐるチャンク長
          reqBodyWasteAll    <- newTVarIO False   -- 殘りの body を讀み捨てよと云ふ要求
-         receivedBody       <- newTVarIO B.empty
+         receivedBody       <- newTVarIO L8.empty
 
          willReceiveBody   <- newTVarIO False
          willChunkBody     <- newTVarIO False
          willDiscardBody   <- newTVarIO False
          willClose         <- newTVarIO False
 
-         bodyToSend <- newTVarIO B.empty
+         bodyToSend <- newTVarIO L8.empty
          bodyIsNull <- newTVarIO True -- 一度でも bodyToSend が空でなくなったら False
 
          state <- newTVarIO ExaminingRequest