X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=4c59b3e9f8b1ac5a1524d634d2595a339c80c853;hp=8830b5c010f8adf9d562207dfb1b43a33543a7d9;hb=1ead053df6a792edafa9d714c4c038a8a9c3ad16;hpb=b495d6b8b7647b719eceef2f3e50d5bf87c430cf

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 8830b5c..4c59b3e 100644
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -67,24 +67,22 @@ requestReader cnf tree fbs h port addr tQueue
          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
@@ -94,16 +92,12 @@ 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
@@ -144,7 +138,7 @@ acceptRequestForResource ∷ HandleLike h
                          → AugmentedRequest
                          → Lazy.ByteString
                          → [Strict.ByteString]
-                         → ResourceDef
+                         → Resource
                          → IO ()
 acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsrcPath rsrcDef
     = do
@@ -154,7 +148,7 @@ acceptRequestForResource ctx@(Context {..}) ar@(AugmentedRequest {..}) input rsr
 #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
@@ -381,8 +375,10 @@ readNonChunkedRequestBody ctx ni@(NI {..}) input bodyLen wanted
                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)