runResource :: ResourceDef -> Interaction -> IO ThreadId
runResource def itr
= fork
- $ catch ( runReaderT ( do fromMaybe notAllowed rsrc
+ $ catch ( runReaderT ( do req <- getRequest
+ fromMaybe notAllowed $ rsrc req
driftTo Done
) itr
)
then forkOS
else forkIO
- rsrc :: Maybe (Resource ())
- rsrc = case reqMethod $ fromJust $ itrRequest itr of
- GET -> resGet def
- HEAD -> case resHead def of
- Just r -> Just r
- Nothing -> resGet def
- POST -> resPost def
- PUT -> resPut def
- DELETE -> resDelete def
+ rsrc :: Request -> Maybe (Resource ())
+ rsrc req
+ = case reqMethod req of
+ GET -> resGet def
+ HEAD -> case resHead def of
+ Just r -> Just r
+ Nothing -> resGet def
+ POST -> resPost def
+ PUT -> resPut def
+ DELETE -> resDelete def
notAllowed :: Resource ()
notAllowed = do setStatus MethodNotAllowed
$ Just $ show exc
_ -> Abortion InternalServerError [] $ Just $ show exc
conf = itrConfig itr
- reqM = itrRequest itr
-- まだ DecidingHeader 以前の状態だったら、この途中終了
-- を應答に反映させる餘地がある。さうでなければ stderr
-- にでも吐くしか無い。
state <- atomically $ readItr itr itrState id
+ reqM <- atomically $ readItr itr itrRequest id
res <- atomically $ readItr itr itrResponse id
if state <= DecidingHeader then
flip runReaderT itr