From f0467aee0010f4e2ccd81b0c540e5e324edb1ceb Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sun, 4 Jan 2026 19:04:32 +0000 Subject: [PATCH] directory service: fix queries (#6539) * fix directory service queries * fix * reduce postgres pool size to 1 * stabilize postgres client tests, remove slow handshake tests * update simplexmq * fix test * test delay --- .../src/Directory/Store.hs | 12 +-- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat/Controller.hs | 32 +++--- src/Simplex/Chat/Library/Commands.hs | 4 +- src/Simplex/Chat/Options/Postgres.hs | 4 +- tests/ChatClient.hs | 20 ++-- tests/ChatTests/Direct.hs | 99 ++++++------------- tests/ChatTests/Files.hs | 4 +- tests/ChatTests/Groups.hs | 98 +++++------------- tests/ChatTests/Profiles.hs | 97 +++++------------- 11 files changed, 117 insertions(+), 257 deletions(-) diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs index b78b446821..b5f7220724 100644 --- a/apps/simplex-directory-service/src/Directory/Store.hs +++ b/apps/simplex-directory-service/src/Directory/Store.hs @@ -351,11 +351,11 @@ searchListedGroups cc user@User {userId, userContactId} searchType lastGroup_ pa pure (gs, n) Just gId -> do gs <- groups $ DB.query db (listedGroupQuery <> " AND r.group_id > ? " <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, gId, pageSize) - n <- count $ DB.query db (countQuery' <> " AND r.group_id > ? " <> orderBy) (GRSActive, gId) + n <- count $ DB.query db (countQuery' <> " AND r.group_id > ?") (GRSActive, gId) pure (gs, n) where countQuery' = countQuery <> " WHERE r.group_reg_status = ? " - orderBy = " ORDER BY g.summary_current_members_count DESC " + orderBy = " ORDER BY g.summary_current_members_count DESC, r.group_reg_id ASC " STRecent -> case lastGroup_ of Nothing -> do gs <- groups $ DB.query db (listedGroupQuery <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, pageSize) @@ -363,11 +363,11 @@ searchListedGroups cc user@User {userId, userContactId} searchType lastGroup_ pa pure (gs, n) Just gId -> do gs <- groups $ DB.query db (listedGroupQuery <> " AND r.group_id > ? " <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, gId, pageSize) - n <- count $ DB.query db (countQuery' <> " AND r.group_id > ? " <> orderBy) (GRSActive, gId) + n <- count $ DB.query db (countQuery' <> " AND r.group_id > ?") (GRSActive, gId) pure (gs, n) where countQuery' = countQuery <> " WHERE r.group_reg_status = ? " - orderBy = " ORDER BY r.created_at DESC " + orderBy = " ORDER BY r.created_at DESC, r.group_reg_id ASC " STSearch search -> case lastGroup_ of Nothing -> do gs <- groups $ DB.query db (listedGroupQuery <> searchCond <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, s, s, s, s, pageSize) @@ -375,12 +375,12 @@ searchListedGroups cc user@User {userId, userContactId} searchType lastGroup_ pa pure (gs, n) Just gId -> do gs <- groups $ DB.query db (listedGroupQuery <> " AND r.group_id > ? " <> searchCond <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, gId, s, s, s, s, pageSize) - n <- count $ DB.query db (countQuery' <> " AND r.group_id > ? " <> searchCond <> orderBy) (GRSActive, gId, s, s, s, s) + n <- count $ DB.query db (countQuery' <> " AND r.group_id > ? " <> searchCond) (GRSActive, gId, s, s, s, s) pure (gs, n) where s = T.toLower search countQuery' = countQuery <> " JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id WHERE r.group_reg_status = ? " - orderBy = " ORDER BY g.summary_current_members_count DESC " + orderBy = " ORDER BY g.summary_current_members_count DESC, r.group_reg_id ASC " where groups = (map (toGroupInfoReg (vr cc) user) <$>) count = maybeFirstRow' 0 fromOnly diff --git a/cabal.project b/cabal.project index e9842b1138..e5d7464ece 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 5f73d1e629a8807f1b9d94f8b411d6480a0a59fb + tag: a7b43b1a3e204759d4b7ad60928fa897b1600654 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 3cfc2a05af..16454f63d1 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."5f73d1e629a8807f1b9d94f8b411d6480a0a59fb" = "1w5mxw9rwiiiqphbg2rdyp4cvv9hz2l64f7fpfhncw6gncfx7ggw"; + "https://github.com/simplex-chat/simplexmq.git"."a7b43b1a3e204759d4b7ad60928fa897b1600654" = "169vjn5gyw42cmak6kwyl27zm57il43khnlj40zjwjw7cldkzdzi"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 34ad95b800..5754419933 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -96,7 +96,12 @@ import Simplex.RemoteControl.Types import System.IO (Handle) import System.Mem.Weak (Weak) import UnliftIO.STM -#if !defined(dbPostgres) + +#if defined(dbPostgres) +import qualified Database.PostgreSQL.Simple as PSQL + +type SQLError = PSQL.SqlError +#else import Database.SQLite.Simple (SQLError) import qualified Database.SQLite.Simple as SQL import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..)) @@ -1542,25 +1547,24 @@ withFastStore = withStorePriority True withStorePriority :: Bool -> (DB.Connection -> ExceptT StoreError IO a) -> CM a withStorePriority priority action = do ChatController {chatStore} <- ask - liftIOEither $ withTransactionPriority chatStore priority (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors + liftIOEither $ withTransactionPriority chatStore priority (runExceptT . withExceptT ChatErrorStore . action) `E.catch` handleDBErrors withStoreBatch :: Traversable t => (DB.Connection -> t (IO (Either ChatError a))) -> CM' (t (Either ChatError a)) withStoreBatch actions = do ChatController {chatStore} <- ask - liftIO $ withTransaction chatStore $ mapM (`E.catches` handleDBErrors) . actions + liftIO $ withTransaction chatStore $ mapM (`E.catch` handleDBErrors) . actions --- TODO [postgres] postgres specific error handling -handleDBErrors :: [E.Handler (Either ChatError a)] -handleDBErrors = -#if !defined(dbPostgres) - ( E.Handler $ \(e :: SQLError) -> - let se = SQL.sqlError e - busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked - in pure . Left . ChatErrorStore $ if busy then SEDBBusyError $ show se else SEDBException $ show e - ) : +handleDBErrors :: E.SomeException -> IO (Either ChatError a) +handleDBErrors e = pure $ Left $ ChatErrorStore $ case E.fromException e of + Just (e' :: SQLError) -> +#if defined(dbPostgres) + SEDBException $ show e' +#else + let se = SQL.sqlError e' + busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked + in (if busy then SEDBBusyError else SEDBException) $ show e' #endif - [ E.Handler $ \(E.SomeException e) -> pure . Left . ChatErrorStore . SEDBException $ show e - ] + Nothing -> SEDBException $ show e withStoreBatch' :: Traversable t => (DB.Connection -> t (IO a)) -> CM' (t (Either ChatError a)) withStoreBatch' actions = withStoreBatch $ fmap (fmap Right) . actions diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index fc6a0ea782..675ca03a8a 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -262,7 +262,7 @@ stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, readTVarIO remoteHostSessions >>= mapM_ (cancelRemoteHost False . snd) atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (cancelRemoteCtrl False . snd) disconnectAgentClient smpAgent - readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2) + readTVarIO s >>= mapM_ (\(a1, a2) -> forkIO $ uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2) closeFiles sndFiles closeFiles rcvFiles atomically $ do @@ -1805,7 +1805,7 @@ processChatCommand vr nm = \case conn <- withFastStore $ \db -> getPendingContactConnection db userId connId let PendingContactConnection {pccConnStatus, connLinkInv} = conn case (pccConnStatus, connLinkInv) of - (ConnNew, Just _ссLink) -> do + (ConnNew, Just _ccLink) -> do newUser <- privateGetUser newUserId conn' <- recreateConn user conn newUser pure $ CRConnectionUserChanged user conn conn' newUser diff --git a/src/Simplex/Chat/Options/Postgres.hs b/src/Simplex/Chat/Options/Postgres.hs index c74ae37750..ab7414566c 100644 --- a/src/Simplex/Chat/Options/Postgres.hs +++ b/src/Simplex/Chat/Options/Postgres.hs @@ -42,7 +42,7 @@ chatDbOptsP _appDir defaultDbName = do ( long "pool-size" <> metavar "DB_POOL_SIZE" <> help "Database connection pool size" - <> value 10 + <> value 1 <> showDefault ) dbCreateSchema <- @@ -84,7 +84,7 @@ mobileDbOpts schemaPrefix connstr = do ChatDbOpts { dbConnstr, dbSchemaPrefix, - dbPoolSize = 10, + dbPoolSize = 1, dbCreateSchema = True } diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index d0b186dd94..e258f3dccc 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -131,7 +131,7 @@ testCoreOpts = -- dbSchemaPrefix is not used in tests (except bot tests where it's redefined), -- instead different schema prefix is passed per client so that single test database is used dbSchemaPrefix = "", - dbPoolSize = 3, + dbPoolSize = 1, dbCreateSchema = True #else { dbFilePrefix = "./simplex_v1", -- dbFilePrefix is not used in tests (except bot tests where it's redefined) @@ -184,16 +184,11 @@ aCfg = (agentConfig defaultChatConfig) {tbqSize = 16} testAgentCfg :: AgentConfig testAgentCfg = aCfg - { reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000} - } - -testAgentCfgSlow :: AgentConfig -testAgentCfgSlow = - testAgentCfg - { smpClientVRange = mkVersionRange (Version 1) srvHostnamesSMPClientVersion, -- v2 - smpAgentVRange = mkVersionRange duplexHandshakeSMPAgentVersion pqdrSMPAgentVersion, -- v5 - smpCfg = (smpCfg testAgentCfg) {serverVRange = mkVersionRange minClientSMPRelayVersion sendingProxySMPVersion} -- v8 + { reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000}, + messageRetryInterval = RetryInterval2 {riFast = riFast {initialInterval = 50000}, riSlow = riSlow {initialInterval = 50000}} } + where + RetryInterval2 {riFast, riSlow} = messageRetryInterval aCfg testAgentCfgNoShortLinks :: AgentConfig testAgentCfgNoShortLinks = @@ -213,9 +208,6 @@ testCfg = confirmMigrations = MCYesUp } -testCfgSlow :: ChatConfig -testCfgSlow = testCfg {agentConfig = testAgentCfgSlow} - testCfgNoShortLinks :: ChatConfig testCfgNoShortLinks = testCfg {agentConfig = testAgentCfgNoShortLinks} @@ -522,7 +514,7 @@ smpServerCfg :: ServerConfig STMMsgStore smpServerCfg = ServerConfig { transports = [(serverPort, transport @TLS, False)], - tbqSize = 1, + tbqSize = 4, msgQueueQuota = 16, maxJournalMsgCount = 24, maxJournalStateLines = 4, diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 1b93013258..a56ad6d4e3 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -94,22 +94,9 @@ chatDirectTests = do describe "operators and usage conditions" $ do it "get and enable operators, accept conditions" testOperators describe "async connection handshake" $ do - describe "connect when initiating client goes offline" $ do - it "curr" $ testAsyncInitiatingOffline True testCfg testCfg - it "v5" $ testAsyncInitiatingOffline False testCfgSlow testCfgSlow - it "v5/curr" $ testAsyncInitiatingOffline False testCfgSlow testCfg - it "curr/v5" $ testAsyncInitiatingOffline True testCfg testCfgSlow - describe "connect when accepting client goes offline" $ do - it "curr" $ testAsyncAcceptingOffline True testCfg testCfg - it "v5" $ testAsyncAcceptingOffline False testCfgSlow testCfgSlow - it "v5/curr" $ testAsyncAcceptingOffline False testCfgSlow testCfg - it "curr/v5" $ testAsyncAcceptingOffline True testCfg testCfgSlow - describe "connect, fully asynchronous (when clients are never simultaneously online)" $ do - it "curr" testFullAsyncFast - -- fails in CI - xit'' "v5" $ testFullAsyncSlow False testCfgSlow testCfgSlow - xit'' "v5/curr" $ testFullAsyncSlow False testCfgSlow testCfg - xit'' "curr/v5" $ testFullAsyncSlow True testCfg testCfgSlow + it "connect when initiating client goes offline" $ testAsyncInitiatingOffline True + it "connect when accepting client goes offline" $ testAsyncAcceptingOffline True + it "connect, fully asynchronous (when clients are never simultaneously online)" $ testFullAsyncFast describe "webrtc calls api" $ do it "negotiate call" testNegotiateCall #if !defined(dbPostgres) @@ -1241,33 +1228,33 @@ testOperators = where opts' = testOpts {coreOptions = testCoreOpts {smpServers = [], xftpServers = []}} -testAsyncInitiatingOffline :: HasCallStack => Bool -> ChatConfig -> ChatConfig -> TestParams -> IO () -testAsyncInitiatingOffline withShortLink aliceCfg bobCfg ps = do - inv <- withNewTestChatCfg ps aliceCfg "alice" aliceProfile $ \alice -> do +testAsyncInitiatingOffline :: HasCallStack => Bool -> TestParams -> IO () +testAsyncInitiatingOffline withShortLink ps = do + inv <- withNewTestChat ps "alice" aliceProfile $ \alice -> do threadDelay 250000 alice ##> "/c" (if withShortLink then getInvitation else getInvitationNoShortLink) alice - withNewTestChatCfg ps bobCfg "bob" bobProfile $ \bob -> do + withNewTestChat ps "bob" bobProfile $ \bob -> do threadDelay 250000 bob ##> ("/c " <> inv) bob <## "confirmation sent!" - withTestChatCfg ps aliceCfg "alice" $ \alice -> do + withTestChat ps "alice" $ \alice -> do alice <## "subscribed 1 connections on server localhost" concurrently_ (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") -testAsyncAcceptingOffline :: HasCallStack => Bool -> ChatConfig -> ChatConfig -> TestParams -> IO () -testAsyncAcceptingOffline withShortLink aliceCfg bobCfg ps = do - inv <- withNewTestChatCfg ps aliceCfg "alice" aliceProfile $ \alice -> do +testAsyncAcceptingOffline :: HasCallStack => Bool -> TestParams -> IO () +testAsyncAcceptingOffline withShortLink ps = do + inv <- withNewTestChat ps "alice" aliceProfile $ \alice -> do alice ##> "/c" (if withShortLink then getInvitation else getInvitationNoShortLink) alice - withNewTestChatCfg ps bobCfg "bob" bobProfile $ \bob -> do + withNewTestChat ps "bob" bobProfile $ \bob -> do threadDelay 250000 bob ##> ("/c " <> inv) bob <## "confirmation sent!" - withTestChatCfg ps aliceCfg "alice" $ \alice -> do - withTestChatCfg ps bobCfg "bob" $ \bob -> do + withTestChat ps "alice" $ \alice -> do + withTestChat ps "bob" $ \bob -> do alice <## "subscribed 1 connections on server localhost" bob <## "subscribed 1 connections on server localhost" concurrently_ @@ -1292,30 +1279,6 @@ testFullAsyncFast ps = do bob <## "subscribed 1 connections on server localhost" bob <## "alice (Alice): contact is connected" -testFullAsyncSlow :: HasCallStack => Bool -> ChatConfig -> ChatConfig -> TestParams -> IO () -testFullAsyncSlow withShortLink aliceCfg bobCfg ps = do - inv <- withNewTestChatCfg ps aliceCfg "alice" aliceProfile $ \alice -> do - threadDelay 250000 - alice ##> "/c" - (if withShortLink then getInvitation else getInvitationNoShortLink) alice - withNewTestChatCfg ps bobCfg "bob" bobProfile $ \bob -> do - threadDelay 250000 - bob ##> ("/c " <> inv) - bob <## "confirmation sent!" - withAlice $ \alice -> - alice <## "subscribed 1 connections on server localhost" - withBob $ \bob -> - bob <## "subscribed 1 connections on server localhost" - withAlice $ \alice -> do - alice <## "subscribed 1 connections on server localhost" - alice <## "bob (Bob): contact is connected" - withBob $ \bob -> do - bob <## "subscribed 1 connections on server localhost" - bob <## "alice (Alice): contact is connected" - where - withAlice = withTestChatCfg ps aliceCfg "alice" - withBob = withTestChatCfg ps aliceCfg "bob" - testCallType :: CallType testCallType = CallType {media = CMVideo, capabilities = CallCapabilities {encryption = True}} @@ -1341,7 +1304,7 @@ repeatM_ n a = forM_ [1 .. n] $ const a testNegotiateCall :: HasCallStack => TestParams -> IO () testNegotiateCall = - testChat2 aliceProfile bobProfile $ \alice bob -> do + withTestOutput $ testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob -- just for testing db query alice ##> "/_call get" @@ -2200,7 +2163,7 @@ testUsersDifferentCIExpirationTTL ps = do showActiveUser alice "alisa" alice #$> ("/_get chat @6 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")]) - threadDelay 2000000 + threadDelay 2100000 alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner")]) where @@ -2419,7 +2382,7 @@ testDisableCIExpirationOnlyForOneUser ps = do cfg = testCfg {initialCleanupManagerDelay = 0, cleanupManagerStepDelay = 0, ciExpirationInterval = 500000} testUsersTimedMessages :: HasCallStack => TestParams -> IO () -testUsersTimedMessages ps = do +testUsersTimedMessages ps' = do withNewTestChat ps "bob" bobProfile $ \bob -> do withNewTestChat ps "alice" aliceProfile $ \alice -> do connectUsers alice bob @@ -2462,10 +2425,8 @@ testUsersTimedMessages ps = do threadDelay 1000000 - alice <## "[user: alice] timed message deleted: alice 1" - alice <## "[user: alice] timed message deleted: alice 2" - bob <## "timed message deleted: alice 1" - bob <## "timed message deleted: alice 2" + 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"] alice ##> "/user alice" showActiveUser alice "alice (Alice)" @@ -2477,10 +2438,8 @@ testUsersTimedMessages ps = do threadDelay 1000000 - alice <## "timed message deleted: alisa 1" - alice <## "timed message deleted: alisa 2" - bob <## "timed message deleted: alisa 1" - bob <## "timed message deleted: alisa 2" + alice <### ["timed message deleted: alisa 1", "timed message deleted: alisa 2"] + bob <### ["timed message deleted: alisa 1", "timed message deleted: alisa 2"] alice ##> "/user" showActiveUser alice "alisa" @@ -2519,10 +2478,8 @@ testUsersTimedMessages ps = do -- messages are deleted after restart threadDelay 1000000 - alice <## "[user: alice] timed message deleted: alice 3" - alice <## "[user: alice] timed message deleted: alice 4" - bob <## "timed message deleted: alice 3" - bob <## "timed message deleted: alice 4" + 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"] alice ##> "/user alice" showActiveUser alice "alice (Alice)" @@ -2534,15 +2491,14 @@ testUsersTimedMessages ps = do threadDelay 1000000 - alice <## "timed message deleted: alisa 3" - alice <## "timed message deleted: alisa 4" - bob <## "timed message deleted: alisa 3" - bob <## "timed message deleted: alisa 4" + alice <### ["timed message deleted: alisa 3", "timed message deleted: alisa 4"] + bob <### ["timed message deleted: alisa 3", "timed message deleted: alisa 4"] alice ##> "/user" showActiveUser alice "alisa" alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner")]) where + ps = ps' {printOutput = True} :: TestParams configureTimedMessages :: HasCallStack => TestCC -> TestCC -> String -> String -> IO () configureTimedMessages alice bob bobId ttl = do aliceName <- userName alice @@ -2699,7 +2655,7 @@ testUserPrivacy = testSetChatItemTTL :: HasCallStack => TestParams -> IO () testSetChatItemTTL = testChat2 aliceProfile bobProfile $ - \alice bob -> do + \alice bob -> withXFTPServer $ do connectUsers alice bob alice #> "@bob 1" bob <# "alice> 1" @@ -2713,6 +2669,7 @@ testSetChatItemTTL = alice <## "use /fc 1 to cancel sending" bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" 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 alice #> "@bob 3" diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 2de9d7ffe5..a71e7ae173 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -761,7 +761,9 @@ testXFTPDeleteUploadedFileGroup = alice ##> "/fc 1" concurrentlyN_ - [ alice <## "cancelled sending file 1 (test.pdf) to bob, cath", + [ do + recipients <- dropStrPrefix "cancelled sending file 1 (test.pdf) to " <$> getTermLine alice + recipients == "bob, cath" || recipients == "cath, bob" `shouldBe` True, cath <## "alice cancelled sending file 1 (test.pdf)" ] diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index aa9a48f279..166528e69c 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -94,10 +94,7 @@ chatGroupTests = do describe "batch send messages" $ do it "send multiple messages api" testSendMulti it "send multiple timed messages" testSendMultiTimed -#if !defined(dbPostgres) - -- TODO [postgres] this test hangs with PostgreSQL it "send multiple messages (many chat batches)" testSendMultiManyBatches -#endif it "shared message body is reused" testSharedMessageBody it "shared batch body is reused" testSharedBatchBody describe "async group connections" $ do @@ -124,7 +121,6 @@ chatGroupTests = do it "ok to connect; known group" testPlanGroupLinkKnown it "own group link" testPlanGroupLinkOwn it "group link without contact - connecting" testPlanGroupLinkConnecting - it "group link without contact - connecting (slow handshake)" testPlanGroupLinkConnectingSlow it "re-join existing group after leaving" testPlanGroupLinkLeaveRejoin #if !defined(dbPostgres) -- TODO [postgres] restore from outdated db backup (same as in agent) @@ -2044,20 +2040,17 @@ testSendMultiManyBatches = (bob <# ("#team alice> message " <> show i)) (cath <# ("#team alice> message " <> show i)) - aliceItemsCount <- withCCTransaction alice $ \db -> - DB.query db "SELECT count(1) FROM chat_items WHERE chat_item_id > ?" (Only msgIdAlice) :: IO [[Int]] - aliceItemsCount `shouldBe` [[300]] - - bobItemsCount <- withCCTransaction bob $ \db -> - DB.query db "SELECT count(1) FROM chat_items WHERE chat_item_id > ?" (Only msgIdBob) :: IO [[Int]] - bobItemsCount `shouldBe` [[300]] - - cathItemsCount <- withCCTransaction cath $ \db -> - DB.query db "SELECT count(1) FROM chat_items WHERE chat_item_id > ?" (Only msgIdCath) :: IO [[Int]] - cathItemsCount `shouldBe` [[300]] + checkItemCount alice msgIdAlice 300 + checkItemCount bob msgIdBob 300 + checkItemCount cath msgIdCath 300 + where + checkItemCount c msgId n = do + itemsCount <- withCCTransaction c $ \db -> + DB.query db "SELECT count(1) FROM chat_items WHERE chat_item_id > ?" (Only msgId) :: IO [[Int]] + itemsCount `shouldBe` [[n]] testSharedMessageBody :: HasCallStack => TestParams -> IO () -testSharedMessageBody ps = +testSharedMessageBody ps' = withNewTestChatOpts ps opts' "alice" aliceProfile $ \alice -> do withSmpServer' serverCfg' $ withNewTestChatOpts ps opts' "bob" bobProfile $ \bob -> @@ -2066,9 +2059,7 @@ testSharedMessageBody ps = alice <## "disconnected 4 connections on server localhost" alice #> "#team hello" - bodiesCount1 <- withCCAgentTransaction alice $ \db -> - DB.query_ db "SELECT count(1) FROM snd_message_bodies" :: IO [[Int]] - bodiesCount1 `shouldBe` [[1]] + checkMsgBodyCount alice 1 withSmpServer' serverCfg' $ withTestChatOpts ps opts' "bob" $ \bob -> @@ -2080,12 +2071,15 @@ testSharedMessageBody ps = ] bob <# "#team alice> hello" cath <# "#team alice> hello" - bodiesCount2 <- withCCAgentTransaction alice $ \db -> - DB.query_ db "SELECT count(1) FROM snd_message_bodies" :: IO [[Int]] - bodiesCount2 `shouldBe` [[0]] +-- because of PostgreSQL concurrency deleteSndMsgDelivery fails to delete message body +#if !defined(dbPostgres) + threadDelay 500000 + checkMsgBodyCount alice 0 +#endif alice <## "disconnected 4 connections on server localhost" where + ps = ps' {printOutput = True} :: TestParams tmp = tmpPath ps serverCfg' = smpServerCfg @@ -2100,6 +2094,12 @@ testSharedMessageBody ps = } } +checkMsgBodyCount :: TestCC -> Int -> IO () +checkMsgBodyCount c n = do + bodiesCount <- withCCAgentTransaction c $ \db -> + DB.query_ db "SELECT count(1) FROM snd_message_bodies" + bodiesCount `shouldBe` [[n]] + testSharedBatchBody :: HasCallStack => TestParams -> IO () testSharedBatchBody ps = withNewTestChatOpts ps opts' "alice" aliceProfile $ \alice -> do @@ -2116,9 +2116,7 @@ testSharedBatchBody ps = _ <- getTermLine alice alice <## "300 messages sent" - bodiesCount1 <- withCCAgentTransaction alice $ \db -> - DB.query_ db "SELECT count(1) FROM snd_message_bodies" :: IO [[Int]] - bodiesCount1 `shouldBe` [[3]] + checkMsgBodyCount alice 3 withSmpServer' serverCfg' $ withTestChatOpts ps opts' "bob" $ \bob -> @@ -2132,9 +2130,10 @@ testSharedBatchBody ps = concurrently_ (bob <# ("#team alice> message " <> show i)) (cath <# ("#team alice> message " <> show i)) - bodiesCount2 <- withCCAgentTransaction alice $ \db -> - DB.query_ db "SELECT count(1) FROM snd_message_bodies" :: IO [[Int]] - bodiesCount2 `shouldBe` [[0]] +-- because of PostgreSQL concurrency deleteSndMsgDelivery fails to delete message body +#if !defined(dbPostgres) + checkMsgBodyCount alice 0 +#endif alice <## "disconnected 4 connections on server localhost" where @@ -3611,49 +3610,6 @@ testPlanGroupLinkConnecting ps = do bob <## "group link: known group #team" bob <## "use #team to send messages" -testPlanGroupLinkConnectingSlow :: HasCallStack => TestParams -> IO () -testPlanGroupLinkConnectingSlow ps = do - gLink <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do - threadDelay 100000 - alice ##> "/g team" - alice <## "group #team is created" - alice <## "to add members use /a team or /create link #team" - alice ##> "/create link #team" - getGroupLinkNoShortLink alice "team" GRMember True - withNewTestChatCfg ps testCfgSlow "bob" bobProfile $ \bob -> do - threadDelay 100000 - - bob ##> ("/c " <> gLink) - bob <## "connection request sent!" - - bob ##> ("/_connect plan 1 " <> gLink) - bob <## "group link: connecting, allowed to reconnect" - - let gLinkSchema2 = linkAnotherSchema gLink - bob ##> ("/_connect plan 1 " <> gLinkSchema2) - bob <## "group link: connecting, allowed to reconnect" - - threadDelay 100000 - withTestChatCfg ps testCfgSlow "alice" $ \alice -> do - alice - <### [ "subscribed 1 connections on server localhost", - "bob (Bob): accepting request to join group #team..." - ] - withTestChatCfg ps testCfgSlow "bob" $ \bob -> do - threadDelay 500000 - bob <## "subscribed 1 connections on server localhost" - bob <## "#team: joining the group..." - - bob ##> ("/_connect plan 1 " <> gLink) - bob <## "group link: connecting to group #team" - - let gLinkSchema2 = linkAnotherSchema gLink - bob ##> ("/_connect plan 1 " <> gLinkSchema2) - bob <## "group link: connecting to group #team" - - bob ##> ("/c " <> gLink) - bob <## "group link: connecting to group #team" - #if !defined(dbPostgres) testGroupMsgDecryptError :: HasCallStack => TestParams -> IO () testGroupMsgDecryptError ps = diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index a1ab8548ed..3fdadc3b64 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -61,7 +61,6 @@ chatProfileTests = do it "contact address ok to connect; known contact" testPlanAddressOkKnown it "own contact address" testPlanAddressOwn it "connecting via contact address" testPlanAddressConnecting - it "connecting via contact address (slow handshake)" testPlanAddressConnectingSlow it "re-connect with deleted contact" testPlanAddressContactDeletedReconnected it "contact via address" testPlanAddressContactViaAddress it "contact via short address" testPlanAddressContactViaShortAddress @@ -72,7 +71,6 @@ chatProfileTests = do it "set connection incognito" testSetConnectionIncognito it "reset connection incognito" testResetConnectionIncognito it "set connection incognito prohibited during negotiation" testSetConnectionIncognitoProhibitedDuringNegotiation - it "set connection incognito prohibited during negotiation (slow handshake)" testSetConnectionIncognitoProhibitedDuringNegotiationSlow it "connection incognito unchanged errors" testConnectionIncognitoUnchangedErrors it "set, reset, set connection incognito" testSetResetSetConnectionIncognito it "join group incognito" testJoinGroupIncognito @@ -1110,46 +1108,6 @@ testPlanAddressConnecting ps = do bob <## "contact address: known contact alice" bob <## "use @alice to send messages" -testPlanAddressConnectingSlow :: HasCallStack => TestParams -> IO () -testPlanAddressConnectingSlow ps = do - cLink <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do - alice ##> "/ad" - getContactLinkNoShortLink alice True - withNewTestChatCfg ps testCfgSlow "bob" bobProfile $ \bob -> do - threadDelay 100000 - - bob ##> ("/c " <> cLink) - bob <## "connection request sent!" - - bob ##> ("/_connect plan 1 " <> cLink) - bob <## "contact address: connecting, allowed to reconnect" - - let cLinkSchema2 = linkAnotherSchema cLink - bob ##> ("/_connect plan 1 " <> cLinkSchema2) - bob <## "contact address: connecting, allowed to reconnect" - - threadDelay 100000 - withTestChatCfg ps testCfgSlow "alice" $ \alice -> do - alice <## "subscribed 1 connections on server localhost" - alice <## "bob (Bob) wants to connect to you!" - alice <## "to accept: /ac bob" - alice <## "to reject: /rc bob (the sender will NOT be notified)" - alice ##> "/ac bob" - alice <## "bob (Bob): accepting contact request..." - withTestChatCfg ps testCfgSlow "bob" $ \bob -> do - threadDelay 500000 - bob <## "subscribed 1 connections on server localhost" - bob @@@ [("@alice", "")] - bob ##> ("/_connect plan 1 " <> cLink) - bob <## "contact address: connecting to contact alice" - - let cLinkSchema2 = linkAnotherSchema cLink - bob ##> ("/_connect plan 1 " <> cLinkSchema2) - bob <## "contact address: connecting to contact alice" - - bob ##> ("/c " <> cLink) - bob <## "contact address: connecting to contact alice" - testPlanAddressContactDeletedReconnected :: HasCallStack => TestParams -> IO () testPlanAddressContactDeletedReconnected = testChat2 aliceProfile bobProfile $ @@ -1559,30 +1517,6 @@ testSetConnectionIncognitoProhibitedDuringNegotiation ps = do alice `hasContactProfiles` ["alice", "bob"] bob `hasContactProfiles` ["alice", "bob"] -testSetConnectionIncognitoProhibitedDuringNegotiationSlow :: HasCallStack => TestParams -> IO () -testSetConnectionIncognitoProhibitedDuringNegotiationSlow ps = do - inv <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do - threadDelay 250000 - alice ##> "/connect" - getInvitationNoShortLink alice - withNewTestChatCfg ps testCfgSlow "bob" bobProfile $ \bob -> do - threadDelay 250000 - bob ##> ("/c " <> inv) - bob <## "confirmation sent!" - withTestChatCfg ps testCfgSlow "alice" $ \alice -> do - threadDelay 250000 - alice <## "subscribed 1 connections on server localhost" - alice ##> "/_set incognito :1 on" - alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}" - withTestChatCfg ps testCfgSlow "bob" $ \bob -> do - bob <## "subscribed 1 connections on server localhost" - concurrently_ - (bob <## "alice (Alice): contact is connected") - (alice <## "bob (Bob): contact is connected") - alice <##> bob - alice `hasContactProfiles` ["alice", "bob"] - bob `hasContactProfiles` ["alice", "bob"] - testConnectionIncognitoUnchangedErrors :: HasCallStack => TestParams -> IO () testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $ \alice bob -> do @@ -2022,8 +1956,14 @@ testChangePCCUser = testChat2 aliceProfile bobProfile $ alice ##> "/user alisa" showActiveUser alice "alisa" -- Change connection back to other user +#if defined(dbPostgres) + alice ##> "/_set conn user :2 3" + alice <## "connection 2 changed from user alisa to user alisa2, new link:" +#else + -- connection ID does not change in SQLite because table has no auto-increment alice ##> "/_set conn user :1 3" alice <## "connection 1 changed from user alisa to user alisa2, new link:" +#endif alice <## "" _shortInv <- getTermLine alice alice <## "" @@ -2065,8 +2005,14 @@ testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $ alice ##> "/user alisa" showActiveUser alice "alisa" -- Change connection back to initial user +#if defined(dbPostgres) + alice ##> "/_set conn user :2 1" + alice <## "connection 2 changed from user alisa to user alice, new link:" +#else + -- connection ID does not change in SQLite because table has no auto-increment alice ##> "/_set conn user :1 1" alice <## "connection 1 changed from user alisa to user alice, new link:" +#endif alice <## "" _shortInv <- getTermLine alice alice <## "" @@ -2104,9 +2050,16 @@ testChangePCCUserAndThenIncognito = testChat2 aliceProfile bobProfile $ alice ##> "/user alisa" showActiveUser alice "alisa" -- Change connection to incognito and make sure it's attached to the newly created user profile +#if defined(dbPostgres) + alice ##> "/_set incognito :2 on" + _ <- getTermLine alice + alice <## "connection 2 changed to incognito" +#else + -- connection ID does not change in SQLite because table has no auto-increment alice ##> "/_set incognito :1 on" _ <- getTermLine alice alice <## "connection 1 changed to incognito" +#endif bob ##> ("/connect " <> inv) bob <## "confirmation sent!" alisaIncognito <- getTermLine alice @@ -2485,10 +2438,8 @@ testEnableTimedMessagesContact = 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 <## "timed message deleted: hi" - alice <## "timed message deleted: hey" - bob <## "timed message deleted: hi" - bob <## "timed message deleted: hey" + 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)")]) -- turn off, messages are not disappearing @@ -2580,10 +2531,8 @@ testTimedMessagesEnabledGlobally = 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 <## "timed message deleted: hi" - bob <## "timed message deleted: hi" - alice <## "timed message deleted: hey" - bob <## "timed message deleted: hey" + 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)")])