X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FInteraction.hs;h=4ac7c093607729fe8784acc3f8e914c96fed1b66;hb=72a3e24;hp=ac5c1d6285aa33d936d4ae23135cb09b4ef8e125;hpb=ea2b7838f1b3d9d4923a220a601be2e04cc559d7;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index ac5c1d6..4ac7c09 100644
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -9,21 +9,19 @@ module Network.HTTP.Lucu.Interaction
     , InteractionQueue
     , newInteractionQueue
     , newInteraction
-    , defaultPageContentType
 
     , setResponseStatus
     )
     where
 import Blaze.ByteString.Builder (Builder)
 import Control.Concurrent.STM
-import Data.Ascii (Ascii)
 import qualified Data.ByteString as BS
+import Data.Monoid.Unicode
 import Data.Sequence (Seq)
 import qualified Data.Sequence as S
 import Data.Text (Text)
 import Network.Socket
 import Network.HTTP.Lucu.Config
-import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.HttpVersion
 import Network.HTTP.Lucu.Preprocess
 import Network.HTTP.Lucu.Request
@@ -51,8 +49,8 @@ data Interaction = Interaction {
     , itrWillChunkBody     ∷ !(TVar Bool)
     , itrWillDiscardBody   ∷ !(TVar Bool)
     , itrWillClose         ∷ !(TVar Bool)
+    , itrResponseHasCType  ∷ !(TVar Bool)
     , itrBodyToSend        ∷ !(TMVar Builder)
-    , itrSentNoBodySoFar   ∷ !(TVar Bool)
 
     , itrState             ∷ !(TVar InteractionState)
     }
@@ -71,9 +69,6 @@ type InteractionQueue = TVar (Seq Interaction)
 newInteractionQueue ∷ IO InteractionQueue
 newInteractionQueue = newTVarIO S.empty
 
-defaultPageContentType ∷ Ascii
-defaultPageContentType = "application/xhtml+xml"
-
 newInteraction ∷ Config
                → PortNumber
                → SockAddr
@@ -85,7 +80,7 @@ newInteraction conf@(Config {..}) port addr cert request
              res = Response {
                      resVersion = HttpVersion 1 1
                    , resStatus  = arInitialStatus ar
-                   , resHeaders = singleton "Content-Type" defaultPageContentType
+                   , resHeaders = (∅)
                    }
 
          reqBodyWanted   ← newTVarIO 0
@@ -94,14 +89,14 @@ newInteraction conf@(Config {..}) port addr cert request
          receivedBody    ← newTVarIO S.empty
          receivedBodyLen ← newTVarIO 0
 
-         response        ← newTVarIO res
-         willChunkBody   ← newTVarIO False
-         willDiscardBody ← newTVarIO False
-         willClose       ← newTVarIO False
-         bodyToSend      ← newEmptyTMVarIO
-         sentNoBodySoFar ← newTVarIO True
+         response         ← newTVarIO res
+         willChunkBody    ← newTVarIO False
+         willDiscardBody  ← newTVarIO (arWillDiscardBody ar)
+         willClose        ← newTVarIO (arWillClose       ar)
+         bodyToSend       ← newEmptyTMVarIO
+         responseHasCType ← newTVarIO False
 
-         state           ← newTVarIO ExaminingRequest
+         state            ← newTVarIO ExaminingRequest
 
          return Interaction {
                       itrConfig       = conf
@@ -124,8 +119,8 @@ newInteraction conf@(Config {..}) port addr cert request
                     , itrWillChunkBody    = willChunkBody
                     , itrWillDiscardBody  = willDiscardBody
                     , itrWillClose        = willClose
+                    , itrResponseHasCType = responseHasCType
                     , itrBodyToSend       = bodyToSend
-                    , itrSentNoBodySoFar  = sentNoBodySoFar
                     
                     , itrState            = state
                     }