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
@@ -9,15 +9,17 @@
 
 module Network.WebSockets.Simple where
 
-import Network.WebSockets (DataMessage (..), sendTextData, receiveDataMessage, acceptRequest)
+import Network.WebSockets (DataMessage (..), sendTextData, receiveDataMessage, acceptRequest, ConnectionException)
 import Network.Wai.Trans (ServerAppT, ClientAppT)
 import Data.Aeson (ToJSON (..), FromJSON (..))
 import qualified Data.Aeson as Aeson
 import Data.ByteString.Lazy (ByteString)
+import Data.IORef (newIORef, writeIORef, readIORef)
 
 import Control.Monad (void, forever)
-import Control.Monad.Catch (Exception, throwM, MonadThrow)
+import Control.Monad.Catch (Exception, throwM, MonadThrow, catch, MonadCatch)
 import Control.Monad.Trans.Control (MonadBaseControl (..))
+import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (Async, async)
 import Control.Concurrent.STM (atomically)
 import Control.Concurrent.STM.TChan (TChan, newTChanIO, writeTChan)
@@ -41,41 +43,57 @@
                 , FromJSON receive
                 , MonadBaseControl IO m
                 , MonadThrow m
+                , MonadCatch m
                 )
              => WebSocketsApp send receive m
-             -> ClientAppT m WebSocketsAppThreads
-toClientAppT WebSocketsApp{onOpen,onReceive} = \conn -> do
-  let send :: send -> m ()
-      send x = liftBaseWith $ \_ -> sendTextData conn (Aeson.encode x)
+             -> ClientAppT m (Maybe WebSocketsAppThreads)
+toClientAppT WebSocketsApp{onOpen,onReceive} conn = do
+  toWaitVar <- liftBaseWith $ \_ -> newIORef (0 :: Int)
+  let go =
+        let go' = do
+              liftBaseWith $ \_ -> writeIORef toWaitVar 0
+              let send :: send -> m ()
+                  send x = liftBaseWith $ \_ -> sendTextData conn (Aeson.encode x)
 
-  onOpenThread <- liftBaseWith $ \runToBase ->
-    async $ void $ runToBase $ onOpen send
+              onOpenThread <- liftBaseWith $ \runToBase ->
+                async $ void $ runToBase $ onOpen send
 
-  onReceiveThreads <- liftBaseWith $ \_ -> newTChanIO
+              onReceiveThreads <- liftBaseWith $ \_ -> newTChanIO
 
-  forever $ do
-    data' <- liftBaseWith $ \_ -> receiveDataMessage conn
-    let data'' = case data' of
-                   Text xs -> xs
-                   Binary xs -> xs
-    case Aeson.decode data'' of
-      Nothing -> throwM (JSONParseError data'')
-      Just received -> liftBaseWith $ \runToBase -> do
-        thread <- async $ void $ runToBase $ onReceive send received
-        atomically $ writeTChan onReceiveThreads thread
+              forever $ do
+                data' <- liftBaseWith $ \_ -> receiveDataMessage conn
+                let data'' = case data' of
+                              Text xs -> xs
+                              Binary xs -> xs
+                case Aeson.decode data'' of
+                  Nothing -> throwM (JSONParseError data'')
+                  Just received -> liftBaseWith $ \runToBase -> do
+                    thread <- async $ void $ runToBase $ onReceive send received
+                    atomically $ writeTChan onReceiveThreads thread
 
-  pure WebSocketsAppThreads
-    { onOpenThread
-    , onReceiveThreads
-    }
+              pure $ Just WebSocketsAppThreads
+                { onOpenThread
+                , onReceiveThreads
+                }
 
+            onDisconnect :: ConnectionException -> m (Maybe WebSocketsAppThreads)
+            onDisconnect _ = do
+              liftBaseWith $ \_ -> do
+                toWait <- readIORef toWaitVar
+                writeIORef toWaitVar (toWait+1)
+                let second = 1000000
+                threadDelay $ second * (2^toWait)
+              go
+        in  go' `catch` onDisconnect
+  go
 
 
-toClientAppT' :: (ToJSON send, FromJSON receive, MonadBaseControl IO m, MonadThrow m) => WebSocketsApp send receive m -> ClientAppT m ()
+
+toClientAppT' :: (ToJSON send, FromJSON receive, MonadBaseControl IO m, MonadThrow m, MonadCatch m) => WebSocketsApp send receive m -> ClientAppT m ()
 toClientAppT' wsApp conn = void (toClientAppT wsApp conn)
 
 
-toServerAppT :: (ToJSON send, FromJSON receive, MonadBaseControl IO m, MonadThrow m) => WebSocketsApp send receive m -> ServerAppT m
+toServerAppT :: (ToJSON send, FromJSON receive, MonadBaseControl IO m, MonadThrow m, MonadCatch m) => WebSocketsApp send receive m -> ServerAppT m
 toServerAppT wsApp pending = do
   conn <- liftBaseWith $ \_ -> acceptRequest pending
   toClientAppT' wsApp conn
diff --git a/test/Spec.hs b/test/Spec.hs
deleted file mode 100644
--- a/test/Spec.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-main :: IO ()
-main = putStrLn "Test suite not yet implemented"
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.1
+version:             0.0.2
 synopsis:            Simpler interface to the websockets api
 -- description:
 homepage:            https://github.com/athanclark/websockets-simple#readme
@@ -27,15 +27,6 @@
                      , websockets
   default-language:    Haskell2010
 
-test-suite websockets-simple-test
-  type:                exitcode-stdio-1.0
-  hs-source-dirs:      test
-  main-is:             Spec.hs
-  build-depends:       base
-                     , websockets-simple
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
-  default-language:    Haskell2010
-
 source-repository head
   type:     git
-  location: https://github.com/githubuser/websockets-simple
+  location: https://github.com/athanclark/websockets-simple