From 8fd4599f983dd326863b71bccf43d0d3abd800b4 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 20 Mar 2022 16:50:36 +0000
Subject: [PATCH] use TCP keep-alive instead of SMP protocol PING

---
 simplexmq.cabal                              |  1 +
 src/Simplex/Messaging/Client.hs              |  2 +-
 src/Simplex/Messaging/Transport/Client.hs    |  2 +
 src/Simplex/Messaging/Transport/KeepAlive.hs | 40 ++++++++++++++++++++
 4 files changed, 44 insertions(+), 1 deletion(-)
 create mode 100644 src/Simplex/Messaging/Transport/KeepAlive.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index a7f130e9f..411cad3cf 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -57,6 +57,7 @@ library
       Simplex.Messaging.Server.StoreLog
       Simplex.Messaging.Transport
       Simplex.Messaging.Transport.Client
+      Simplex.Messaging.Transport.KeepAlive
       Simplex.Messaging.Transport.Server
       Simplex.Messaging.Transport.WebSockets
       Simplex.Messaging.Util
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 1290bfab4..12a5aa7f5 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -110,7 +110,7 @@ smpDefaultConfig =
     { qSize = 64,
       defaultTransport = ("5223", transport @TLS),
       tcpTimeout = 4_000_000,
-      smpPing = 30_000_000
+      smpPing = 3_600_000_000 -- 1 hour
     }
 
 data Request = Request
diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs
index 29bff966c..37c8866ce 100644
--- a/src/Simplex/Messaging/Transport/Client.hs
+++ b/src/Simplex/Messaging/Transport/Client.hs
@@ -20,6 +20,7 @@ import Network.Socket
 import qualified Network.TLS as T
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.KeepAlive
 import System.IO.Error
 import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E
@@ -51,6 +52,7 @@ startTCPClient host port clientParams = withSocketsDo $ resolve >>= tryOpen err
     open addr = do
       sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
       connect sock $ addrAddress addr
+      setSocketKeepAlive sock defaultKeepAlive
       ctx <- connectTLS clientParams sock
       getClientConnection ctx
 
diff --git a/src/Simplex/Messaging/Transport/KeepAlive.hs b/src/Simplex/Messaging/Transport/KeepAlive.hs
new file mode 100644
index 000000000..a9f21652d
--- /dev/null
+++ b/src/Simplex/Messaging/Transport/KeepAlive.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Transport.KeepAlive where
+
+import Foreign.C (CInt (..))
+import Network.Socket
+
+foreign import capi "sys/socket.h value TCP_KEEPCNT" tcpKeepCnt :: CInt
+
+foreign import capi "sys/socket.h value TCP_KEEPIDLE" tcpKeepIdle :: CInt
+
+foreign import capi "sys/socket.h value TCP_KEEPINTVL" tcpKeepIntvl :: CInt
+
+foreign import capi "sys/socket.h value SOL_TCP" solTcp :: CInt
+
+data KeepAliveOpts = KeepAliveOpts
+  { keepCnt :: Int,
+    keepIdle :: Int,
+    keepIntvl :: Int
+  }
+
+defaultKeepAlive :: KeepAliveOpts
+defaultKeepAlive =
+  KeepAliveOpts
+    { keepCnt = 2,
+      keepIdle = 30,
+      keepIntvl = 15
+    }
+
+setSocketKeepAlive :: Socket -> KeepAliveOpts -> IO ()
+setSocketKeepAlive sock KeepAliveOpts {keepCnt, keepIdle, keepIntvl} = do
+  setSocketOption sock KeepAlive 1
+  putStrLn $ "solTcp: " <> show solTcp
+  putStrLn $ "tcpKeepCnt: " <> show tcpKeepCnt
+  putStrLn $ "tcpKeepIdle: " <> show tcpKeepIdle
+  putStrLn $ "tcpKeepIntvl: " <> show tcpKeepIntvl
+  setSocketOption sock (SockOpt solTcp tcpKeepCnt) keepCnt
+  setSocketOption sock (SockOpt solTcp tcpKeepIdle) keepIdle
+  setSocketOption sock (SockOpt solTcp tcpKeepIntvl) keepIntvl