Have libev's timeout thread initially use the defaultTimeout, and mak…

…e sure send always updates the timeout thread
snapframework · Oct 5, 2011 · 134d5cf · 134d5cf
1 parent 04e866c
commit 134d5cf
Show file tree

Hide file tree

Showing 2 changed files with 3 additions and 4 deletions.
diff --git a/src/Snap/Internal/Http/Server/HttpPort.hs b/src/Snap/Internal/Http/Server/HttpPort.hs
@@ -99,7 +99,7 @@ send tickleTimeout onBlock (NetworkSession s _ _) bs =
           let sent' = fromIntegral sent
           if sent' < len
              then tickleTimeout >> loop (plusPtr ptr sent') (len - sent')
-             else return ()
+             else tickleTimeout
 
 
 ------------------------------------------------------------------------------

diff --git a/src/Snap/Internal/Http/Server/LibevBackend.hs b/src/Snap/Internal/Http/Server/LibevBackend.hs
@@ -456,13 +456,12 @@ runSession defaultTimeout backend handler lsock fd = do
     -----------------
     tmr         <- mkEvTimer
     now         <- getCurrentDateTime
-    timeoutTime <- newIORef $ now + 20
+    timeoutTime <- newIORef $ now + (fromIntegral defaultTimeout)
     tcb         <- mkTimerCallback $ timerCallback lp
                                                   tmr
                                                   timeoutTime
                                                   tid
-    -- 20 second timeout
-    evTimerInit tmr tcb 0 20.0
+    evTimerInit tmr tcb 0 (fromIntegral defaultTimeout)
 
 
     readActive  <- newIORef True