git.iko.soy/typeable/wai
on master help sign in
pause/resume timeouts
c5b29e6Michael Snoyman
Network/Wai/Handler/Warp.hs+2−2
compare with master
unifiedsplit
@@ -142,9 +142,9 @@ serveConnection th onException port app conn remoteHost' = do
142 serveConnection' = do
142 serveConnection' = do
143 (enumeratee, env) <- parseRequest port remoteHost'
143 (enumeratee, env) <- parseRequest port remoteHost'
144 -- Let the application run for as long as it wants
144 -- Let the application run for as long as it wants
145− --FIXME liftIO $ T.pause th
145+ liftIO $ T.pause th
146 res <- E.joinI $ enumeratee $$ app env
146 res <- E.joinI $ enumeratee $$ app env
147− --liftIO $ T.resume th
147+ liftIO $ T.resume th
148 keepAlive <- liftIO $ sendResponse th env (httpVersion env) conn res
148 keepAlive <- liftIO $ sendResponse th env (httpVersion env) conn res
149 if keepAlive then serveConnection' else return ()
149 if keepAlive then serveConnection' else return ()
150
150
Timeout.hs+20−9
@@ -4,14 +4,18 @@ module Timeout
4 , initialize
4 , initialize
5 , register
5 , register
6 , tickle
6 , tickle
7+ , pause
8+ , resume
7 ) where
9 ) where
8
10
9import qualified Data.IORef as I
11import qualified Data.IORef as I
10import Control.Concurrent (forkIO, threadDelay)
12import Control.Concurrent (forkIO, threadDelay)
11import Control.Monad (forever)
13import Control.Monad (forever)
14+import qualified Control.Exception as E
12
15
13newtype Manager = Manager (I.IORef [Handle])
16newtype Manager = Manager (I.IORef [Handle])
14−data Handle = Handle (IO ()) (I.IORef Bool)
17+data Handle = Handle (IO ()) (I.IORef State)
18+data State = Active | Inactive | Paused
15
19
16initialize :: Int -> IO Manager
20initialize :: Int -> IO Manager
17initialize timeout = do
21initialize timeout = do
@@ -25,19 +29,26 @@ initialize timeout = do
25 where
29 where
26 go [] front = return front
30 go [] front = return front
27 go (m@(Handle onTimeout iactive):rest) front = do
31 go (m@(Handle onTimeout iactive):rest) front = do
28− active <- I.atomicModifyIORef iactive (\x -> (False, x))
32+ state <- I.atomicModifyIORef iactive (\x -> (go' x, x))
29− if active
33+ case state of
30− then go rest (front . (:) m)
34+ Inactive -> do
31− else do
32− onTimeout
35+ onTimeout `E.catch` ignoreAll
33 go rest front
36 go rest front
37+ _ -> go rest (front . (:) m)
38+ go' Active = Inactive
39+ go' x = x
40+
41+ignoreAll :: E.SomeException -> IO ()
42+ignoreAll _ = return ()
34
43
35register :: Manager -> IO () -> IO Handle
44register :: Manager -> IO () -> IO Handle
36register (Manager ref) onTimeout = do
45register (Manager ref) onTimeout = do
37− iactive <- I.newIORef True
46+ iactive <- I.newIORef Active
38 let h = Handle onTimeout iactive
47 let h = Handle onTimeout iactive
39 I.atomicModifyIORef ref (\x -> (h : x, ()))
48 I.atomicModifyIORef ref (\x -> (h : x, ()))
40 return h
49 return h
41
50
42−tickle :: Handle -> IO ()
51+tickle, pause, resume :: Handle -> IO ()
43−tickle (Handle _ iactive) = I.writeIORef iactive True
52+tickle (Handle _ iactive) = I.writeIORef iactive Active
53+pause (Handle _ iactive) = I.writeIORef iactive Paused
54+resume = tickle