getRequestURI should always return an absolute URI

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

diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
index a31e754adc2d6c4e16050c478df42b26eda2766c..bb4ba2824e979582db1ca79fc841f2221328e2d2 100644 (file)
--- a/Network/HTTP/Lucu/DefaultPage.hs
+++ b/Network/HTTP/Lucu/DefaultPage.hs
@@ -46,10 +46,11 @@ writeDefaultPage itr
     = do wroteHeader <- readTVar (itrWroteHeader itr)
 
          -- Content-Type が正しくなければ補完できない。
-         res <- readTVar (itrResponse itr)
+         res <- readItr itr itrResponse id
          when (getHeader "Content-Type" res == Just defaultPageContentType)
-                  $ do let reqM = itrRequest itr
-                           conf = itrConfig itr
+                  $ do reqM <- readItr itr itrRequest id
+
+                       let conf = itrConfig itr
                            page = B.pack $ getDefaultPage conf reqM res
 
                        writeTVar (itrBodyToSend itr)