git.iko.soy/typeable/wai
on master help sign in
Added cancel to Timeout
dbfb750Michael Snoyman
Network/Wai/Handler/Warp.hs+1
compare with master
unifiedsplit
@@ -152,6 +152,7 @@ serveConnections' set app socket = do
152 _ <- forkIO $ do
152 _ <- forkIO $ do
153 th <- T.register tm $ sClose conn
153 th <- T.register tm $ sClose conn
154 serveConnection th onE port app conn sa
154 serveConnection th onE port app conn sa
155+ T.cancel th
155 return ()
156 return ()
156
157
157serveConnection :: T.Handle
158serveConnection :: T.Handle
Timeout.hs+7−2
@@ -6,6 +6,7 @@ module Timeout
6 , tickle
6 , tickle
7 , pause
7 , pause
8 , resume
8 , resume
9+ , cancel
9 ) where
10 ) where
10
11
11import qualified Data.IORef as I
12import qualified Data.IORef as I
@@ -13,9 +14,11 @@ import Control.Concurrent (forkIO, threadDelay)
13import Control.Monad (forever)
14import Control.Monad (forever)
14import qualified Control.Exception as E
15import qualified Control.Exception as E
15
16
17+-- FIXME implement stopManager
18+
16newtype Manager = Manager (I.IORef [Handle])
19newtype Manager = Manager (I.IORef [Handle])
17data Handle = Handle (IO ()) (I.IORef State)
20data Handle = Handle (IO ()) (I.IORef State)
18−data State = Active | Inactive | Paused
21+data State = Active | Inactive | Paused | Canceled
19
22
20initialize :: Int -> IO Manager
23initialize :: Int -> IO Manager
21initialize timeout = do
24initialize timeout = do
@@ -34,6 +37,7 @@ initialize timeout = do
34 Inactive -> do
37 Inactive -> do
35 onTimeout `E.catch` ignoreAll
38 onTimeout `E.catch` ignoreAll
36 go rest front
39 go rest front
40+ Canceled -> go rest front
37 _ -> go rest (front . (:) m)
41 _ -> go rest (front . (:) m)
38 go' Active = Inactive
42 go' Active = Inactive
39 go' x = x
43 go' x = x
@@ -48,7 +52,8 @@ register (Manager ref) onTimeout = do
48 I.atomicModifyIORef ref (\x -> (h : x, ()))
52 I.atomicModifyIORef ref (\x -> (h : x, ()))
49 return h
53 return h
50
54
51−tickle, pause, resume :: Handle -> IO ()
55+tickle, pause, resume, cancel :: Handle -> IO ()
52tickle (Handle _ iactive) = I.writeIORef iactive Active
56tickle (Handle _ iactive) = I.writeIORef iactive Active
53pause (Handle _ iactive) = I.writeIORef iactive Paused
57pause (Handle _ iactive) = I.writeIORef iactive Paused
54resume = tickle
58resume = tickle
59+cancel (Handle _ iactive) = I.writeIORef iactive Canceled