@@ -32,6 +32,8 @@ module Network.Wai.Handler.Warp
3232 , settingsPort
3333 , settingsHost
3434 , settingsOnException
35+ , settingsOnOpen
36+ , settingsOnClose
3537 , settingsTimeout
3638 , settingsIntercept
3739 , settingsManager
@@ -219,6 +221,8 @@ runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application ->
219221runSettingsConnection set getConn app = do
220222 let onE = settingsOnException set
221223 port = settingsPort set
224+ onOpen = settingsOnOpen set
225+ onClose = settingsOnClose set
222226 tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
223227 $ settingsManager set
224228 mask $ \restore -> forever $ do
@@ -226,9 +230,10 @@ runSettingsConnection set getConn app = do
226230 (conn, addr) <- getConn
227231 void $ forkIO $ do
228232 th <- T.registerKillThread tm
229− handle onE $ (do restore $ serveConnection set th port app conn addr
230− connClose conn >> T.cancel th
231− ) `onException` (T.cancel th >> connClose conn)
233+ handle onE $ (do onOpen
234+ restore $ serveConnection set th port app conn addr
235+ connClose conn >> T.cancel th >> onClose
236+ ) `onException` (T.cancel th >> connClose conn >> onClose)
232237
233238-- | Contains a @Source@ and a byte count that is still to be read in.
234239newtype IsolatedBSSource = IsolatedBSSource (I.IORef (Int, C.Source (ResourceT IO) ByteString))
@@ -694,6 +699,8 @@ data Settings = Settings
694699 { settingsPort :: Int -- ^ Port to listen on. Default value: 3000
695700 , settingsHost :: HostPreference -- ^ Default value: HostIPv4
696701 , 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
697704 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
698705 , settingsIntercept :: Request -> Maybe (C.Source (ResourceT IO) S.ByteString -> Connection -> ResourceT IO ())
699706 , 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
711718 Nothing ->
712719 when (go' $ fromException e) $
713720 hPrint stderr e
721+ , settingsOnOpen = return ()
722+ , settingsOnClose = return ()
714723 , settingsTimeout = 30
715724 , settingsIntercept = const Nothing
716725 , settingsManager = Nothing