X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=12cad2040039a95fd30426076ebfc45534a4c3b0;hp=4f63f28bb2a7293e907e08df9f1fc2a845b5f419;hb=a9e9f50818285bf66cd64e5a248175eecb8e1fea;hpb=3c7a58ab749a55a30466a033b170536bcdf18b98

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 4f63f28..12cad20 100644
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -15,6 +15,7 @@ import qualified Data.Sequence as S
 import           Data.Sequence (Seq, (<|), ViewR(..))
 import           Network
 import           Network.HTTP.Lucu.Config
+import           Network.HTTP.Lucu.DefaultPage
 import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Interaction
 import           Network.HTTP.Lucu.Parser
@@ -63,9 +64,10 @@ requestReader cnf tree h host tQueue
                          , resStatus  = BadRequest
                          , resHeaders = []
                          }
-               atomically $ do writeTVar (itrResponse  itr) $ Just res
-                               writeTVar (itrWillClose itr) True
-                               writeTVar (itrState     itr) Done
+               atomically $ do writeItr itr itrResponse $ Just res
+                               writeItr itr itrWillClose True
+                               writeItr itr itrState     Done
+                               writeDefaultPage itr
                                postprocess itr
                                enqueue itr
 
@@ -75,8 +77,8 @@ requestReader cnf tree h host tQueue
                action
                    <- atomically $
                       do preprocess itr
-                         res <- readTVar (itrResponse itr)
-                         if fmap isError (fmap resStatus res) == Just True then
+                         isErr <- readItrF itr itrResponse (isError . resStatus)
+                         if isErr == Just True then
                              acceptSemanticallyInvalidRequest itr input'
                            else
                              case findResource tree $ (reqURI . fromJust . itrRequest) itr of
@@ -89,7 +91,8 @@ requestReader cnf tree h host tQueue
 
       acceptSemanticallyInvalidRequest :: Interaction -> ByteString -> STM (IO ())
       acceptSemanticallyInvalidRequest itr input
-          = do writeTVar (itrState itr) Done
+          = do writeItr itr itrState Done
+               writeDefaultPage itr
                postprocess itr
                enqueue itr
                return $ acceptRequest input
@@ -101,18 +104,19 @@ requestReader cnf tree h host tQueue
                          , resStatus  = NotFound
                          , resHeaders = []
                          }
-               writeTVar (itrResponse  itr) $ Just res
-               writeTVar (itrState     itr) Done
+               writeItr itr itrResponse $ Just res
+               writeItr itr itrState Done
+               writeDefaultPage itr
                postprocess itr
                enqueue itr
                return $ acceptRequest input
 
       acceptRequestForExistentResource :: Interaction -> ByteString -> ResourceDef -> STM (IO ())
       acceptRequestForExistentResource itr input rsrcDef
-          = do requestHasBody <- readTVar (itrRequestHasBody itr)
-               writeTVar (itrState itr) (if requestHasBody
-                                         then ExaminingHeader
-                                         else DecidingHeader)
+          = do requestHasBody <- readItr itr itrRequestHasBody id
+               writeItr itr itrState (if requestHasBody
+                                      then ExaminingHeader
+                                      else DecidingHeader)
                enqueue itr
                return $ do runResource rsrcDef itr
                            if requestHasBody then