many changes...

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

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 52a5e2eea41e76b334015fedcee80089babad881..ac9c46f5a93b8e8a78c1bcb583f1d712b0c8a374 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -11,20 +11,16 @@ module Network.HTTP.Lucu.Interaction
     , newInteraction
     , defaultPageContentType
 
-    , chunksToLBS
-    , chunksFromLBS
-
     , writeItr
     , readItr
     , updateItr
     )
     where
+import Blaze.ByteString.Builder (Builder)
 import Control.Applicative
 import Control.Concurrent.STM
 import Data.Ascii (Ascii)
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as LBS
-import Data.Foldable
 import Data.Sequence (Seq)
 import qualified Data.Sequence as S
 import Network.Socket
@@ -34,7 +30,6 @@ import Network.HTTP.Lucu.HttpVersion
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
 import OpenSSL.X509
-import Prelude.Unicode
 
 data Interaction = Interaction {
       itrConfig            ∷ !Config
@@ -55,13 +50,14 @@ data Interaction = Interaction {
     , itrReqBodyWanted     ∷ !(TVar (Maybe Int))
     , itrReqBodyWasteAll   ∷ !(TVar Bool)
     , itrReceivedBody      ∷ !(TVar (Seq BS.ByteString))
+    , itrReceivedBodyLen   ∷ !(TVar Int)
 
     , itrWillReceiveBody   ∷ !(TVar Bool)
     , itrWillChunkBody     ∷ !(TVar Bool)
     , itrWillDiscardBody   ∷ !(TVar Bool)
     , itrWillClose         ∷ !(TVar Bool)
 
-    , itrBodyToSend        ∷ !(TVar (Seq BS.ByteString))
+    , itrBodyToSend        ∷ !(TMVar Builder)
     , itrBodyIsNull        ∷ !(TVar Bool)
 
     , itrState             ∷ !(TVar InteractionState)
@@ -106,13 +102,14 @@ newInteraction !conf !port !addr !cert !req
          reqBodyWanted      ← newTVarIO Nothing -- Resource が要求してゐるチャンク長
          reqBodyWasteAll    ← newTVarIO False   -- 殘りの body を讀み捨てよと云ふ要求
          receivedBody       ← newTVarIO S.empty
+         receivedBodyLen    ← newTVarIO 0
 
          willReceiveBody   ← newTVarIO False
          willChunkBody     ← newTVarIO False
          willDiscardBody   ← newTVarIO False
          willClose         ← newTVarIO False
 
-         bodyToSend ← newTVarIO S.empty
+         bodyToSend ← newEmptyTMVarIO
          bodyIsNull ← newTVarIO True -- 一度でも bodyToSend が空でなくなったら False
 
          state ← newTVarIO ExaminingRequest
@@ -139,6 +136,7 @@ newInteraction !conf !port !addr !cert !req
                     , itrReqBodyWanted     = reqBodyWanted
                     , itrReqBodyWasteAll   = reqBodyWasteAll
                     , itrReceivedBody      = receivedBody
+                    , itrReceivedBodyLen   = receivedBodyLen
 
                     , itrWillReceiveBody   = willReceiveBody
                     , itrWillChunkBody     = willChunkBody
@@ -154,6 +152,7 @@ newInteraction !conf !port !addr !cert !req
                     , itrWroteHeader   = wroteHeader
                     }
 
+{-
 chunksToLBS ∷ Seq BS.ByteString → LBS.ByteString
 {-# INLINE chunksToLBS #-}
 chunksToLBS = LBS.fromChunks ∘ toList
@@ -161,6 +160,7 @@ chunksToLBS = LBS.fromChunks ∘ toList
 chunksFromLBS ∷ LBS.ByteString → Seq BS.ByteString
 {-# INLINE chunksFromLBS #-}
 chunksFromLBS = S.fromList ∘ LBS.toChunks
+-}
 
 writeItr ∷ (Interaction → TVar a) → a → Interaction → STM ()
 {-# INLINE writeItr #-}