X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FInteraction.hs;h=34452196a6148f0e0ac147c1c42174b6f78d21eb;hp=91979c9d5449e7a1b2ee7811a0c8294a9d381fc7;hb=15aa04a569fb13fb0793389f78f52b0255083cef;hpb=ea8f823ffa1004582d403c69f52a83e20486269f diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs index 91979c9..3445219 100644 --- a/Network/HTTP/Lucu/Interaction.hs +++ b/Network/HTTP/Lucu/Interaction.hs @@ -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