-
Notifications
You must be signed in to change notification settings - Fork 113
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Add ping-pong implementation that handles stale connections. #239
Changes from all commits
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,62 @@ | ||
module Network.WebSockets.Connection.PingPong | ||
( withPingPong | ||
, PingPongOptions(..) | ||
, PongTimeout(..) | ||
, defaultPingPongOptions | ||
) where | ||
|
||
import Control.Concurrent.Async as Async | ||
import Control.Exception | ||
import Control.Monad (void) | ||
import Network.WebSockets.Connection (Connection, connectionHeartbeat, pingThread) | ||
import Control.Concurrent.MVar (takeMVar) | ||
import System.Timeout (timeout) | ||
|
||
|
||
-- | Exception type used to kill connections if there | ||
-- is a pong timeout. | ||
data PongTimeout = PongTimeout deriving Show | ||
|
||
instance Exception PongTimeout | ||
|
||
|
||
-- | Options for ping-pong | ||
-- | ||
-- Make sure that the ping interval is less than the pong timeout, | ||
-- for example N/2. | ||
data PingPongOptions = PingPongOptions { | ||
pingInterval :: Int, -- ^ Interval in seconds | ||
pongTimeout :: Int, -- ^ Timeout in seconds | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I only noticed this because of the comment on the other PR; but I guess it would be more consistent if the library uses microseconds for time everywhere rather than mixed units? There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Given that the other Ping utilities use seconds, maybe it's better we just use seconds for the connection timeout as well. I'll add it to the other PR. |
||
pingAction :: IO () -- ^ Action to perform after sending a ping | ||
} | ||
|
||
-- | Default options for ping-pong | ||
-- | ||
-- Ping every 15 seconds, timeout after 30 seconds | ||
defaultPingPongOptions :: PingPongOptions | ||
defaultPingPongOptions = PingPongOptions { | ||
pingInterval = 15, | ||
pongTimeout = 30, | ||
pingAction = return () | ||
} | ||
|
||
-- | Run an application with ping-pong enabled. Raises PongTimeout if a pong is not received. | ||
-- | ||
-- Can used with Client and Server connections. | ||
withPingPong :: PingPongOptions -> Connection -> (Connection -> IO ()) -> IO () | ||
withPingPong options connection app = void $ | ||
withAsync (app connection) $ \appAsync -> do | ||
withAsync (pingThread connection (pingInterval options) (pingAction options)) $ \pingAsync -> do | ||
withAsync (heartbeat >> throwIO PongTimeout) $ \heartbeatAsync -> do | ||
waitAnyCancel [appAsync, pingAsync, heartbeatAsync] | ||
where | ||
heartbeat = whileJust $ timeout (pongTimeout options * 1000 * 1000) | ||
$ takeMVar (connectionHeartbeat connection) | ||
|
||
-- Loop until action returns Nothing | ||
whileJust :: IO (Maybe a) -> IO () | ||
whileJust action = do | ||
result <- action | ||
case result of | ||
Nothing -> return () | ||
Just _ -> whileJust action |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I would add a comment to the field explaining how this is used (or refer to the PingPong module).
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Done :)