diff --git a/src/Network/WebSockets/Simple.hs b/src/Network/WebSockets/Simple.hs
--- a/src/Network/WebSockets/Simple.hs
+++ b/src/Network/WebSockets/Simple.hs
@@ -92,7 +92,11 @@
                 toWait <- readIORef toWaitVar
                 writeIORef toWaitVar (toWait+1)
                 let second = 1000000
-                threadDelay $ second * (2^toWait)
+                    origDelayTime = 2^toWait
+                    threadDelayTime
+                      | origDelayTime > 5*60*origDelayTime = 5*60 -- limit at 5 mins
+                      | otherwise = origDelayTime
+                threadDelay $ second * threadDelayTime
               go
         in  go' `catch` onDisconnect
   go
diff --git a/src/Network/WebSockets/Simple/PingPong.hs b/src/Network/WebSockets/Simple/PingPong.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/WebSockets/Simple/PingPong.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE
+    NamedFieldPuns
+  , FlexibleContexts
+  #-}
+
+module Network.WebSockets.Simple.PingPong where
+
+import Network.WebSockets.Simple (WebSocketsApp (..))
+
+import Data.Aeson (ToJSON (..), FromJSON (..))
+import Data.Aeson.Types (Value (Array))
+import Control.Monad.Trans.Control (MonadBaseControl (..))
+import Control.Concurrent.Async.Every (every, reset)
+import Control.Concurrent.STM (atomically)
+import Control.Concurrent.STM.TVar (newTVarIO, readTVar, writeTVar)
+
+
+newtype PingPong a = PingPong {getPingPong :: Maybe a}
+
+-- | Assumes @a@ isn't an 'Data.Aeson.Types.Array' of anything
+instance ToJSON a => ToJSON (PingPong a) where
+  toJSON (PingPong Nothing) = toJSON ([] :: [()])
+  toJSON (PingPong (Just x)) = toJSON x
+
+-- | Assumes @a@ isn't an 'Data.Aeson.Types.Array' of anything
+instance FromJSON a => FromJSON (PingPong a) where
+  parseJSON (Array _) = pure (PingPong Nothing)
+  parseJSON x = (PingPong . Just) <$> parseJSON x
+
+
+
+pingPong :: ( MonadBaseControl IO m
+            )
+         => Int -- ^ Delay in microseconds
+         -> WebSocketsApp send receive m
+         -> m (WebSocketsApp (PingPong send) (PingPong receive) m)
+pingPong delay WebSocketsApp{onOpen,onReceive} = do
+  counterVar <- liftBaseWith $ \_ -> newTVarIO Nothing
+
+  let halfDelay = delay `div` 2
+
+  pure WebSocketsApp
+    { onOpen = \send -> do
+        liftBaseWith $ \runInBase -> do
+          counter <- every delay (Just halfDelay) $ runInBase $
+            send (PingPong Nothing)
+          atomically $ writeTVar counterVar (Just counter)
+        onOpen (send . PingPong . Just)
+    , onReceive = \send (PingPong mPingPong) -> do
+        case mPingPong of
+          Nothing -> liftBaseWith $ \_ -> do
+            mCounter <- atomically $ readTVar counterVar
+            case mCounter of
+              Nothing -> error "somehow received message before socket was opened"
+              Just counter -> reset (Just halfDelay) counter
+          Just r -> onReceive (send . PingPong . Just) r
+    }
diff --git a/websockets-simple.cabal b/websockets-simple.cabal
--- a/websockets-simple.cabal
+++ b/websockets-simple.cabal
@@ -1,5 +1,5 @@
 name:                websockets-simple
-version:             0.0.2.2
+version:             0.0.3
 synopsis:            Simpler interface to the websockets api
 -- description:
 homepage:            https://github.com/athanclark/websockets-simple#readme
@@ -16,10 +16,12 @@
 library
   hs-source-dirs:      src
   exposed-modules:     Network.WebSockets.Simple
+                       Network.WebSockets.Simple.PingPong
   build-depends:       base >= 4.8 && < 5
                      , aeson
                      , async
                      , bytestring
+                     , every >= 0.0.1
                      , exceptions
                      , monad-control
                      , stm