X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=639a37104262ad37a762c2881118977e002489b3;hb=8e78bc83bfe67a376293c346ae0b30f1a684c787;hp=1d0f44f0f39c7fe9510bfe5f8fde36a140b9cc95;hpb=34b0ad7f2ffc5e7ca67fa3468d01c5551edc8a8b;p=Lucu.git

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 1d0f44f..639a371 100644
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -9,31 +9,28 @@ import           Control.Exception
 import           Control.Monad
 import qualified Data.ByteString.Lazy.Char8 as B
 import           Data.ByteString.Lazy.Char8 (ByteString)
-import           Data.Map as M
-import           Data.Map (Map)
 import           Data.Maybe
 import qualified Data.Sequence as S
-import           Data.Sequence (Seq, (<|), ViewR(..))
-import           Network
+import           Data.Sequence ((<|))
+import           Network.Socket
 import           Network.HTTP.Lucu.Config
 import           Network.HTTP.Lucu.Chunk
 import           Network.HTTP.Lucu.DefaultPage
-import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Interaction
 import           Network.HTTP.Lucu.Parser
 import           Network.HTTP.Lucu.Postprocess
 import           Network.HTTP.Lucu.Preprocess
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
-import           Network.HTTP.Lucu.Resource
 import           Network.HTTP.Lucu.Resource.Tree
 import           Prelude hiding (catch)
 import           System.IO
 
 
-requestReader :: Config -> ResTree -> Handle -> HostName -> InteractionQueue -> IO ()
-requestReader cnf tree h host tQueue
-    = do catch (do input <- B.hGetContents h
+requestReader :: Config -> ResTree -> Handle -> SockAddr -> InteractionQueue -> IO ()
+requestReader cnf tree h addr tQueue
+    = cnf `seq` tree `seq` h `seq` addr `seq` tQueue `seq`
+      do catch (do input <- B.hGetContents h
                    acceptRequest input) $ \ exc ->
              case exc of
                IOException _               -> return ()
@@ -59,7 +56,7 @@ requestReader cnf tree h host tQueue
 
       acceptNonparsableRequest :: StatusCode -> IO ()
       acceptNonparsableRequest status
-          = do itr <- newInteraction cnf host Nothing
+          = do itr <- newInteraction cnf addr Nothing
                atomically $ do updateItr itr itrResponse
                                              $ \ res -> res {
                                                           resStatus = status
@@ -72,7 +69,7 @@ requestReader cnf tree h host tQueue
 
       acceptParsableRequest :: Request -> ByteString -> IO ()
       acceptParsableRequest req input
-          = do itr <- newInteraction cnf host (Just req)
+          = do itr <- newInteraction cnf addr (Just req)
                action
                    <- atomically $
                       do preprocess itr
@@ -80,7 +77,7 @@ requestReader cnf tree h host tQueue
                          if isErr then
                              acceptSemanticallyInvalidRequest itr input
                            else
-                             case findResource tree $ (reqURI . fromJust . itrRequest) itr of
+                             case findResource tree $ reqURI req of
                                Nothing -- Resource が無かった
                                    -> acceptRequestForNonexistentResource itr input