Send websocket ping every 30 seconds

erebe · May 27, 2018 · f8cf0e7 · f8cf0e7
1 parent 04815d9
commit f8cf0e7
Showing 1 changed file with 4 additions and 1 deletion.
diff --git a/src/Tunnel.hs b/src/Tunnel.hs
@@ -58,14 +58,17 @@ tunnelingClientP cfg@TunnelSettings{..} app conn = onError $ do
   debug "Oppening Websocket stream"
 
   stream <- connectionToStream conn
-  ret <- WS.runClientWithStream stream serverHost (toPath cfg) WS.defaultConnectionOptions [] (app . toConnection)
+  ret <- WS.runClientWithStream stream serverHost (toPath cfg) WS.defaultConnectionOptions [] run
 
   debug "Closing Websocket stream"
   return ret
 
   where
     connectionToStream Connection{..} =  WS.makeStream read (write . toStrict . fromJust)
     onError = flip catch (\(e :: SomeException) -> return . throwError . WebsocketError $ show e)
+    run cnx = do
+      WS.forkPingThread cnx 30
+      app (toConnection cnx)
 
 
 tlsClientP :: MonadError Error m => TunnelSettings -> (Connection -> IO (m ())) -> (Connection -> IO (m ()))