@@ -32,6 +32,8 @@ module Network.Wai.Handler.Warp
32 , settingsPort
32 , settingsPort
33 , settingsHost
33 , settingsHost
34 , settingsOnException
34 , settingsOnException
35 , settingsTimeout
37 , settingsTimeout
36 , settingsIntercept
38 , settingsIntercept
37 , settingsManager
39 , settingsManager
@@ -219,6 +221,8 @@ runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application ->
219runSettingsConnection set getConn app = do
221runSettingsConnection set getConn app = do
220 let onE = settingsOnException set
222 let onE = settingsOnException set
221 port = settingsPort set
223 port = settingsPort set
224+ onOpen = settingsOnOpen set
225+ onClose = settingsOnClose set
222 tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
226 tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
223 $ settingsManager set
227 $ settingsManager set
224 mask $ \restore -> forever $ do
228 mask $ \restore -> forever $ do
@@ -226,9 +230,10 @@ runSettingsConnection set getConn app = do
226 (conn, addr) <- getConn
230 (conn, addr) <- getConn
227 void $ forkIO $ do
231 void $ forkIO $ do
228 th <- T.registerKillThread tm
232 th <- T.registerKillThread tm
233+ handle onE $ (do onOpen
229− handle onE $ (do restore $ serveConnection set th port app conn addr
234+ restore $ serveConnection set th port app conn addr
230− connClose conn >> T.cancel th
235+ connClose conn >> T.cancel th >> onClose
231− ) `onException` (T.cancel th >> connClose conn)
236+ ) `onException` (T.cancel th >> connClose conn >> onClose)
233-- | Contains a @Source@ and a byte count that is still to be read in.
238-- | Contains a @Source@ and a byte count that is still to be read in.
234newtype IsolatedBSSource = IsolatedBSSource (I.IORef (Int, C.Source (ResourceT IO) ByteString))
239newtype IsolatedBSSource = IsolatedBSSource (I.IORef (Int, C.Source (ResourceT IO) ByteString))
@@ -694,6 +699,8 @@ data Settings = Settings
694 { settingsPort :: Int -- ^ Port to listen on. Default value: 3000
699 { settingsPort :: Int -- ^ Port to listen on. Default value: 3000
695 , settingsHost :: HostPreference -- ^ Default value: HostIPv4
700 , settingsHost :: HostPreference -- ^ Default value: HostIPv4
696 , settingsOnException :: SomeException -> IO () -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr.
701 , settingsOnException :: SomeException -> IO () -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr.
702+ , settingsOnOpen :: IO () -- ^ What to do when a connection is open
703+ , settingsOnClose :: IO () -- ^ What to do when a connection is close
697 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
704 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
698 , settingsIntercept :: Request -> Maybe (C.Source (ResourceT IO) S.ByteString -> Connection -> ResourceT IO ())
705 , settingsIntercept :: Request -> Maybe (C.Source (ResourceT IO) S.ByteString -> Connection -> ResourceT IO ())
699 , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'
706 , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'
@@ -711,6 +718,8 @@ defaultSettings = Settings
711 Nothing ->
718 Nothing ->
712 when (go' $ fromException e) $
719 when (go' $ fromException e) $
713 hPrint stderr e
720 hPrint stderr e
721+ , settingsOnOpen = return ()
722+ , settingsOnClose = return ()
714 , settingsTimeout = 30
723 , settingsTimeout = 30
715 , settingsIntercept = const Nothing
724 , settingsIntercept = const Nothing
716 , settingsManager = Nothing
725 , settingsManager = Nothing