+-- #hide
module Network.HTTP.Lucu.Preprocess
- ( preprocess -- Interaction -> STM ()
+ ( preprocess
)
where
case reqMethod req of
GET -> return ()
HEAD -> writeItr itr itrWillDiscardBody True
- POST -> ensureHavingBody itr
- PUT -> ensureHavingBody itr
+ 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 "Content-Length" req == Nothing &&
- getHeader "Transfer-Encoding" req == Nothing then
-
- setStatus itr LengthRequired
- else
- writeItr itr itrRequestHasBody True
-
setStatus itr status
- = writeItr itr itrResponse $ Just (Response {
- resVersion = HttpVersion 1 1
- , resStatus = status
- , resHeaders = []
- })
+ = updateItr itr itrResponse
+ $ \ res -> res {
+ resStatus = status
+ }
preprocessHeader itr (name, value)
= case map toLower name of