import Network.HTTP.Lucu.Preprocess
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Resource.Internal
import Network.HTTP.Lucu.Resource.Tree
import Network.Socket
import Network.URI
= do input ← hGetLBS h
acceptRequest (Context cnf tree fbs h port addr tQueue) input
`catches`
- [ Handler $ \ (_ ∷ IOException) → return ()
- , Handler $ \ e → case e of
- ThreadKilled → return ()
- _ → hPutStrLn stderr (show e)
- , Handler $ \ BlockedIndefinitelyOnSTM → hPutStrLn stderr "requestReader: blocked indefinitely"
- , Handler $ \ (e ∷ SomeException) → hPutStrLn stderr (show e)
+ [ Handler handleAsyncE
+ , Handler handleBIOS
+ , Handler handleOthers
]
+ where
+ handleAsyncE ∷ AsyncException → IO ()
+ handleAsyncE ThreadKilled = return ()
+ handleAsyncE e = dump e
+
+ handleBIOS ∷ BlockedIndefinitelyOnSTM → IO ()
+ handleBIOS = dump
+
+ handleOthers ∷ SomeException → IO ()
+ handleOthers = dump
+
+ dump ∷ Exception e ⇒ e → IO ()
+ dump e
+ = do hPutStrLn stderr "requestReader caught an exception:"
+ hPutStrLn stderr (show $ toException e)
acceptRequest ∷ HandleLike h ⇒ Context h → Lazy.ByteString → IO ()
acceptRequest ctx@(Context {..}) input
acceptRequestForExistentResource ctx oldItr input rsrcPath rsrcDef
= do let itr = oldItr { itrResourcePath = Just rsrcPath }
atomically $ enqueue ctx itr
- do _ ← runResource rsrcDef itr
+ do _ ← spawnResource rsrcDef itr
if reqMustHaveBody $ fromJust $ itrRequest itr then
observeRequest ctx itr input
else