preprocess :: Interaction -> STM ()
preprocess itr
- = do req <- readItr itr itrRequest fromJust
+ = itr `seq`
+ do req <- readItr itr itrRequest fromJust
let reqVer = reqVersion req
where
setStatus :: StatusCode -> STM ()
setStatus status
- = updateItr itr itrResponse
- $ \ res -> res {
- resStatus = status
- }
+ = status `seq`
+ updateItr itr itrResponse
+ $! \ res -> res {
+ resStatus = status
+ }
completeAuthority :: Request -> STM ()
completeAuthority req
- = when (uriAuthority (reqURI req) == Nothing)
+ = req `seq`
+ when (uriAuthority (reqURI req) == Nothing)
$ if reqVersion req == HttpVersion 1 0 then
-- HTTP/1.0 なので Config から補完
do let conf = itrConfig itr
updateAuthority :: String -> String -> STM ()
updateAuthority host portStr
- = updateItr itr itrRequest
- $ \ (Just req) -> Just req {
- reqURI = let uri = reqURI req
- in uri {
- uriAuthority = Just URIAuth {
- uriUserInfo = ""
- , uriRegName = host
- , uriPort = portStr
- }
- }
- }
+ = host `seq` portStr `seq`
+ updateItr itr itrRequest
+ $! \ (Just req) -> Just req {
+ reqURI = let uri = reqURI req
+ in uri {
+ uriAuthority = Just URIAuth {
+ uriUserInfo = ""
+ , uriRegName = host
+ , uriPort = portStr
+ }
+ }
+ }
+ preprocessHeader :: Interaction -> (String, String) -> STM ()
preprocessHeader itr (name, value)
- = case map toLower name of
+ = itr `seq` name `seq` value `seq`
+ case map toLower name of
"expect"
- -> if value `noCaseEq` "100-continue" then
+ -> if value `noCaseEq'` "100-continue" then
writeItr itr itrExpectedContinue True
else
setStatus ExpectationFailed