diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index f8f1a4cb9..a1c5210d6 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -35,6 +35,7 @@ module Simplex.Messaging.Client ProxiedRelay (..), getProtocolClient, closeProtocolClient, + pClientSentCommandsCount, protocolClientServer, protocolClientServer', transportHost', @@ -150,6 +151,7 @@ import Data.Int (Int64) import Data.List (find, isSuffixOf) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L +import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -750,6 +752,9 @@ closeProtocolClient :: ProtocolClient v err msg -> IO () closeProtocolClient = mapM_ (deRefWeak >=> mapM_ killThread) . action {-# INLINE closeProtocolClient #-} +pClientSentCommandsCount :: ProtocolClient v err msg -> IO Int +pClientSentCommandsCount ProtocolClient {client_ = PClient {sentCommands}} = M.size <$> readTVarIO sentCommands + -- | SMP client error type. data ProtocolClientError err = -- | Correctly parsed SMP server ERR response. diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 43aa22a76..ea500b181 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -349,6 +349,14 @@ proxyCfgShortTimeout = nt = NetworkTimeout {backgroundTimeout = 4_000000, interactiveTimeout = 4_000000} in cfg' {smpAgentCfg = aCfg {smpCfg = cCfg {networkConfig = (networkConfig cCfg) {tcpConnectTimeout = nt}}}} +proxyCfgForwardTimeout :: AServerConfig +proxyCfgForwardTimeout = + updateCfg proxyCfg $ \cfg' -> + let aCfg = smpAgentCfg cfg' + cCfg = smpCfg aCfg + nt = NetworkTimeout {backgroundTimeout = 1, interactiveTimeout = 1} + in cfg' {smpAgentCfg = aCfg {smpCfg = cCfg {networkConfig = (networkConfig cCfg) {tcpTimeout = nt}}}} + withSmpServerStoreMsgLogOn :: HasCallStack => (ASrvTransport, AStoreType) -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a withSmpServerStoreMsgLogOn (t, msType) = withSmpServerConfigOn t $ updateCfg (cfgMS msType) $ \cfg' -> cfg' {storeNtfsFile = Just testStoreNtfsFile, serverStatsBackupFile = Just testServerStatsBackupFile} diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 430d52304..29ac4a0bd 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -21,6 +21,7 @@ import Control.Logger.Simple import Control.Monad (forM, forM_, forever, replicateM_) import Control.Monad.Trans.Except (ExceptT, runExceptT) import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as L import Data.Time.Clock (getCurrentTime) @@ -63,6 +64,10 @@ smpProxyTests = do testProxyRecoversWithoutDisconnect it "reconnects to relay after sender disconnects mid-connection" $ \_ -> testProxyReconnectAfterRelayRestart + xit "must drop a stuck relay session after forward timeouts" $ \_ -> + testProxyForwardTimeoutStuckSession + xit "does not keep oversized forwarded command" $ \_ -> + testForwardOversizedNotKept describe "agent client reconnection" $ do it "reconnects after a connect is cancelled mid-flight" $ \_ -> testAgentClientReconnectAfterCancel @@ -496,6 +501,32 @@ testProxyReconnectAfterRelayRestart = race_ (threadDelay 1000000) requestRelaySession requireProxyReconnect +testProxyForwardTimeoutStuckSession :: IO () +testProxyForwardTimeoutStuckSession = + withSmpServerConfigOn (transport @TLS) proxyCfgForwardTimeout testPort $ \_ -> do + g <- C.newRandom + ts <- getCurrentTime + let srv = SMPServer testHost testPort testKeyHash + vr = mkVersionRange minServerSMPRelayVersion currentClientSMPRelayVersion + pc <- either (fail . show) pure =<< getProtocolClient g NRMInteractive (1, srv, Nothing) defaultSMPClientConfig {serverVRange = vr} [] Nothing ts (\_ -> pure ()) + sess <- runExceptT' $ connectSMPProxiedRelay pc NRMInteractive srv (Just "correct") + sId <- atomically $ SMP.EntityId <$> C.randomBytes 24 g + rs <- forM ([1 .. 10] :: [Int]) $ \_ -> runExceptT' (proxySMPMessage pc NRMInteractive sess Nothing sId noMsgFlags "hi") + rs `shouldSatisfy` elem (Left (ProxyProtocolError (SMP.PROXY SMP.NO_SESSION))) + +testForwardOversizedNotKept :: IO () +testForwardOversizedNotKept = + withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ -> do + g <- C.newRandom + ts <- getCurrentTime + let proxyClientCfg = defaultSMPClientConfig {serverVRange = supportedProxyClientSMPRelayVRange, agreeSecret = True, proxyServer = True} + c <- either (fail . show) pure =<< getProtocolClient g NRMBackground (1, testSMPServer, Nothing) proxyClientCfg [] Nothing ts (\_ -> pure ()) + (k, _) <- atomically $ C.generateKeyPair @'C.X25519 g + let et = SMP.EncTransmission $ B.replicate smpBlockSize 'a' + runExceptT (forwardSMPTransmission c (SMP.CorrId "123456789012345678901234") currentClientSMPRelayVersion k et) + `shouldReturn` Left (PCETransportError TELargeMsg) + pClientSentCommandsCount c `shouldReturn` 0 + -- Bug B (same root cause as the proxy, in the messaging agent): getSMPServerClient inserts an -- empty SessionVar into smpClients, then connects inside newProtocolClient's tryAllErrors, which -- rethrows async exceptions. If the connecting thread is cancelled mid-connect, putTMVar is