diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index b16a74daba..86f3b497cb 100644 --- a/tests/ChatClient.hs +++ b/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) ..] diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index f10bba0d82..d38e80b19f 100644 --- a/tests/ChatTests.hs +++ b/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 =