X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FInteraction.hs;h=6045d97752e9551f1cf449da20939f60adb56e9e;hb=34b0ad7f2ffc5e7ca67fa3468d01c5551edc8a8b;hp=0dd925916cc68d7fc083d9d6c31827e883525777;hpb=30fcb38426696db8b80d322196cc594431e30407;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 0dd9259..6045d97 100644
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -3,14 +3,15 @@ module Network.HTTP.Lucu.Interaction
     ( Interaction(..)
     , InteractionState(..)
     , InteractionQueue
-    , newInteractionQueue -- IO InteractionQueue
-    , newInteraction      -- Config -> HostName -> Maybe Request -> IO Interaction
-
-    , writeItr   -- Interaction -> (Interaction -> TVar a) -> a -> STM ()
-    , readItr    -- Interaction -> (Interaction -> TVar a) -> (a -> b) -> STM b
-    , readItrF   -- (Functor f) => Interaction -> (Interaction -> TVar (f a)) -> (a -> b) -> STM (f b)
-    , updateItr  -- Interaction -> (Interaction -> TVar a) -> (a -> a) -> STM ()
-    , updateItrF -- (Functor f) => Interaction -> (Interaction -> TVar (f a)) -> (a -> a) -> STM ()
+    , newInteractionQueue
+    , newInteraction
+    , defaultPageContentType
+
+    , writeItr
+    , readItr
+    , readItrF
+    , updateItr
+    , updateItrF
     )
     where
 
@@ -21,6 +22,7 @@ import qualified Data.Sequence as S
 import           Data.Sequence (Seq)
 import           Network
 import           Network.HTTP.Lucu.Config
+import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
 
@@ -29,7 +31,7 @@ data Interaction = Interaction {
     , itrRemoteHost   :: HostName
     , itrResourcePath :: Maybe [String]
     , itrRequest      :: Maybe Request
-    , itrResponse     :: TVar (Maybe Response)
+    , itrResponse     :: TVar Response
 
     -- FIXME: この三つは本來 TVar であるべきでないので、唯の Bool にす
     -- るに越した事は無いが、それは重要でない。そんな golf で自分の貴重
@@ -76,9 +78,17 @@ newInteractionQueue :: IO InteractionQueue
 newInteractionQueue = newTVarIO S.empty
 
 
+defaultPageContentType :: String
+defaultPageContentType = "application/xhtml+xml"
+
+
 newInteraction :: Config -> HostName -> Maybe Request -> IO Interaction
 newInteraction conf host req
-    = do responce <- newTVarIO Nothing
+    = do responce <- newTVarIO $ Response {
+                       resVersion = HttpVersion 1 1
+                     , resStatus  = Ok
+                     , resHeaders = [("Content-Type", defaultPageContentType)]
+                     }
 
          requestHasBody     <- newTVarIO False
          requestIsChunked   <- newTVarIO False