diff --git a/apps/simplex-stress-test/Main.hs b/apps/simplex-stress-test/Main.hs index 7d45262a64..ebbafa8a5e 100644 --- a/apps/simplex-stress-test/Main.hs +++ b/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" diff --git a/src/Simplex/StressTest.hs b/src/Simplex/StressTest.hs index 7824fb72cb..5a02c8a4bc 100644 --- a/src/Simplex/StressTest.hs +++ b/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 = diff --git a/src/Simplex/StressTest/ChatClient.hs b/src/Simplex/StressTest/ChatClient.hs index 700887b52a..25f36275e6 100644 --- a/src/Simplex/StressTest/ChatClient.hs +++ b/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) ..] diff --git a/stack.yaml b/stack.yaml index 09a567a0bc..e6a7d0b8b9 100644 --- a/stack.yaml +++ b/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