Many improvements

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

diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
index e8fdfc630b20bf4dea3de677f6daeb392d7fd852..3552e489e23da5494182a034788f90ef5519949d 100644 (file)
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -54,22 +54,22 @@ preprocess itr
             reqVer /= HttpVersion 1 1 then
 
              do setStatus itr HttpVersionNotSupported
-                writeTVar (itrWillClose itr) True
+                writeItr itr itrWillClose True
 
            else
              do if reqVer == HttpVersion 1 0 then
                     -- HTTP/1.0 では Keep-Alive できない
-                    writeTVar (itrWillClose itr) True
+                    writeItr itr itrWillClose True
                   else
                     -- URI または Host: ヘッダのどちらかにホストが無ければ
                     -- ならない。
                     when (uriAuthority (reqURI req) == Nothing &&
-                          getHeader req "Host"      == Nothing)
+                          getHeader "Host" req      == Nothing)
                              $ setStatus itr BadRequest
 
                 case reqMethod req of
                   GET  -> return ()
-                  HEAD -> writeTVar (itrWillDiscardBody itr) True
+                  HEAD -> writeItr itr itrWillDiscardBody True
                   POST -> ensureHavingBody itr
                   PUT  -> ensureHavingBody itr
                   _    -> setStatus itr NotImplemented
@@ -79,44 +79,44 @@ preprocess itr
       ensureHavingBody itr
           = let req = fromJust $ itrRequest itr
             in
-              if getHeader req "Content-Length"    == Nothing &&
-                 getHeader req "Transfer-Encoding" == Nothing then
+              if getHeader "Content-Length"    req == Nothing &&
+                 getHeader "Transfer-Encoding" req == Nothing then
 
                   setStatus itr LengthRequired
               else
-                  writeTVar (itrRequestHasBody itr) True
+                  writeItr itr itrRequestHasBody True
 
       setStatus itr status
-          = writeTVar (itrResponse itr) (Just $ Response {
-                                                    resVersion = HttpVersion 1 1
-                                                  , resStatus  = status
-                                                  , resHeaders = []
-                                                  })
+          = writeItr itr itrResponse $ Just (Response {
+                                               resVersion = HttpVersion 1 1
+                                             , resStatus  = status
+                                             , resHeaders = []
+                                             })
 
       preprocessHeader itr (name, value)
           = case map toLower name of
 
               "expect"
                   -> if value `noCaseEq` "100-continue" then
-                         writeTVar (itrExpectedContinue itr) True
+                         writeItr itr itrExpectedContinue True
                      else
                          setStatus itr ExpectationFailed
 
               "transfer-encoding"
                   -> case map toLower value of
                        "identity" -> return ()
-                       "chunked"  -> writeTVar (itrRequestIsChunked itr) True
+                       "chunked"  -> writeItr itr itrRequestIsChunked True
                        _          -> setStatus itr NotImplemented
 
               "content-length"
                   -> if all isDigit value then
-                         writeTVar (itrRequestBodyLength itr) (Just $ read value)
+                         writeItr itr itrRequestBodyLength $ Just $ read value
                      else
                          setStatus itr BadRequest
 
               "connection"
                   -> case map toLower value of
-                       "close"      -> writeTVar (itrWillClose itr) True
+                       "close"      -> writeItr itr itrWillClose True
                        _            -> return ()
 
               _ -> return ()
\ No newline at end of file