X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FPreprocess.hs;h=de5efaae4ac5bce5d23bab1658609092a95f8df4;hb=f62b6f07bbf1eefcf552163d8f7daa6e0862ed5d;hp=ef6689892ca753f23909fe467932ef470589b669;hpb=15aa04a569fb13fb0793389f78f52b0255083cef;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
index ef66898..de5efaa 100644
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -5,8 +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 qualified Data.ByteString as Strict (ByteString)
+import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
 import           Data.Char
 import           Data.Maybe
 import           Network.HTTP.Lucu.Config
@@ -69,13 +69,14 @@ preprocess itr
                 completeAuthority req
 
                 case reqMethod req of
-                  GET  -> return ()
-                  HEAD -> writeItr itr itrWillDiscardBody True
-                  POST -> writeItr itr itrRequestHasBody True
-                  PUT  -> writeItr itr itrRequestHasBody True
-                  _    -> setStatus NotImplemented
+                  GET    -> return ()
+                  HEAD   -> writeItr itr itrWillDiscardBody True
+                  POST   -> writeItr itr itrRequestHasBody True
+                  PUT    -> writeItr itr itrRequestHasBody True
+                  DELETE -> return ()
+                  _      -> setStatus NotImplemented
                   
-                preprocessHeader itr req
+                preprocessHeader req
     where
       setStatus :: StatusCode -> STM ()
       setStatus status
@@ -94,12 +95,12 @@ preprocess itr
                   do let conf = itrConfig itr
                          host = cnfServerHost conf
                          port = case cnfServerPort conf of
-                                  PortNumber n -> Just $ fromIntegral n
+                                  PortNumber n -> Just (fromIntegral n :: Int)
                                   _            -> Nothing
                          portStr
                               = case port of
                                   Just 80 -> Just ""
-                                  Just n  -> Just $ ":" ++ show n
+                                  Just n  -> Just $ ':' : show n
                                   Nothing -> Nothing
                      case portStr of
                        Just str -> updateAuthority host (C8.pack str)
@@ -109,17 +110,17 @@ preprocess itr
                        -- いと思ふ。stderr？
                        Nothing  -> setStatus InternalServerError
               else
-                  do case getHeader (C8.pack "Host") req of
-                       Just str -> let (host, portStr) = parseHost str
-                                   in updateAuthority host portStr
-                       Nothing  -> setStatus BadRequest
+                  case getHeader (C8.pack "Host") req of
+                    Just str -> let (host, portStr) = parseHost str
+                                in updateAuthority host portStr
+                    Nothing  -> setStatus BadRequest
 
 
-      parseHost :: ByteString -> (ByteString, ByteString)
+      parseHost :: Strict.ByteString -> (Strict.ByteString, Strict.ByteString)
       parseHost = C8.break (== ':')
 
 
-      updateAuthority :: ByteString -> ByteString -> STM ()
+      updateAuthority :: Strict.ByteString -> Strict.ByteString -> STM ()
       updateAuthority host portStr
           = host `seq` portStr `seq`
             updateItr itr itrRequest
@@ -135,9 +136,9 @@ preprocess itr
                                }
                 
 
-      preprocessHeader :: Interaction -> Request -> STM ()
-      preprocessHeader itr req
-          = itr `seq` req `seq`
+      preprocessHeader :: Request -> STM ()
+      preprocessHeader req
+          = req `seq`
             do case getHeader (C8.pack "Expect") req of
                  Nothing    -> return ()
                  Just value -> if value `noCaseEq` C8.pack "100-continue" then
@@ -147,13 +148,11 @@ preprocess itr
 
                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
+                 Just value -> unless (value `noCaseEq` C8.pack "identity")
+                                   $ if value `noCaseEq` C8.pack "chunked" then
+                                         writeItr itr itrRequestIsChunked True
+                                     else
+                                         setStatus NotImplemented
 
                case getHeader (C8.pack "Content-Length") req of
                  Nothing    -> return ()
@@ -166,7 +165,5 @@ preprocess itr
 
                case getHeader (C8.pack "Connection") req of
                  Nothing    -> return ()
-                 Just value -> if value `noCaseEq` C8.pack "close" then
-                                   writeItr itr itrWillClose True
-                               else
-                                   return ()
+                 Just value -> when (value `noCaseEq` C8.pack "close")
+                                   $ writeItr itr itrWillClose True