From 79079f64c3e9f4dd98fd305350b10d5582ac5a87 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Wed, 23 Sep 2026 20:12:59 +0000 Subject: [PATCH] fix more tests --- plans/2026-09-13-parallel-tests.md | 10 ++++ tests/Bots/BadgeServiceTests.hs | 22 ++++---- tests/ChatClient.hs | 82 ++++++++++++++------------- tests/ChatTests/Direct.hs | 89 ++++++++++++++++-------------- tests/ChatTests/Groups.hs | 16 ++++-- tests/ChatTests/Profiles.hs | 68 +++++++++++------------ tests/ChatTests/Utils.hs | 4 +- 7 files changed, 157 insertions(+), 134 deletions(-) diff --git a/plans/2026-09-13-parallel-tests.md b/plans/2026-09-13-parallel-tests.md index 542e8d2016..461c970b84 100644 --- a/plans/2026-09-13-parallel-tests.md +++ b/plans/2026-09-13-parallel-tests.md @@ -32,6 +32,16 @@ concurrently in one process with `parallel` and `--jobs`. "Save query plans" (last item, reads the maps after every test). - Postgres: the database is created once (`beforeAll_`/`afterAll_`); the client schema prefix includes the test directory name. +- Bots started through `directoryService`, `badgeService` and + `simplexChatCore` take `coreOptions` and the config from `testPortsCfg`. +- `TestTerminal` wraps the virtual terminal and writes the cursor row to + `termQ` on `PutLn`. +- The "no output left" check runs in the bracket body; `stopTestChat` stops + the client in a separate thread with a 60 s limit and keeps the store open + after the limit. +- Per-test limit 180 s; the "channels" group is `sequential`; `@@@` waits + 500 ms. TTL and timed-message tests use multi-second TTLs; ratchet + desynchronization helpers turn receipts off. ## Status diff --git a/tests/Bots/BadgeServiceTests.hs b/tests/Bots/BadgeServiceTests.hs index 640d0ba533..db31650194 100644 --- a/tests/Bots/BadgeServiceTests.hs +++ b/tests/Bots/BadgeServiceTests.hs @@ -38,7 +38,7 @@ import Simplex.Chat.Badges.Ledger (addMonths, creditTypeTag, debitTypeTag, endOf import Simplex.Chat.Badges.Service import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatResponse (CRCustomChatResponse)) import Simplex.Chat.Core (sendChatCmdStr) -import Simplex.Chat.Options (CoreChatOpts (..)) +import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..)) import Simplex.Chat.Options.DB import Simplex.Messaging.Agent.Store.Common (withTransaction) import Simplex.Messaging.Agent.Store.DB (BoolInt (..)) @@ -96,16 +96,16 @@ testIssuerKeyIdx :: Int testIssuerKeyIdx = 1 mkBadgeServiceOpts :: TestParams -> BBSSecretKey -> BadgeServiceOpts -mkBadgeServiceOpts TestParams {tmpPath = ps} secretKey = +mkBadgeServiceOpts ps secretKey = BadgeServiceOpts { coreOptions = - testCoreOpts + coreOpts { dbOptions = (dbOptions testCoreOpts) #if defined(dbPostgres) - {dbSchemaPrefix = "client_" <> serviceDbPrefix} + {dbSchemaPrefix = testSchemaPrefix ps serviceDbPrefix} #else - {dbFilePrefix = ps serviceDbPrefix} + {dbFilePrefix = tmpPath ps serviceDbPrefix} #endif }, serviceName = "SimpleX Badges", @@ -115,6 +115,8 @@ mkBadgeServiceOpts TestParams {tmpPath = ps} secretKey = issuerKey = Just BadgeIssuerKey {keyIdx = testIssuerKeyIdx, secretKey}, testing = True } + where + (_, ChatOpts {coreOptions = coreOpts}) = testPortsCfg ps testCfg testOpts -- | A clock the service and the client both read: real time plus an offset the test moves. It -- tracks real time rather than freezing it, so a sleeper still sleeps the right real duration. @@ -157,7 +159,7 @@ withBadgeServiceEnv ps test = do svcCfg = testCfg {badgePublicKeys = M.singleton testIssuerKeyIdx pk, badgeCurrentTime = testClockTime clock} withNewTestChatCfg ps testCfg serviceDbPrefix badgeProfile $ \_ -> pure () -- First start: badge service takes the CreateMyAddress branch. - runBadgeService svcCfg opts $ \_ -> pure () + runBadgeService ps svcCfg opts $ \_ -> pure () -- Reopen the DB to read the link the service created. bsLink <- withTestChat ps serviceDbPrefix $ \bs -> do bs <## "subscribed 1 connections on server localhost" @@ -168,7 +170,7 @@ withBadgeServiceEnv ps test = do let clientCfg = svcCfg {badgeServiceAddress = Just $ either (error . ("bad badge service address: " <>)) id $ strDecode (B.pack bsLink)} -- Second start: badge service takes the ShowMyAddress branch, then serves the test body. - runBadgeService svcCfg opts $ \env -> do + runBadgeService ps svcCfg opts $ \env -> do cc <- atomically $ readTMVar $ serviceCC env test BadgeServiceEnv {bsIssuerKey = BadgeIssuerKey {keyIdx = testIssuerKeyIdx, secretKey = sk}, bsClock = clock, bsClientCfg = clientCfg, bsAddress = bsLink, bsController = cc} @@ -184,10 +186,10 @@ issueCode cc badgeType months = -- | The post-start hook fills serviceCC once the address exists, so waiting on it is the service -- being ready. A fixed delay here raced with startup and left the address output of one start -- arriving during the next test. -runBadgeService :: ChatConfig -> BadgeServiceOpts -> (ServiceState -> IO ()) -> IO () -runBadgeService cfg opts action = do +runBadgeService :: TestParams -> ChatConfig -> BadgeServiceOpts -> (ServiceState -> IO ()) -> IO () +runBadgeService ps cfg opts action = do env <- newServiceState - t <- forkIO $ badgeService opts cfg env + t <- forkIO $ badgeService opts (fst $ testPortsCfg ps cfg testOpts) env ready <- timeout 30000000 $ atomically $ readTMVar $ serviceCC env when (isNothing ready) $ killThread t >> error "badge service did not start" action env `finally` killThread t diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index a3eb252f2b..d1c83ddc39 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -40,7 +40,7 @@ import Simplex.Chat.Options.DB import Simplex.Chat.Store import Simplex.Chat.Store.Profiles import Simplex.Chat.Terminal -import Simplex.Chat.Terminal.Output (newChatTerminal) +import Simplex.Chat.Terminal.Output (WithTerminal (..), newChatTerminal) import Simplex.Chat.Types import Simplex.Chat.Types.Shared (GroupMemberRole (..)) import Simplex.FileTransfer.Description (kb, mb) @@ -70,7 +70,7 @@ import Simplex.Messaging.Version.Internal import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive) import System.FilePath (()) import qualified System.Terminal as C -import System.Terminal.Internal (VirtualTerminal (..), VirtualTerminalSettings (..), withVirtualTerminal) +import System.Terminal.Internal (Command (..), Terminal (..), VirtualTerminal (..), VirtualTerminalSettings (..), withVirtualTerminal) import System.Timeout (timeout) import Test.Hspec (Expectation, HasCallStack, shouldReturn) #if defined(dbPostgres) @@ -260,14 +260,33 @@ termSettings = data TestCC = TestCC { chatController :: ChatController, - virtualTerminal :: VirtualTerminal, chatAsync :: Async (), - termAsync :: Async (), termQ :: TQueue String, printOutput :: Bool, ccParams :: TestParams } +data TestTerminal = TestTerminal VirtualTerminal (TQueue String) + +instance Terminal TestTerminal where + termType (TestTerminal t _) = termType t + termEvent (TestTerminal t _) = termEvent t + termInterrupt (TestTerminal t _) = termInterrupt t + termCommand (TestTerminal t q) c = do + case c of + PutLn -> atomically $ do + C.Position {row} <- readTVar $ virtualCursor t + rows <- readTVar $ virtualWindow t + writeTQueue q $ dropWhileEnd (== ' ') $ rows !! row + _ -> pure () + termCommand t c + termFlush (TestTerminal t _) = termFlush t + termGetWindowSize (TestTerminal t _) = termGetWindowSize t + termGetCursorPosition (TestTerminal t _) = termGetCursorPosition t + +instance WithTerminal TestTerminal where + withTerm t = ($ t) + aCfg :: AgentConfig aCfg = (agentConfig defaultChatConfig) {tbqSize = 16} @@ -380,29 +399,31 @@ insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) V startTestChat_ :: TestParams -> ChatDatabase -> ChatConfig -> ChatOpts -> String -> User -> IO TestCC startTestChat_ ps@TestParams {tmpPath, printOutput} db cfg_ opts_ dbPrefix user = do let (cfg, opts@ChatOpts {coreOptions = CoreChatOpts {maintenance}}) = testPortsCfg ps cfg_ opts_ - t <- withVirtualTerminal termSettings pure + termQ <- newTQueueIO + t <- withVirtualTerminal termSettings $ pure . (`TestTerminal` termQ) ct <- newChatTerminal t opts Right cc <- newChatController db (Just user) cfg opts False void $ execChatCommand' (SetTempFolder (tmpPath dbPrefix)) 0 `runReaderT` cc chatAsync <- async $ runSimplexChat cfg opts user cc $ \_u cc' -> runChatTerminal ct cc' opts unless maintenance $ atomically $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry - termQ <- newTQueueIO - termAsync <- async $ readTerminalOutput t termQ - pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ, printOutput, ccParams = ps} + pure TestCC {chatController = cc, chatAsync, termQ, printOutput, ccParams = ps} stopTestChat :: TestParams -> TestCC -> IO () -stopTestChat ps TestCC {chatController = cc@ChatController {smpAgent, chatStore}, chatAsync, termAsync} = do - stopChatController cc - uninterruptibleCancel termAsync - uninterruptibleCancel chatAsync - liftIO $ disposeAgentClient smpAgent +stopTestChat ps TestCC {chatController = cc@ChatController {smpAgent, chatStore}, chatAsync} = do + stopped <- async $ do + stopChatController cc + cancel chatAsync + disposeAgentClient smpAgent + r <- timeout 60000000 $ wait stopped #if !defined(dbPostgres) chatStats <- withConnection chatStore $ readTVarIO . DB.slow atomically $ modifyTVar' (chatQueryStats ps) $ M.unionWith combineStats chatStats agentStats <- withConnection (agentClientStore smpAgent) $ readTVarIO . DB.slow atomically $ modifyTVar' (agentQueryStats ps) $ M.unionWith combineStats agentStats #endif - closeDBStore chatStore + case r of + Just () -> closeDBStore chatStore + Nothing -> putStrLn "stopTestChat: chat did not stop in 60 seconds" threadDelay 200000 #if !defined(dbPostgres) where @@ -455,7 +476,8 @@ withTestChatOpts :: HasCallStack => TestParams -> ChatOpts -> String -> (HasCall withTestChatOpts ps = withTestChatCfgOpts ps testCfg withTestChatCfgOpts :: HasCallStack => TestParams -> ChatConfig -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a -withTestChatCfgOpts ps cfg opts dbPrefix = bracket (startTestChat ps cfg opts dbPrefix) (\cc -> cc > stopTestChat ps cc) +withTestChatCfgOpts ps cfg opts dbPrefix runTest = + bracket (startTestChat ps cfg opts dbPrefix) (stopTestChat ps) (\cc -> runTest cc >>= ((cc )) -- enable output for specific test. -- usage: withTestOutput $ testChat2 aliceProfile bobProfile $ \alice bob -> do ... @@ -482,29 +504,6 @@ enableNamesRole TestCC {chatController = cc} = do } enableNames srv@UserServer {roles} = (srv :: UserServer 'PSMP) {roles = (roles :: ServerRolesOverride) {names = Just True}} -readTerminalOutput :: VirtualTerminal -> TQueue String -> IO () -readTerminalOutput t termQ = do - let w = virtualWindow t - winVar <- atomically $ newTVar . init =<< readTVar w - forever . atomically $ do - win <- readTVar winVar - win' <- init <$> readTVar w - if win' == win - then retry - else do - let diff = getDiff win' win - forM_ diff $ writeTQueue termQ - writeTVar winVar win' - where - getDiff :: [String] -> [String] -> [String] - getDiff win win' = getDiff_ 1 (length win) win win' - getDiff_ :: Int -> Int -> [String] -> [String] -> [String] - getDiff_ n len win' win = - let diff = drop (len - n) win' - in if drop n win <> diff == win' - then map (dropWhileEnd (== ' ')) diff - else getDiff_ (n + 1) len win' win - withTmpFiles :: IO () -> IO () withTmpFiles = bracket_ @@ -523,16 +522,15 @@ withPortBase bases = bracket takeBase (\b -> atomically $ modifyTVar' bases (b : testChatN :: HasCallStack => ChatConfig -> ChatOpts -> [Profile] -> (HasCallStack => [TestCC] -> IO ()) -> TestParams -> IO () testChatN cfg opts ps test params = - bracket (getTestCCs $ zip ps [1 ..]) endTests test + bracket (getTestCCs $ zip ps [1 ..]) (mapConcurrently_ $ stopTestChat params) $ \tcs -> do + test tcs + mapConcurrently_ ( IO [TestCC] getTestCCs [] = pure [] getTestCCs ((p, db) : envs') = (:) <$> createTestChat params cfg opts (show db) useClientServices p <*> getTestCCs envs' - endTests tcs = do - mapConcurrently_ ( TestCC -> Int -> Expectation ( "/_call status @2 connected" alice <## "ok" threadDelay 100000 - alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "outgoing call: in progress (00:00)")]) + alice #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(1, "outgoing call: in progress")]) bob ##> "/_call status @2 connected" bob <## "ok" threadDelay 100000 - bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "incoming call: in progress (00:00)")]) + bob #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(0, "incoming call: in progress")]) -- either party can end the call bob ##> "/_call end @2" bob <## "ok" threadDelay 100000 - bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "incoming call: ended (00:00)")]) + bob #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(0, "incoming call: ended")]) alice <## "call with bob ended" - alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "outgoing call: ended (00:00)")]) + alice #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(1, "outgoing call: ended")]) + where + callChat = map (fmap noDuration) . chat + noDuration s = case words s of + ws@(_ : _) | "(0" `isPrefixOf` last ws -> unwords $ init ws + _ -> s testStopStartChat :: HasCallStack => TestParams -> IO () testStopStartChat ps = @@ -1370,12 +1375,12 @@ testStopStartChat ps = connectUsers alice bob alice #> "@bob hi" bob <# "alice> hi" - alice #$> ("/_ttl 1 4", id, "ok") - alice ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 2}}" + alice #$> ("/_ttl 1 12", id, "ok") + alice ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 6}}" alice <## "you updated preferences for bob:" - alice <## "Disappearing messages: enabled (you allow: yes (2 sec), contact allows: yes)" + alice <## "Disappearing messages: enabled (you allow: yes (6 sec), contact allows: yes)" bob <## "alice updated preferences for you:" - bob <## "Disappearing messages: enabled (you allow: yes (2 sec), contact allows: yes (2 sec))" + bob <## "Disappearing messages: enabled (you allow: yes (6 sec), contact allows: yes (6 sec))" alice #> "@bob hi timed" bob <# "alice> hi timed" let ChatController {agentAsync, cleanupManagerAsync, expireCIThreads, timedItemThreads} = chatController alice @@ -1397,9 +1402,10 @@ testStopStartChat ps = alice <## "subscribed 1 connections on server localhost" bob #> "@alice hello" alice <# "bob> hello" + threadDelay 3000000 alice <### ["timed message deleted: hi timed", "timed message deleted: hello"] bob <### ["timed message deleted: hi timed", "timed message deleted: hello"] - threadDelay 3000000 + threadDelay 8000000 alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner")]) Just (a1', _) <- readTVarIO agentAsync (a1' == a1) `shouldBe` False @@ -1685,6 +1691,7 @@ testConnSyncExtraAgentConns ps = do alice ##> "/_connections diff" alice <## "no difference between agent and chat connections" + threadDelay 1000000 -- deleting connection record in chat db void $ withCCTransaction alice $ \db -> DB.execute_ db "DELETE FROM connections WHERE contact_id = (SELECT contact_id FROM contacts WHERE local_display_name = 'cath')" @@ -2275,17 +2282,17 @@ testUsersDifferentCIExpirationTTL ps = do -- set ttl for first user alice ##> "/user alice" showActiveUser alice "alice (Alice)" - alice #$> ("/_ttl 1 2", id, "ok") + alice #$> ("/_ttl 1 10", id, "ok") -- set ttl for second user alice ##> "/user alisa" showActiveUser alice "alisa" - alice #$> ("/_ttl 2 4", id, "ok") + alice #$> ("/_ttl 2 25", id, "ok") -- first user messages alice ##> "/user alice" showActiveUser alice "alice (Alice)" - alice #$> ("/ttl", id, "old messages are set to be deleted after: 2 second(s)") + alice #$> ("/ttl", id, "old messages are set to be deleted after: 10 second(s)") alice #> "@bob alice 3" bob <# "alice> alice 3" @@ -2297,7 +2304,7 @@ testUsersDifferentCIExpirationTTL ps = do -- second user messages alice ##> "/user alisa" showActiveUser alice "alisa" - alice #$> ("/ttl", id, "old messages are set to be deleted after: 4 second(s)") + alice #$> ("/ttl", id, "old messages are set to be deleted after: 25 second(s)") alice #> "@bob alisa 3" bob <# "alisa> alisa 3" @@ -2306,7 +2313,7 @@ testUsersDifferentCIExpirationTTL ps = do alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")]) - threadDelay 3000000 + threadDelay 12000000 -- messages both before and after setting chat item ttl are deleted -- first user messages @@ -2319,7 +2326,7 @@ testUsersDifferentCIExpirationTTL ps = do showActiveUser alice "alisa" alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")]) - threadDelay 2100000 + threadDelay 15000000 alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner")]) where @@ -2330,13 +2337,13 @@ testUsersRestartCIExpiration ps = do withNewTestChat ps "bob" bobProfile $ \bob -> do withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do -- set ttl for first user - alice #$> ("/_ttl 1 2", id, "ok") + alice #$> ("/_ttl 1 10", id, "ok") connectUsers alice bob -- create second user and set ttl alice ##> "/create user alisa" showActiveUser alice "alisa" - alice #$> ("/_ttl 2 5", id, "ok") + alice #$> ("/_ttl 2 25", id, "ok") connectUsers alice bob -- first user messages @@ -2368,7 +2375,7 @@ testUsersRestartCIExpiration ps = do -- first user messages alice ##> "/user alice" showActiveUser alice "alice (Alice)" - alice #$> ("/ttl", id, "old messages are set to be deleted after: 2 second(s)") + alice #$> ("/ttl", id, "old messages are set to be deleted after: 10 second(s)") alice #> "@bob alice 3" bob <# "alice> alice 3" @@ -2380,7 +2387,7 @@ testUsersRestartCIExpiration ps = do -- second user messages alice ##> "/user alisa" showActiveUser alice "alisa" - alice #$> ("/ttl", id, "old messages are set to be deleted after: 5 second(s)") + alice #$> ("/ttl", id, "old messages are set to be deleted after: 25 second(s)") alice #> "@bob alisa 3" bob <# "alisa> alisa 3" @@ -2389,7 +2396,7 @@ testUsersRestartCIExpiration ps = do alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")]) - threadDelay 3000000 + threadDelay 12000000 -- messages both before and after restart are deleted -- first user messages @@ -2402,7 +2409,7 @@ testUsersRestartCIExpiration ps = do showActiveUser alice "alisa" alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")]) - threadDelay 4000000 + threadDelay 15000000 alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner")]) where @@ -2490,7 +2497,7 @@ testDisableCIExpirationOnlyForOneUser ps = do -- create second user and set ttl alice ##> "/create user alisa" showActiveUser alice "alisa" - alice #$> ("/_ttl 2 1", id, "ok") + alice #$> ("/_ttl 2 5", id, "ok") connectUsers alice bob -- first user disables expiration @@ -2502,7 +2509,7 @@ testDisableCIExpirationOnlyForOneUser ps = do -- second user still has ttl configured alice ##> "/user alisa" showActiveUser alice "alisa" - alice #$> ("/ttl", id, "old messages are set to be deleted after: 1 second(s)") + alice #$> ("/ttl", id, "old messages are set to be deleted after: 5 second(s)") alice #> "@bob alisa 1" bob <# "alisa> alisa 1" @@ -2511,7 +2518,7 @@ testDisableCIExpirationOnlyForOneUser ps = do alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2")]) - threadDelay 2000000 + threadDelay 6000000 -- second user messages are deleted alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner")]) @@ -2521,7 +2528,7 @@ testDisableCIExpirationOnlyForOneUser ps = do alice <## "subscribed 1 connections on server localhost" -- second user still has ttl configured after restart - alice #$> ("/ttl", id, "old messages are set to be deleted after: 1 second(s)") + alice #$> ("/ttl", id, "old messages are set to be deleted after: 5 second(s)") alice #> "@bob alisa 3" bob <# "alisa> alisa 3" @@ -2530,7 +2537,7 @@ testDisableCIExpirationOnlyForOneUser ps = do alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")]) - threadDelay 3000000 + threadDelay 6000000 -- second user messages are deleted alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner")]) @@ -2542,13 +2549,13 @@ testUsersTimedMessages ps' = do withNewTestChat ps "bob" bobProfile $ \bob -> do withNewTestChat ps "alice" aliceProfile $ \alice -> do connectUsers alice bob - configureTimedMessages alice bob "2" "2" + configureTimedMessages alice bob "2" "8" -- create second user and configure timed messages for contact alice ##> "/create user alisa" showActiveUser alice "alisa" connectUsers alice bob - configureTimedMessages alice bob "5" "3" + configureTimedMessages alice bob "5" "16" -- first user messages alice ##> "/user alice" @@ -2569,7 +2576,7 @@ testUsersTimedMessages ps' = do alice <# "bob> alisa 2" -- messages are deleted after ttl - threadDelay 1500000 + threadDelay 6000000 alice ##> "/user alice" showActiveUser alice "alice (Alice)" @@ -2579,7 +2586,7 @@ testUsersTimedMessages ps' = do showActiveUser alice "alisa" alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 1"), (0, "alisa 2")]) - threadDelay 1000000 + threadDelay 4000000 alice <### ["[user: alice] timed message deleted: alice 1", "[user: alice] timed message deleted: alice 2"] bob <### ["timed message deleted: alice 1", "timed message deleted: alice 2"] @@ -2592,7 +2599,7 @@ testUsersTimedMessages ps' = do showActiveUser alice "alisa" alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 1"), (0, "alisa 2")]) - threadDelay 1000000 + threadDelay 7000000 alice <### ["timed message deleted: alisa 1", "timed message deleted: alisa 2"] bob <### ["timed message deleted: alisa 1", "timed message deleted: alisa 2"] @@ -2632,7 +2639,7 @@ testUsersTimedMessages ps' = do alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")]) -- messages are deleted after restart - threadDelay 1000000 + threadDelay 8000000 alice <### ["[user: alice] timed message deleted: alice 3", "[user: alice] timed message deleted: alice 4"] bob <### ["timed message deleted: alice 3", "timed message deleted: alice 4"] @@ -2645,7 +2652,7 @@ testUsersTimedMessages ps' = do showActiveUser alice "alisa" alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")]) - threadDelay 1000000 + threadDelay 8000000 alice <### ["timed message deleted: alisa 3", "timed message deleted: alisa 4"] bob <### ["timed message deleted: alisa 3", "timed message deleted: alisa 4"] @@ -2827,17 +2834,17 @@ testSetChatItemTTL = bob <## "use /fr 1 [/ | ] to receive it" alice <## "completed uploading file 1 (test.jpg) for bob" -- above items should be deleted after we set ttl - threadDelay 3000000 + threadDelay 6000000 alice #> "@bob 3" bob <# "alice> 3" bob #> "@alice 4" alice <# "bob> 4" alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "1"), Nothing), ((0, "2"), Nothing), ((1, ""), Just "test.jpg"), ((1, "3"), Nothing), ((0, "4"), Nothing)]) checkActionDeletesFile (tmpFile alice "app_files/test.jpg") $ - alice #$> ("/_ttl 1 2", id, "ok") + alice #$> ("/_ttl 1 5", id, "ok") alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner"), (1, "3"), (0, "4")]) -- when expiration is turned on, first cycle is synchronous bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "1"), (1, "2"), (0, ""), (0, "3"), (1, "4")]) - alice #$> ("/_ttl 1", id, "old messages are set to be deleted after: 2 second(s)") + alice #$> ("/_ttl 1", id, "old messages are set to be deleted after: 5 second(s)") alice #$> ("/ttl week", id, "ok") alice #$> ("/ttl", id, "old messages are set to be deleted after: one week") alice #$> ("/ttl none", id, "ok") @@ -2861,13 +2868,13 @@ testSetDirectChatTTL = alice #$> ("/ttl @cath none", id, "ok") alice #$> ("/ttl @cath", id, "old messages are not being deleted") - threadDelay 3000000 + threadDelay 6000000 alice #> "@bob 3" bob <# "alice> 3" bob #> "@alice 4" alice <# "bob> 4" alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "1"), Nothing), ((0, "2"), Nothing), ((1, "3"), Nothing), ((0, "4"), Nothing)]) - alice #$> ("/_ttl 1 2", id, "ok") + alice #$> ("/_ttl 1 5", id, "ok") -- when expiration is turned on, first cycle is synchronous alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner"), (1, "3"), (0, "4")]) @@ -3116,13 +3123,15 @@ testMsgDecryptError ps = withTestChat ps "bob" $ \bob -> do bob <## "subscribed 1 connections on server localhost" alice #> "@bob hello again" - bob <# "alice> skipped message ID 9..11" + bob <# "alice> skipped message ID 7..9" bob <# "alice> hello again" bob #> "@alice received!" alice <# "bob> received!" setupDesynchronizedRatchet :: HasCallStack => TestParams -> TestCC -> IO () setupDesynchronizedRatchet ps alice = do + alice ##> "/set receipts all off" + alice <## "ok" copyDb "bob" "bob_old" withTestChat ps "bob" $ \bob -> do bob <## "subscribed 1 connections on server localhost" diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index a649ceb808..0d9610ac67 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -262,7 +262,7 @@ chatGroupTests = do -- TODO - cancellation on failure to create relay group (for owner) -- TODO - async retry connecting to relay (for members) -- TODO - test relay privileges - describe "channels" $ do + sequential $ describe "channels" $ do describe "relay delivery" $ do describe "single relay" $ do it "should deliver messages to members" testChannels1RelayDeliver @@ -3501,7 +3501,7 @@ testGLinkRejectBlockedName = bob <## "#team: joining the group..." bob <## "#team: join rejected, reason: GRRBlockedName" - threadDelay 100000 + threadDelay 1000000 alice `hasContactProfiles` ["alice"] memCount <- withCCTransaction alice $ \db -> @@ -4097,13 +4097,15 @@ testGroupMsgDecryptError ps = withTestChat ps "bob" $ \bob -> do bob <## "subscribed 2 connections on server localhost" alice #> "#team hello again" - bob <# "#team alice> skipped message ID 8..10" + bob <# "#team alice> skipped message ID 6..8" bob <# "#team alice> hello again" bob #> "#team received!" alice <# "#team bob> received!" setupDesynchronizedRatchet :: HasCallStack => TestParams -> TestCC -> IO () setupDesynchronizedRatchet ps alice = do + alice ##> "/set receipts all off" + alice <## "ok" copyDb "bob" "bob_old" withTestChat ps "bob" $ \bob -> do bob <## "subscribed 2 connections on server localhost" @@ -6482,12 +6484,12 @@ testGroupHistoryDisappearingMessage = threadDelay 1000000 -- 3 seconds so that messages 2 and 3 are not deleted for alice before sending history to cath - alice ##> "/set disappear #team on 4" + alice ##> "/set disappear #team on 15" alice <## "updated group preferences:" - alice <## "Disappearing messages: on (4 sec)" + alice <## "Disappearing messages: on (15 sec)" bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" - bob <## "Disappearing messages: on (4 sec)" + bob <## "Disappearing messages: on (15 sec)" bob #> "#team 2" alice <# "#team bob> 2" @@ -6531,6 +6533,7 @@ testGroupHistoryDisappearingMessage = r1 <- chat <$> getTermLine cath r1 `shouldContain` [(0, "1"), (0, "2"), (0, "3"), (0, "4")] + threadDelay 11000000 concurrentlyN_ [ alice <### [ "timed message deleted: 2", @@ -7614,6 +7617,7 @@ testGroupMemberInactive ps = do bob <# "#team alice> hi" bob #> "#team hey" alice <# "#team bob> hey" + threadDelay 1000000 -- bob is offline alice #> "#team 1" diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index f91c31ac0e..d8eead5209 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -1627,7 +1627,7 @@ testPlanAddressContactViaAddress = bob ##> ("/c " <> cLink) connecting alice bob - bob ##> "/delete @alice" + bob ##> "/delete @alice notify=off" bob <## "alice: contact is deleted" alice ##> "/delete @bob" alice <## "bob: contact is deleted" @@ -1689,7 +1689,7 @@ testPlanAddressContactViaShortAddress = bob ##> ("/c " <> sLink) connecting alice bob - bob ##> "/delete @alice" + bob ##> "/delete @alice notify=off" bob <## "alice: contact is deleted" alice ##> "/delete @bob" alice <## "bob: contact is deleted" @@ -2803,41 +2803,41 @@ testEnableTimedMessagesContact = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob - alice ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 1}}" + alice ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 3}}" alice <## "you updated preferences for bob:" - alice <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes)" + alice <## "Disappearing messages: enabled (you allow: yes (3 sec), contact allows: yes)" bob <## "alice updated preferences for you:" - bob <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec))" + bob <## "Disappearing messages: enabled (you allow: yes (3 sec), contact allows: yes (3 sec))" bob ##> "/set disappear @alice yes" bob <## "your preferences for alice did not change" alice <##> bob threadDelay 500000 - alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)"), (1, "hi"), (0, "hey")]) - bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)"), (0, "hi"), (1, "hey")]) - threadDelay 1000000 + alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)"), (1, "hi"), (0, "hey")]) + bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)"), (0, "hi"), (1, "hey")]) + threadDelay 3000000 alice <### ["timed message deleted: hi", "timed message deleted: hey"] bob <### ["timed message deleted: hi", "timed message deleted: hey"] - alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)")]) - bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)")]) + alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)")]) + bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)")]) -- turn off, messages are not disappearing bob ##> "/set disappear @alice no" bob <## "you updated preferences for alice:" - bob <## "Disappearing messages: off (you allow: no, contact allows: yes (1 sec))" + bob <## "Disappearing messages: off (you allow: no, contact allows: yes (3 sec))" alice <## "bob updated preferences for you:" - alice <## "Disappearing messages: off (you allow: yes (1 sec), contact allows: no)" + alice <## "Disappearing messages: off (you allow: yes (3 sec), contact allows: no)" alice <##> bob threadDelay 1500000 - alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)"), (0, "Disappearing messages: off"), (1, "hi"), (0, "hey")]) - bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)"), (1, "Disappearing messages: off"), (0, "hi"), (1, "hey")]) + alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)"), (0, "Disappearing messages: off"), (1, "hi"), (0, "hey")]) + bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)"), (1, "Disappearing messages: off"), (0, "hi"), (1, "hey")]) -- test api bob ##> "/set disappear @alice yes 30s" bob <## "you updated preferences for alice:" - bob <## "Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (1 sec))" + bob <## "Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (3 sec))" alice <## "bob updated preferences for you:" alice <## "Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (30 sec))" bob ##> "/set disappear @alice week" -- "yes" is optional bob <## "you updated preferences for alice:" - bob <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 sec))" + bob <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (3 sec))" alice <## "bob updated preferences for you:" alice <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 week))" @@ -2847,23 +2847,23 @@ testEnableTimedMessagesGroup = \alice bob -> do createGroup2 "team" alice bob threadDelay 1000000 - alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 1}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}" + alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 3}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}" alice <## "updated group preferences:" - alice <## "Disappearing messages: on (1 sec)" + alice <## "Disappearing messages: on (3 sec)" bob <## "alice updated group #team: (signed)" bob <## "updated group preferences:" - bob <## "Disappearing messages: on (1 sec)" + bob <## "Disappearing messages: on (3 sec)" threadDelay 1000000 alice #> "#team hi" bob <# "#team alice> hi" threadDelay 500000 - alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "hi")]) - bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)"), (0, "hi")]) - threadDelay 1000000 + alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (3 sec)"), (1, "hi")]) + bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (3 sec)"), (0, "hi")]) + threadDelay 3000000 alice <## "timed message deleted: hi" bob <## "timed message deleted: hi" - alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (1 sec)")]) - bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)")]) + alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (3 sec)")]) + bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (3 sec)")]) -- turn off, messages are not disappearing alice ##> "/set disappear #team off" alice <## "updated group preferences:" @@ -2875,8 +2875,8 @@ testEnableTimedMessagesGroup = alice #> "#team hey" bob <# "#team alice> hey" threadDelay 1500000 - alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "Disappearing messages: off"), (1, "hey")]) - bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)"), (0, "Disappearing messages: off"), (0, "hey")]) + alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (3 sec)"), (1, "Disappearing messages: off"), (1, "hey")]) + bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (3 sec)"), (0, "Disappearing messages: off"), (0, "hey")]) -- test api alice ##> "/set disappear #team on 30s" alice <## "updated group preferences:" @@ -2898,20 +2898,20 @@ testTimedMessagesEnabledGlobally = alice ##> "/set disappear yes" alice <## "user profile did not change" connectUsers alice bob - bob ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 1}}" + bob ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 3}}" bob <## "you updated preferences for alice:" - bob <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes)" + bob <## "Disappearing messages: enabled (you allow: yes (3 sec), contact allows: yes)" alice <## "bob updated preferences for you:" - alice <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec))" + alice <## "Disappearing messages: enabled (you allow: yes (3 sec), contact allows: yes (3 sec))" alice <##> bob threadDelay 500000 - alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)"), (1, "hi"), (0, "hey")]) - bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)"), (0, "hi"), (1, "hey")]) - threadDelay 1000000 + alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)"), (1, "hi"), (0, "hey")]) + bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)"), (0, "hi"), (1, "hey")]) + threadDelay 3000000 alice <### ["timed message deleted: hi", "timed message deleted: hey"] bob <### ["timed message deleted: hi", "timed message deleted: hey"] - alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)")]) - bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)")]) + alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)")]) + bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)")]) testUpdateMultipleUserPrefs :: HasCallStack => TestParams -> IO () testUpdateMultipleUserPrefs = testChat3 aliceProfile bobProfile cathProfile $ diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index fa853c2df9..6e093f232b 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -94,7 +94,7 @@ it :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expe it name test = Hspec.it name $ \tmp -> timeout t (test tmp) >>= maybe (error "test timed out") pure where - t = 90 * 1000000 + t = 180 * 1000000 xit' :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expectation)) xit' = if os == "linux" then xit else it @@ -350,7 +350,7 @@ itemId i = show $ length chatFeatures + i (@@@) :: HasCallStack => TestCC -> [(String, String)] -> Expectation (@@@) cc res = do - threadDelay 100000 + threadDelay 500000 getChats mapChats cc res mapChats :: [(String, String, Maybe ConnStatus)] -> [(String, String)]