+-- #hide
module Network.HTTP.Lucu.Preprocess
- ( preprocess -- Interaction -> STM ()
+ ( preprocess
)
where
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
- POST -> ensureHavingBody itr
- PUT -> ensureHavingBody itr
+ HEAD -> writeItr itr itrWillDiscardBody True
+ POST -> writeItr itr itrRequestHasBody True
+ PUT -> writeItr itr itrRequestHasBody True
_ -> setStatus itr NotImplemented
mapM_ (preprocessHeader itr) (reqHeaders req)
where
- ensureHavingBody itr
- = let req = fromJust $ itrRequest itr
- in
- if getHeader req "Content-Length" == Nothing &&
- getHeader req "Transfer-Encoding" == Nothing then
-
- setStatus itr LengthRequired
- else
- writeTVar (itrRequestHasBody itr) 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)
+ do let len = read value
+ writeItr itr itrReqChunkLength $ Just len
+ writeItr itr itrReqChunkRemaining $ Just len
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