acceptRequest (Context cnf tree fbs h port addr tQueue) input
`catches`
[ Handler handleAsyncE
- , Handler handleBIOS
, Handler handleOthers
]
+ `finally`
+ enqueue' tQueue EndOfInteraction
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)
+ = do hPutStrLn stderr "Lucu: requestReader caught an exception:"
+ hPutStrLn stderr $ show e
acceptRequest ∷ HandleLike h ⇒ Context h → Lazy.ByteString → IO ()
acceptRequest ctx@(Context {..}) input
-- Too many requests in the pipeline...
retry
if Lazy.null input then
- endOfRequests ctx
+ return ()
else
case LP.parse request input of
LP.Done input' req → acceptParsableRequest ctx req input'
LP.Fail _ _ _ → acceptNonparsableRequest ctx
-endOfRequests ∷ HandleLike h ⇒ Context h → IO ()
-endOfRequests ctx
- = enqueue ctx EndOfInteraction
-
acceptNonparsableRequest ∷ HandleLike h ⇒ Context h → IO ()
acceptNonparsableRequest ctx@(Context {..})
= do syi ← mkSyntacticallyInvalidInteraction cConfig
→ AugmentedRequest
→ Lazy.ByteString
→ [Strict.ByteString]
- → ResourceDef
+ → Resource
→ IO ()
acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsrcPath rsrcDef
= do
#else
ni ← mkNormalInteraction cConfig cAddr ar rsrcPath
#endif
- tid ← spawnResource rsrcDef ni
+ tid ← spawnRsrc rsrcDef ni
enqueue ctx ni
if reqMustHaveBody arRequest then
waitForReceiveBodyReq ctx ni tid input
acceptRequest ctx input
enqueue ∷ (HandleLike h, Interaction i) ⇒ Context h → i → IO ()
-{-# INLINEABLE enqueue #-}
-enqueue (Context {..}) itr
+enqueue (Context {..}) = enqueue' cQueue
+
+enqueue' ∷ Interaction i ⇒ InteractionQueue → i → IO ()
+enqueue' tQueue itr
= atomically $
- do queue ← readTVar cQueue
- writeTVar cQueue (toInteraction itr ⊲ queue)
+ do queue ← readTVar tQueue
+ writeTVar tQueue (toInteraction itr ⊲ queue)