server stress test

tests/ChatClient.hs

@@ -23,6 +23,7 @@ import Simplex.Chat.Terminal.Output (newChatTerminal)
 import Simplex.Chat.Types (Profile)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Client (SMPClientConfig (..), smpDefaultConfig)
 import Simplex.Messaging.Server (runSMPServerBlocking)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Transport
@@ -42,6 +43,7 @@ opts :: ChatOpts
 opts =
   ChatOpts
     { dbFilePrefix = undefined,
+      -- smp://Ufcpyx7utrV45fUopHVvKh4NECi5Z3Fa1TyL4L7tGgc=@smp7.simplex.im
       smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
       logging = False
     }
@@ -70,7 +72,10 @@ cfg :: ChatConfig
 cfg =
   defaultChatConfig
     { agentConfig =
-        aCfg {reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000}},
+        aCfg
+          { reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000},
+            smpCfg = smpDefaultConfig {tcpTimeout = 10000000}
+          },
       testView = True
     }
 
@@ -115,6 +120,12 @@ withTmpFiles =
     (createDirectoryIfMissing False "tests/tmp")
     (removeDirectoryRecursive "tests/tmp")
 
+testChat2' :: (Int, Profile) -> (Int, Profile) -> (TestCC -> TestCC -> IO ()) -> IO ()
+testChat2' (i1, p1) (i2, p2) test = do
+  cc1 <- virtualSimplexChat (testDBPrefix <> show i1) p1
+  cc2 <- virtualSimplexChat (testDBPrefix <> show i2) p2
+  test cc1 cc2
+
 testChatN :: [Profile] -> ([TestCC] -> IO ()) -> IO ()
 testChatN ps test = withTmpFiles $ do
   let envs = zip ps $ map ((testDBPrefix <>) . show) [(1 :: Int) ..]

tests/ChatTests.hs

@@ -6,8 +6,10 @@
 module ChatTests where
 
 import ChatClient
+import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.STM
+import Control.Monad (forever)
 import qualified Data.ByteString as B
 import Data.Char (isDigit)
 import Data.Maybe (fromJust)
@@ -57,6 +59,31 @@ chatTests = do
     it "should deduplicate contact requests with profile change" testDeduplicateContactRequestsProfileChange
     it "should reject contact and delete contact link" testRejectContactAndDeleteUserContact
     it "should delete connection requests when contact link deleted" testDeleteConnectionRequests
+  describe "server stress test" $
+    fit "should stress server with many chats and messages" testStressServer
+
+testStressServer :: IO ()
+testStressServer =
+  withTmpFiles $ do
+    sentTVar <- newTVarIO (0 :: Int)
+    concurrentlyN_ $
+      forever
+        ( do
+            threadDelay 5000000
+            sent <- readTVarIO sentTVar
+            print $ show sent
+        ) :
+      map
+        ( \i ->
+            testChat2' (i * 2 -1, aliceProfile) (i * 2, bobProfile) $
+              \alice bob -> do
+                connectUsers alice bob
+                forever $ do
+                  alice <##> bob
+                  atomically $ modifyTVar sentTVar (+ 2)
+                  threadDelay 500
+        )
+        (take 100 ([1 ..] :: [Int]))
 
 testAddContact :: IO ()
 testAddContact =