on master help sign in
Merge remote-tracking branch 'origin/onopen'
commitbf468388396842f52265ac42a0e916dbcbbb2ed4 authorMichael Snoyman <michael@snoyman.com> dateWed 5 Mar 2014, 08:18 (13 years ago) parentc76ecb55f1a9f7
2 files changed+8−6
warp/Network/Wai/Handler/Warp/Run.hs+3−2 warp/Network/Wai/Handler/Warp/Settings.hs+5−4
warp/Network/Wai/Handler/Warp/Run.hs+3−2
@@ -185,10 +185,11 @@ runSettingsConnectionMaker set getConnMaker app = do
185185 handle (onE Nothing) .
186186
187187 -- Call the user-supplied code for connection open and close events
188− bracket_ onOpen onClose $
188+ bracket (onOpen addr) (const $ onClose addr) $ \goingon ->
189189
190190 -- Actually serve this connection.
191− serveConnection conn ii addr set app
191+ -- onnClose above ensures the termination of the connection.
192+ when goingon $ serveConnection conn ii addr set app
192193 where
193194 -- FIXME: only IOEception is caught. What about other exceptions?
194195 getConnLoop = getConnMaker `E.catch` \(e :: IOException) -> do
warp/Network/Wai/Handler/Warp/Settings.hs+5−4
@@ -9,6 +9,7 @@ import Data.Conduit
99import Data.Conduit.Network (HostPreference (HostIPv4))
1010import GHC.IO.Exception (IOErrorType(..))
1111import qualified Network.HTTP.Types as H
12+import Network.Socket (SockAddr)
1213import Network.Wai
1314import Network.Wai.Handler.Warp.Timeout
1415import Network.Wai.Handler.Warp.Types
@@ -31,8 +32,8 @@ data Settings = Settings
3132 -- Default: 500, text/plain, \"Something went wrong\"
3233 --
3334 -- Since 2.0.3
34− , settingsOnOpen :: IO () -- ^ What to do when a connection is open. Default: do nothing.
35− , settingsOnClose :: IO () -- ^ What to do when a connection is close. Default: do nothing.
35+ , settingsOnOpen :: SockAddr -> IO Bool -- ^ What to do when a connection is open. When 'False' is returned, the connection is closed immediately. Otherwise, the connection is going on. Default: always returns 'True'.
36+ , settingsOnClose :: SockAddr -> IO () -- ^ What to do when a connection is close. Default: do nothing.
3637 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
3738 , settingsIntercept :: Request -> Maybe (Source IO S.ByteString -> Connection -> IO ())
3839 , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'
@@ -63,8 +64,8 @@ defaultSettings = Settings
6364 , settingsHost = HostIPv4
6465 , settingsOnException = defaultExceptionHandler
6566 , settingsOnExceptionResponse = defaultExceptionResponse
66− , settingsOnOpen = return ()
67− , settingsOnClose = return ()
67+ , settingsOnOpen = const $ return True
68+ , settingsOnClose = const $ return ()
6869 , settingsTimeout = 30
6970 , settingsIntercept = const Nothing
7071 , settingsManager = Nothing