]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/Interaction.hs
Optimization
[Lucu.git] / Network / HTTP / Lucu / Interaction.hs
index 91979c9d5449e7a1b2ee7811a0c8294a9d381fc7..34452196a6148f0e0ac147c1c42174b6f78d21eb 100644 (file)
@@ -15,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
@@ -43,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)
@@ -75,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
@@ -86,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
@@ -98,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