Optimization

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

diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
index 37b1a75ad997dbc7cfe14cf5fca0b91c5b4b287b..ef6689892ca753f23909fe467932ef470589b669 100644 (file)
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -5,6 +5,8 @@ module Network.HTTP.Lucu.Preprocess
 
 import           Control.Concurrent.STM
 import           Control.Monad
+import           Data.ByteString.Base (ByteString)
+import qualified Data.ByteString.Char8 as C8
 import           Data.Char
 import           Data.Maybe
 import           Network.HTTP.Lucu.Config
@@ -13,7 +15,6 @@ import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Interaction
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
-import           Network.HTTP.Lucu.Utils
 import           Network
 import           Network.URI
 
@@ -74,7 +75,7 @@ preprocess itr
                   PUT  -> writeItr itr itrRequestHasBody True
                   _    -> setStatus NotImplemented
                   
-                mapM_ (preprocessHeader itr) (reqHeaders req)
+                preprocessHeader itr req
     where
       setStatus :: StatusCode -> STM ()
       setStatus status
@@ -101,24 +102,24 @@ preprocess itr
                                   Just n  -> Just $ ":" ++ show n
                                   Nothing -> Nothing
                      case portStr of
-                       Just str -> updateAuthority host str
+                       Just str -> updateAuthority host (C8.pack str)
                        -- FIXME: このエラーの原因は、listen してゐるソ
                        -- ケットが INET でない故にポート番號が分からな
                        -- い事だが、その事をどうにかして通知した方が良
                        -- いと思ふ。stderr？
                        Nothing  -> setStatus InternalServerError
               else
-                  do case getHeader "Host" req of
+                  do case getHeader (C8.pack "Host") req of
                        Just str -> let (host, portStr) = parseHost str
                                    in updateAuthority host portStr
                        Nothing  -> setStatus BadRequest
 
 
-      parseHost :: String -> (String, String)
-      parseHost = break (== ':')
+      parseHost :: ByteString -> (ByteString, ByteString)
+      parseHost = C8.break (== ':')
 
 
-      updateAuthority :: String -> String -> STM ()
+      updateAuthority :: ByteString -> ByteString -> STM ()
       updateAuthority host portStr
           = host `seq` portStr `seq`
             updateItr itr itrRequest
@@ -127,41 +128,45 @@ preprocess itr
                                           in uri {
                                                uriAuthority = Just URIAuth {
                                                                    uriUserInfo = ""
-                                                                 , uriRegName  = host
-                                                                 , uriPort     = portStr
+                                                                 , uriRegName  = C8.unpack host
+                                                                 , uriPort     = C8.unpack portStr
                                                               }
                                              }
                                }
                 
 
-      preprocessHeader :: Interaction -> (String, String) -> STM ()
-      preprocessHeader itr (name, value)
-          = itr `seq` name `seq` value `seq`
-            case map toLower name of
-
-              "expect"
-                  -> if value `noCaseEq'` "100-continue" then
-                         writeItr itr itrExpectedContinue True
-                     else
-                         setStatus ExpectationFailed
-
-              "transfer-encoding"
-                  -> case map toLower value of
-                       "identity" -> return ()
-                       "chunked"  -> writeItr itr itrRequestIsChunked True
-                       _          -> setStatus NotImplemented
-
-              "content-length"
-                  -> if all isDigit value then
-                         do let len = read value
-                            writeItr itr itrReqChunkLength    $ Just len
-                            writeItr itr itrReqChunkRemaining $ Just len
-                     else
-                         setStatus BadRequest
-
-              "connection"
-                  -> case map toLower value of
-                       "close"      -> writeItr itr itrWillClose True
-                       _            -> return ()
-
-              _ -> return ()
\ No newline at end of file
+      preprocessHeader :: Interaction -> Request -> STM ()
+      preprocessHeader itr req
+          = itr `seq` req `seq`
+            do case getHeader (C8.pack "Expect") req of
+                 Nothing    -> return ()
+                 Just value -> if value `noCaseEq` C8.pack "100-continue" then
+                                   writeItr itr itrExpectedContinue True
+                               else
+                                   setStatus ExpectationFailed
+
+               case getHeader (C8.pack "Transfer-Encoding") req of
+                 Nothing    -> return ()
+                 Just value -> if value `noCaseEq` C8.pack "identity" then
+                                   return ()
+                               else
+                                   if value `noCaseEq` C8.pack "chunked" then
+                                       writeItr itr itrRequestIsChunked True
+                                   else
+                                       setStatus NotImplemented
+
+               case getHeader (C8.pack "Content-Length") req of
+                 Nothing    -> return ()
+                 Just value -> if C8.all isDigit value then
+                                   do let Just (len, _) = C8.readInt value
+                                      writeItr itr itrReqChunkLength    $ Just len
+                                      writeItr itr itrReqChunkRemaining $ Just len
+                               else
+                                   setStatus BadRequest
+
+               case getHeader (C8.pack "Connection") req of
+                 Nothing    -> return ()
+                 Just value -> if value `noCaseEq` C8.pack "close" then
+                                   writeItr itr itrWillClose True
+                               else
+                                   return ()