diff --git a/cabal.project b/cabal.project index 49d6664..fab9495 100644 --- a/cabal.project +++ b/cabal.project @@ -2,5 +2,5 @@ packages: . source-repository-package type: git - location: git://github.com/simplex-chat/aeson.git + location: https://github.com/simplex-chat/aeson.git tag: 3eb66f9a68f103b5f1489382aad89f5712a64db7 diff --git a/package.yaml b/package.yaml index 1f816a4..f87ca11 100644 --- a/package.yaml +++ b/package.yaml @@ -45,7 +45,7 @@ dependencies: - iso8601-time == 0.1.* - memory == 0.15.* - mtl == 2.2.* - - network == 3.1.* + - network == 3.1.2.* - network-transport == 0.5.* - QuickCheck == 2.14.* - random >= 1.1 && < 1.3 diff --git a/simplexmq.cabal b/simplexmq.cabal index a7f130e..5762c62 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 @@ -91,7 +92,7 @@ library , iso8601-time ==0.1.* , memory ==0.15.* , mtl ==2.2.* - , network ==3.1.* + , network ==3.1.2.* , network-transport ==0.5.* , random >=1.1 && <1.3 , simple-logger ==0.1.* @@ -142,7 +143,7 @@ executable smp-agent , iso8601-time ==0.1.* , memory ==0.15.* , mtl ==2.2.* - , network ==3.1.* + , network ==3.1.2.* , network-transport ==0.5.* , random >=1.1 && <1.3 , simple-logger ==0.1.* @@ -195,7 +196,7 @@ executable smp-server , iso8601-time ==0.1.* , memory ==0.15.* , mtl ==2.2.* - , network ==3.1.* + , network ==3.1.2.* , network-transport ==0.5.* , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -264,7 +265,7 @@ test-suite smp-server-test , iso8601-time ==0.1.* , memory ==0.15.* , mtl ==2.2.* - , network ==3.1.* + , network ==3.1.2.* , network-transport ==0.5.* , random >=1.1 && <1.3 , simple-logger ==0.1.* diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 1290bfa..407bfd4 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -65,6 +65,7 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Protocol import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake) import Simplex.Messaging.Transport.Client (runTransportClient) +import Simplex.Messaging.Transport.KeepAlive import Simplex.Messaging.Transport.WebSockets (WS) import Simplex.Messaging.Util (bshow, liftError, raceAny_) import System.Timeout (timeout) @@ -99,6 +100,8 @@ data SMPClientConfig = SMPClientConfig defaultTransport :: (ServiceName, ATransport), -- | timeout of TCP commands (microseconds) tcpTimeout :: Int, + -- | TCP keep-alive options, Nothing to skip enabling keep-alive + tcpKeepAlive :: Maybe KeepAliveOpts, -- | period for SMP ping commands (microseconds) smpPing :: Int } @@ -110,7 +113,8 @@ smpDefaultConfig = { qSize = 64, defaultTransport = ("5223", transport @TLS), tcpTimeout = 4_000_000, - smpPing = 30_000_000 + tcpKeepAlive = Just defaultKeepAliveOpts, + smpPing = 1_200_000_000 -- 20min } data Request = Request @@ -126,7 +130,7 @@ type Response = Either SMPClientError BrokerMsg -- A single queue can be used for multiple 'SMPClient' instances, -- as 'SMPServerTransmission' includes server information. getSMPClient :: SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO () -> IO (Either SMPClientError SMPClient) -getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ disconnected = +getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smpPing} msgQ disconnected = atomically mkSMPClient >>= runClient useTransport where mkSMPClient :: STM SMPClient @@ -155,7 +159,7 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ dis thVar <- newEmptyTMVarIO action <- async $ - runTransportClient (host smpServer) port' (keyHash smpServer) (client t c thVar) + runTransportClient (host smpServer) port' (keyHash smpServer) tcpKeepAlive (client t c thVar) `finally` atomically (putTMVar thVar $ Left SMPNetworkError) th_ <- tcpTimeout `timeout` atomically (takeTMVar thVar) pure $ case th_ of diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs index 29bff96..e024802 100644 --- a/src/Simplex/Messaging/Transport/Client.hs +++ b/src/Simplex/Messaging/Transport/Client.hs @@ -20,19 +20,20 @@ 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 -- | Connect to passed TCP host:port and pass handle to the client. -runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> C.KeyHash -> (c -> m a) -> m a -runTransportClient host port keyHash client = do +runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a +runTransportClient host port keyHash keepAliveOpts client = do let clientParams = mkTLSClientParams host port keyHash - c <- liftIO $ startTCPClient host port clientParams + c <- liftIO $ startTCPClient host port clientParams keepAliveOpts client c `E.finally` liftIO (closeConnection c) -startTCPClient :: forall c. Transport c => HostName -> ServiceName -> T.ClientParams -> IO c -startTCPClient host port clientParams = withSocketsDo $ resolve >>= tryOpen err +startTCPClient :: forall c. Transport c => HostName -> ServiceName -> T.ClientParams -> Maybe KeepAliveOpts -> IO c +startTCPClient host port clientParams keepAliveOpts = withSocketsDo $ resolve >>= tryOpen err where err :: IOException err = mkIOError NoSuchThing "no address" Nothing Nothing @@ -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 + mapM_ (setSocketKeepAlive sock) keepAliveOpts 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 0000000..a309be4 --- /dev/null +++ b/src/Simplex/Messaging/Transport/KeepAlive.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Simplex.Messaging.Transport.KeepAlive where + +import Foreign.C (CInt (..)) +import Network.Socket + +foreign import capi "netinet/tcp.h value TCP_KEEPCNT" tcpKeepCnt :: CInt + +foreign import capi "netinet/tcp.h value TCP_KEEPINTVL" tcpKeepIntvl :: CInt + +#if defined(darwin_HOST_OS) +foreign import capi "netinet/tcp.h value TCP_KEEPALIVE" tcpKeepIdle :: CInt +foreign import capi "netinet/in.h value IPPROTO_TCP" solTcp :: CInt +#else +foreign import capi "netinet/tcp.h value TCP_KEEPIDLE" tcpKeepIdle :: CInt +foreign import capi "netinet/tcp.h value SOL_TCP" solTcp :: CInt +#endif + +data KeepAliveOpts = KeepAliveOpts + { keepCnt :: Int, + keepIdle :: Int, + keepIntvl :: Int + } + +defaultKeepAliveOpts :: KeepAliveOpts +defaultKeepAliveOpts = + KeepAliveOpts + { keepCnt = 4, + keepIdle = 30, + keepIntvl = 15 + } + +setSocketKeepAlive :: Socket -> KeepAliveOpts -> IO () +setSocketKeepAlive sock KeepAliveOpts {keepCnt, keepIdle, keepIntvl} = do + setSocketOption sock KeepAlive 1 + setSocketOption sock (SockOpt solTcp tcpKeepCnt) keepCnt + setSocketOption sock (SockOpt solTcp tcpKeepIdle) keepIdle + setSocketOption sock (SockOpt solTcp tcpKeepIntvl) keepIntvl diff --git a/stack.yaml b/stack.yaml index 2529b83..ce1c134 100644 --- a/stack.yaml +++ b/stack.yaml @@ -36,6 +36,7 @@ packages: # extra-deps: - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881 + - network-3.1.2.7@sha256:e3d78b13db9512aeb106e44a334ab42b7aa48d26c097299084084cb8be5c5568,4888 - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079 - tls-1.5.7@sha256:1cc30253a9696b65a9cafc0317fbf09f7dcea15e3a145ed6c9c0e28c632fa23a,6991 # below dependancies are to update Aeson to 2.0.3 diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs index 8c14450..2d7b823 100644 --- a/tests/SMPAgentClient.hs +++ b/tests/SMPAgentClient.hs @@ -27,6 +27,7 @@ import Simplex.Messaging.Agent.Server (runSMPAgentBlocking) import Simplex.Messaging.Client (SMPClientConfig (..), smpDefaultConfig) import Simplex.Messaging.Transport import Simplex.Messaging.Transport.Client +import Simplex.Messaging.Transport.KeepAlive import Test.Hspec import UnliftIO.Concurrent import UnliftIO.Directory @@ -190,7 +191,7 @@ withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB) testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m a) -> m a testSMPAgentClientOn port' client = do - runTransportClient agentTestHost port' testKeyHash $ \h -> do + runTransportClient agentTestHost port' testKeyHash (Just defaultKeepAliveOpts) $ \h -> do line <- liftIO $ getLn h if line == "Welcome to SMP agent v" <> B.pack simplexMQVersion then client h diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 7d4352c..3abf2c4 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -22,6 +22,7 @@ import Simplex.Messaging.Server.Env.STM import Simplex.Messaging.Server.StoreLog (openReadStoreLog) import Simplex.Messaging.Transport import Simplex.Messaging.Transport.Client +import Simplex.Messaging.Transport.KeepAlive import Test.Hspec import UnliftIO.Concurrent import qualified UnliftIO.Exception as E @@ -45,7 +46,7 @@ testStoreLogFile = "tests/tmp/smp-server-store.log" testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a testSMPClient client = - runTransportClient testHost testPort testKeyHash $ \h -> + runTransportClient testHost testPort testKeyHash (Just defaultKeepAliveOpts) $ \h -> liftIO (runExceptT $ clientHandshake h testKeyHash) >>= \case Right th -> client th Left e -> error $ show e