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
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
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)
-- いと思ふ。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
}
- 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
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 ()
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