From 9595690aae5f05980f76551c1a5a72fed120c436 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Romain=20G=C3=89RARD?= Date: Sun, 27 May 2018 18:25:21 +0200 Subject: [PATCH] Send websocket ping every 30 seconds Former-commit-id: f8cf0e717959c0b3d388db1a5517d30ff384b1c4 Former-commit-id: cd640b4bdb7c1fc931ae0713fad0b51686711a6c [formerly b25bb73f6ae4fa09076cca43cb1538e497ba1a95] [formerly 7be7f4542e51464b174eda61956323b3cd64e2e4 [formerly 4808ab38b2dc6956ab9900ffaf36e6b09cd42777 [formerly 4808ab38b2dc6956ab9900ffaf36e6b09cd42777 [formerly 4808ab38b2dc6956ab9900ffaf36e6b09cd42777 [formerly ce17ed3ef32e2128b9d45b256a5c1445a6e4bd6f]]]]] Former-commit-id: 9c55ce78df5bcbc718a656a76f12fd797730294c [formerly 34c70e20636616071b5dbe28d56a7d769f6d62a3] Former-commit-id: 54b81c1c6f555f03d0fc3e19b183bf393c99c1d6 Former-commit-id: 30e421ec0b35682a3b743c84b8e47ec590d73485 Former-commit-id: dfbe1a29b9527f2331cd6d231dc2f82ec326e76d Former-commit-id: 782dccac058f7ce2863b33a2afe3217b001a9280 [formerly 60605ee4f15384b7dfa2db69df6881c1d2cac51f] Former-commit-id: aecbcf00e7391129896a001e1a96e10350754dea --- src/Tunnel.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Tunnel.hs b/src/Tunnel.hs index 3e71f61..9f344ec 100644 --- a/src/Tunnel.hs +++ b/src/Tunnel.hs @@ -58,7 +58,7 @@ 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 @@ -66,6 +66,9 @@ tunnelingClientP cfg@TunnelSettings{..} app conn = onError $ do 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 ()))