- ensureHavingBody itr
- = let req = fromJust $ itrRequest itr
- in
- if getHeader req "Content-Length" == Nothing &&
- getHeader req "Transfer-Encoding" == Nothing then
-
- setStatus itr LengthRequired
+ setStatus :: StatusCode -> STM ()
+ setStatus status
+ = status `seq`
+ updateItr itr itrResponse
+ $! \ res -> res {
+ resStatus = status
+ }
+
+ completeAuthority :: Request -> STM ()
+ completeAuthority req
+ = req `seq`
+ when (uriAuthority (reqURI req) == Nothing)
+ $ if reqVersion req == HttpVersion 1 0 then
+ -- HTTP/1.0 なので Config から補完
+ do let conf = itrConfig itr
+ host = cnfServerHost conf
+ port = case cnfServerPort conf of
+ PortNumber n -> Just $ fromIntegral n
+ _ -> Nothing
+ portStr
+ = case port of
+ Just 80 -> Just ""
+ Just n -> Just $ ":" ++ show n
+ Nothing -> Nothing
+ case portStr of
+ Just str -> updateAuthority host str
+ -- FIXME: このエラーの原因は、listen してゐるソ
+ -- ケットが INET でない故にポート番號が分からな
+ -- い事だが、その事をどうにかして通知した方が良
+ -- いと思ふ。stderr?
+ Nothing -> setStatus InternalServerError