getRequestURI should always return an absolute URI

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

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 6045d97752e9551f1cf449da20939f60adb56e9e..88cded5c339209fc2f1d023a50c28318747ca4fa 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -30,7 +30,7 @@ data Interaction = Interaction {
       itrConfig       :: Config
     , itrRemoteHost   :: HostName
     , itrResourcePath :: Maybe [String]
-    , itrRequest      :: Maybe Request
+    , itrRequest      :: TVar (Maybe Request)
     , itrResponse     :: TVar Response
 
     -- FIXME: この三つは本來 TVar であるべきでないので、唯の Bool にす
@@ -84,7 +84,8 @@ defaultPageContentType = "application/xhtml+xml"
 
 newInteraction :: Config -> HostName -> Maybe Request -> IO Interaction
 newInteraction conf host req
-    = do responce <- newTVarIO $ Response {
+    = do request  <- newTVarIO $ req
+         responce <- newTVarIO $ Response {
                        resVersion = HttpVersion 1 1
                      , resStatus  = Ok
                      , resHeaders = [("Content-Type", defaultPageContentType)]
@@ -118,7 +119,7 @@ newInteraction conf host req
                       itrConfig       = conf
                     , itrRemoteHost   = host
                     , itrResourcePath = Nothing
-                    , itrRequest      = req
+                    , itrRequest      = request
                     , itrResponse     = responce
 
                     , itrRequestHasBody    = requestHasBody