diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 7a2eedeb9..d96078804 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -150,7 +150,7 @@ import Data.Int (Int64) import Data.List (find, isSuffixOf) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime) @@ -442,9 +442,12 @@ defaultNetworkConfig = transportClientConfig :: NetworkConfig -> NetworkRequestMode -> TransportHost -> Bool -> Maybe [ALPN] -> TransportClientConfig transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} nm host useSNI clientALPN = - TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout = tOut, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, clientALPN, useSNI} + TransportClientConfig {socksProxy = socks, tcpConnectTimeout = tOut, tcpKeepAlive = keepAlive, logTLSErrors, clientCredentials = Nothing, clientALPN, useSNI} where tOut = netTimeoutInt tcpConnectTimeout nm + socks = useSocksProxy socksMode + -- with SOCKS proxy the socket is connected to the proxy, and a slow circuit should not fail the connection + keepAlive = (\ka -> if isJust socks then ka {unackedDataTimeout = Nothing} else ka) <$> tcpKeepAlive socksProxy' = (\(SocksProxyWithAuth _ proxy) -> proxy) <$> socksProxy useSocksProxy SMAlways = socksProxy' useSocksProxy SMOnion = case host of diff --git a/src/Simplex/Messaging/Transport/KeepAlive.hs b/src/Simplex/Messaging/Transport/KeepAlive.hs index 1d34a27f0..42059f22d 100644 --- a/src/Simplex/Messaging/Transport/KeepAlive.hs +++ b/src/Simplex/Messaging/Transport/KeepAlive.hs @@ -11,6 +11,7 @@ module Simplex.Messaging.Transport.KeepAlive ) where import qualified Data.Aeson.TH as J +import Control.Monad (when) import Foreign.C (CInt (..)) import Network.Socket import Simplex.Messaging.Parsers (defaultJSON) @@ -18,16 +19,25 @@ import Simplex.Messaging.Parsers (defaultJSON) data KeepAliveOpts = KeepAliveOpts { keepIdle :: Int, keepIntvl :: Int, - keepCnt :: Int + keepCnt :: Int, + -- | A connection with unacknowledged data gets no keep-alive probes, so the OS fails it only when it + -- gives up retransmitting - ~15 minutes on Linux and Android. When this is set such a connection is + -- failed after the keep-alive detection time instead. Absent or False - the OS default. + unackedDataTimeout :: Maybe Bool } deriving (Eq, Show) +-- seconds after which a connection with no response to the probes is reported as failed +keepAliveDetectionTime :: KeepAliveOpts -> Int +keepAliveDetectionTime KeepAliveOpts {keepIdle, keepIntvl, keepCnt} = keepIdle + keepIntvl * keepCnt + defaultKeepAliveOpts :: KeepAliveOpts defaultKeepAliveOpts = KeepAliveOpts { keepIdle = 30, keepIntvl = 15, - keepCnt = 4 + keepCnt = 4, + unackedDataTimeout = Nothing } _SOL_TCP :: CInt @@ -53,8 +63,12 @@ _TCP_KEEPCNT = 16 #if defined(darwin_HOST_OS) foreign import capi "netinet/tcp.h value TCP_KEEPALIVE" _TCP_KEEPIDLE :: CInt + +foreign import capi "netinet/tcp.h value TCP_RXT_CONNDROPTIME" _TCP_RXT_CONNDROPTIME :: CInt #else foreign import capi "netinet/tcp.h value TCP_KEEPIDLE" _TCP_KEEPIDLE :: CInt + +foreign import capi "netinet/tcp.h value TCP_USER_TIMEOUT" _TCP_USER_TIMEOUT :: CInt #endif foreign import capi "netinet/tcp.h value TCP_KEEPINTVL" _TCP_KEEPINTVL :: CInt @@ -63,11 +77,22 @@ foreign import capi "netinet/tcp.h value TCP_KEEPCNT" _TCP_KEEPCNT :: CInt #endif +-- | seconds +setSocketUnackedDataTimeout :: Socket -> Int -> IO () +#if defined(mingw32_HOST_OS) +setSocketUnackedDataTimeout _ _ = pure () +#elif defined(darwin_HOST_OS) +setSocketUnackedDataTimeout sock = setSocketOption sock (SockOpt _SOL_TCP _TCP_RXT_CONNDROPTIME) +#else +setSocketUnackedDataTimeout sock t = setSocketOption sock (SockOpt _SOL_TCP _TCP_USER_TIMEOUT) (t * 1000) -- TCP_USER_TIMEOUT is in milliseconds +#endif + setSocketKeepAlive :: Socket -> KeepAliveOpts -> IO () -setSocketKeepAlive sock KeepAliveOpts {keepCnt, keepIdle, keepIntvl} = do +setSocketKeepAlive sock ka@KeepAliveOpts {keepCnt, keepIdle, keepIntvl, unackedDataTimeout} = do setSocketOption sock KeepAlive 1 setSocketOption sock (SockOpt _SOL_TCP _TCP_KEEPIDLE) keepIdle setSocketOption sock (SockOpt _SOL_TCP _TCP_KEEPINTVL) keepIntvl setSocketOption sock (SockOpt _SOL_TCP _TCP_KEEPCNT) keepCnt + when (unackedDataTimeout == Just True) $ setSocketUnackedDataTimeout sock $ keepAliveDetectionTime ka $(J.deriveJSON defaultJSON ''KeepAliveOpts)