testStressServerConnectOnly WIP

apps/simplex-stress-test/Main.hs

@@ -6,6 +6,4 @@ import Test.Hspec
 
 main :: IO ()
 main = do
-  createDirectoryIfMissing False "tests/tmp"
   hspec $ describe "SimpleX chat client" chatTests
-  removeDirectoryRecursive "tests/tmp"

src/Simplex/StressTest.hs

@@ -15,7 +15,9 @@ import Data.Maybe (fromJust)
 import qualified Data.Text as T
 import Simplex.Chat.Controller (ChatController (..))
 import Simplex.Chat.Types (Profile (..), User (..))
+import Simplex.Messaging.Agent (disconnectAgentClient)
 import Simplex.StressTest.ChatClient
+import System.Directory
 import Test.Hspec
 
 aliceProfile :: Profile
@@ -33,7 +35,77 @@ danProfile = Profile {displayName = "dan", fullName = "Daniel"}
 chatTests :: Spec
 chatTests =
   describe "server stress test" $
-    fit "should stress server with many chats and messages" testStressServer
+    -- fit "should stress server with many chats and messages" testStressServer
+    fit "server stress test" testStressServerConnectOnly
+
+testStressServerConnectOnly :: IO ()
+testStressServerConnectOnly = do
+  connectionsTVar <- newTVarIO (0 :: Int)
+  concurrentlyN_ $
+    ( do
+        threadDelay 5000000
+        connections <- readTVarIO connectionsTVar
+        print $ "total connections over time: " <> show connections
+    ) :
+    map
+      ( \i -> do
+          dirExists <- doesDirectoryExist "tests/tmp"
+          if not dirExists
+            then do
+              createDirectoryIfMissing False "tests/tmp"
+              testChat2' (i * 2 -1, aliceProfile) (i * 2, bobProfile) $
+                \alice bob -> do
+                  print $ show i <> " - connected +2"
+                  connectUsers alice bob
+                  threadDelay 1000000
+                  atomically $ modifyTVar connectionsTVar (+ 2)
+            else do
+              testChat2'' (i * 2 -1) (i * 2) $
+                \alice bob -> do
+                  print $ show i <> " - connected +2"
+                  alice `send` "/help"
+                  bob `send` "/help"
+                  threadDelay 1000000
+                  atomically $ modifyTVar connectionsTVar (+ 2)
+      )
+      (take 100 ([1 ..] :: [Int]))
+
+-- testStressServerConnectOnly :: IO ()
+-- testStressServerConnectOnly =
+--   withTmpFiles $ do
+--     connectionsTVar <- newTVarIO (0 :: Int)
+--     concurrentlyN_ $
+--       forever
+--         ( do
+--             threadDelay 5000000
+--             connections <- readTVarIO connectionsTVar
+--             print $ "total connections over time: " <> show connections
+--         ) :
+--       map
+--         ( \i -> do
+--             testChat2' (i * 2 -1, aliceProfile) (i * 2, bobProfile) $
+--               \alice bob -> do
+--                 connectUsers alice bob
+--                 atomically $ modifyTVar connectionsTVar (+ 2)
+--                 disconnectAgent alice
+--                 disconnectAgent bob
+--             forever $ do
+--               threadDelay 5000000
+--               testChat2'' (i * 2 -1) (i * 2) $
+--                 \alice bob -> do
+--                   alice `send` "/help"
+--                   bob `send` "/help"
+--                   atomically $ modifyTVar connectionsTVar (+ 2)
+--                   disconnectAgent alice
+--                   disconnectAgent bob
+--                   threadDelay 5000000
+--                   alice `send` "/help"
+--                   bob `send` "/help"
+--         )
+--         (take 1 ([1 ..] :: [Int]))
+--   where
+--     disconnectAgent TestCC {chatController = ChatController {smpAgent}} =
+--       disconnectAgentClient smpAgent
 
 testStressServer :: IO ()
 testStressServer =

src/Simplex/StressTest/ChatClient.hs

@@ -13,9 +13,11 @@ import Control.Concurrent.STM
 import Control.Exception (bracket, bracket_)
 import Control.Monad.Except
 import Data.List (dropWhileEnd)
+import Data.Maybe (fromJust)
 import Network.Socket
 import Simplex.Chat
 import Simplex.Chat.Controller (ChatConfig (..), ChatController (..))
+import Simplex.Chat.Mobile (getActiveUser_)
 import Simplex.Chat.Options
 import Simplex.Chat.Store
 import Simplex.Chat.Terminal
@@ -74,7 +76,7 @@ cfg =
     { agentConfig =
         aCfg
           { reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000},
-            smpCfg = smpDefaultConfig {tcpTimeout = 10000000}
+            smpCfg = smpDefaultConfig {tcpTimeout = 20000000}
           },
       testView = True
     }
@@ -91,6 +93,18 @@ virtualSimplexChat dbFilePrefix profile = do
   termAsync <- async $ readTerminalOutput t termQ
   pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ}
 
+virtualSimplexChatNoNewUser :: FilePath -> IO TestCC
+virtualSimplexChatNoNewUser dbFilePrefix = do
+  st <- createStore (dbFilePrefix <> "_chat.db") 1 False
+  user_ <- getActiveUser_ st
+  t <- withVirtualTerminal termSettings pure
+  ct <- newChatTerminal t
+  cc <- newChatController st user_ cfg opts {dbFilePrefix} (const $ pure ()) -- no notifications
+  chatAsync <- async $ runSimplexChat (fromJust user_) ct cc
+  termQ <- newTQueueIO
+  termAsync <- async $ readTerminalOutput t termQ
+  pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ}
+
 readTerminalOutput :: VirtualTerminal -> TQueue String -> IO ()
 readTerminalOutput t termQ = do
   let w = virtualWindow t
@@ -126,6 +140,12 @@ testChat2' (i1, p1) (i2, p2) test = do
   cc2 <- virtualSimplexChat (testDBPrefix <> show i2) p2
   test cc1 cc2
 
+testChat2'' :: Int -> Int -> (TestCC -> TestCC -> IO ()) -> IO ()
+testChat2'' i1 i2 test = do
+  cc1 <- virtualSimplexChatNoNewUser (testDBPrefix <> show i1)
+  cc2 <- virtualSimplexChatNoNewUser (testDBPrefix <> show i2)
+  test cc1 cc2
+
 testChatN :: [Profile] -> ([TestCC] -> IO ()) -> IO ()
 testChatN ps test = withTmpFiles $ do
   let envs = zip ps $ map ((testDBPrefix <>) . show) [(1 :: Int) ..]

stack.yaml

@@ -46,9 +46,9 @@ extra-deps:
   - text-short-0.1.5@sha256:962c6228555debdc46f758d0317dea16e5240d01419b42966674b08a5c3d8fa6,3498
   - time-compat-1.9.6.1@sha256:42d8f2e08e965e1718917d54ad69e1d06bd4b87d66c41dc7410f59313dba4ed1,5033
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
-  # - ../simplexmq
-  - github: simplex-chat/simplexmq
-    commit: 229e2607d76f3d6baf0d2623b186c084e3908b8f
+  - ../simplexmq
+  # - github: simplex-chat/simplexmq
+    # commit: 229e2607d76f3d6baf0d2623b186c084e3908b8f
   # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
   - github: simplex-chat/aeson
     commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7