diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 1dbf1adcb9..1db2960fc2 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -659,7 +659,6 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag ct' = ct {activeConn = Just conn'} :: Contact -- [incognito] print incognito profile used for this contact incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) - toView $ CEvtContactConnected user ct' (fmap fromLocalProfile incognitoProfile) let createE2EItem = createInternalChatItem user (CDDirectRcv ct') (CIRcvDirectE2EEInfo $ e2eInfoEncrypted $ Just pqEnc) Nothing -- TODO [short links] get contact request by contactRequestId, check encryption (UserContactRequest.pqSupport)? when (directOrUsed ct') $ case (preparedContact ct', contactRequestId' ct') of @@ -674,6 +673,7 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag withStore' (\db -> getContactRequest' db user connReqId) >>= \case Just UserContactRequest {pqSupport} | CR.pqSupportToEnc pqSupport == pqEnc -> pure () _ -> createE2EItem + toView $ CEvtContactConnected user ct' (fmap fromLocalProfile incognitoProfile) when (contactConnInitiated conn') $ do probeMatchingMembers ct' (contactConnIncognito ct') withStore' $ \db -> resetContactConnInitiated db user conn' @@ -884,7 +884,6 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag pure gInfo {membership = membership {memberStatus = GSMemConnected}} else pure gInfo pure (m {memberStatus = GSMemConnected}, gInfo') - toView $ CEvtUserJoinedGroup user gInfo' m' when (isRelay membership) $ do cc <- ask atomically $ channelProfileUpdated cc groupId groupProfile @@ -898,10 +897,14 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag let prepared = preparedGroup gInfo'' unless (isJust prepared) $ createGroupFeatureItems user cd CIRcvGroupFeature gInfo'' memberConnectedChatItem gInfo'' scopeInfo m'' + toView $ CEvtUserJoinedGroup user gInfo' m' let welcomeMsgId_ = (\PreparedGroup {welcomeSharedMsgId = mId} -> mId) <$> prepared unless (memberPending membership || isJust welcomeMsgId_) $ maybeCreateGroupDescrLocal gInfo'' m'' ) - (memberConnectedChatItem gInfo'' scopeInfo m'') + ( do + memberConnectedChatItem gInfo'' scopeInfo m'' + toView $ CEvtUserJoinedGroup user gInfo' m' + ) where firstConnectedHost | useRelays' gInfo = do diff --git a/tests/Bots/BadgeService/WebTests.hs b/tests/Bots/BadgeService/WebTests.hs index 633ad14564..439abf3b07 100644 --- a/tests/Bots/BadgeService/WebTests.hs +++ b/tests/Bots/BadgeService/WebTests.hs @@ -25,7 +25,7 @@ import Bots.BadgeService.FakeStripe (FakeStripe (..), fakeIntentStatus, setInten import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.Async (async, wait) import qualified Control.Concurrent.Async as Async -import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) +import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar, withMVar) import Control.Concurrent.STM (atomically, modifyTVar', readTVarIO) import qualified Control.Exception as E import Control.Monad (forM_, join, replicateM, replicateM_, void, when) @@ -2485,9 +2485,13 @@ seedPastWindow st i providerRef provider = do passListing :: IORef StubState -> PollerEnv -> IO () passListing ref poller = runOnePass poller >> clearCalls ref +stderrCaptureLock :: MVar () +stderrCaptureLock = unsafePerformIO $ newMVar () +{-# NOINLINE stderrCaptureLock #-} + -- hDuplicateTo changes stderr's buffering, so put the original setting back. capturingStderr :: IO () -> IO Text -capturingStderr action = do +capturingStderr action = withMVar stderrCaptureLock $ \_ -> do createDirectoryIfMissing True "tests/tmp" withTempDirectory "tests/tmp" "badge-stderr" $ \dir -> do let path = dir "stderr.log" diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 9943443a3d..268b3a8fb9 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -1362,7 +1362,7 @@ testNegotiateCall = threadDelay 100000 bob #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(0, "incoming call: ended")]) alice <## "call with bob ended" - alice #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(1, "outgoing call: ended")]) + (alice ##> "/_get chat @2 count=100" >> callChat <$> getTermLine alice) `shouldEventuallyReturn` (chatFeatures <> [(1, "outgoing call: ended")]) where callChat = map (fmap noDuration) . chat noDuration s = case words s of diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index beb6dda2a0..47a8b02e34 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -3322,7 +3322,7 @@ testGroupLinkMemberRole = bob <## "#team: you joined the group" ] - threadDelay 250000 + getProfileShortDescrByName bob "alice" `shouldEventuallyReturn` Just "Alice" alice ##> "/ms team" alice @@ -3492,10 +3492,7 @@ testGroupLinkHostProfileReceived = bob <## "#team: you joined the group" ] - threadDelay 250000 - - aliceImage <- getProfilePictureByName bob "alice" - aliceImage `shouldBe` Just profileImage + getProfilePictureByName bob "alice" `shouldEventuallyReturn` Just profileImage testGroupLinkExistingContactMerged :: HasCallStack => TestParams -> IO () testGroupLinkExistingContactMerged = diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index d645a35d44..3a625f2641 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -1282,11 +1282,8 @@ testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice bob <## "contact address: connecting, allowed to reconnect" biz <## "#bob (Bob): accepting business address request..." bob <## "#biz: joining the group..." - -- the next command can be prone to race conditions - bob ##> ("/_connect plan 1 " <> cLink) - bob <## "business address: connecting to business #biz" + checkBusinessPlanWhileJoining bob cLink biz <## "#bob: bob_1 joined the group" - bob <## "#biz: you joined the group" biz #> "#bob hi" bob <# "#biz biz_1> hi" bob #> "#biz hello" @@ -1320,6 +1317,19 @@ testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice (alice <# "#bob bob_1> hey there") (biz <# "#bob bob_1> hey there") +checkBusinessPlanWhileJoining :: HasCallStack => TestCC -> String -> IO () +checkBusinessPlanWhileJoining cc link = do + let cmd = "/_connect plan 1 " <> link + joined = "#biz: you joined the group" + known = "business address: known business #biz" + cc `send` cmd + ls <- replicateM 3 $ getTermLine cc + if known `elem` ls + then do + l <- getTermLine cc + (l : ls) `shouldMatchList` [cmd, joined, known, "use #biz to send messages"] + else ls `shouldMatchList` [cmd, joined, "business address: connecting to business #biz"] + testBusinessUpdateProfiles :: HasCallStack => TestParams -> IO () testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile cathProfile $ \biz alice bob cath -> do @@ -3433,8 +3443,9 @@ testShortLinkInvitationImage = testChat2 aliceProfile bobProfile test bob <##> alice testShortLinkInvitationConnectRetry :: HasCallStack => TestParams -> IO () -testShortLinkInvitationConnectRetry ps = testChatOpts2 opts' aliceProfile bobProfile test ps +testShortLinkInvitationConnectRetry ps = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile test ps where + cfg' = testCfg {agentConfig = testAgentCfg {persistErrorInterval = 0}} test alice bob = do shortLink <- withSmpServer' serverCfg' $ do alice ##> "/_connect 1" @@ -3734,11 +3745,8 @@ testShortLinkAddressPrepareBusiness = testChat3 businessProfile aliceProfile {fu bob <## "#biz: connection started" biz <## "#bob (Bob): accepting business address request..." bob <## "#biz: joining the group..." - -- the next command can be prone to race conditions - bob ##> ("/_connect plan 1 " <> shortLink) - bob <## "business address: connecting to business #biz" + checkBusinessPlanWhileJoining bob shortLink biz <## "#bob: bob_1 joined the group" - bob <## "#biz: you joined the group" biz #> "#bob hi" bob <# "#biz biz_1> hi" bob #> "#biz hello" diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index a7687a8dfd..59e4bc37dc 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -13,7 +13,7 @@ import ChatTests.DBUtils import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_, mapConcurrently_) import Control.Concurrent.STM -import Control.Monad (unless, when) +import Control.Monad (join, unless, when) import Control.Monad.Except (runExceptT) import Data.ByteString (ByteString) import qualified Data.ByteString.Base64 as B64 @@ -679,11 +679,24 @@ createCCNoteFolder cc = withCCUser cc $ \user -> runExceptT (createNoteFolder db user) >>= either (fail . show) pure +shouldEventuallyReturn :: (HasCallStack, Eq a, Show a) => IO a -> a -> Expectation +shouldEventuallyReturn action expected = go (200 :: Int) + where + go n = do + r <- action + if r == expected || n == 0 + then r `shouldBe` expected + else threadDelay 100000 >> go (n - 1) + getProfilePictureByName :: TestCC -> String -> IO (Maybe String) getProfilePictureByName cc displayName = withTransaction (chatStore $ chatController cc) $ \db -> - maybeFirstRow fromOnly $ - DB.query db "SELECT image FROM contact_profiles WHERE display_name = ? LIMIT 1" (Only displayName) + join <$> maybeFirstRow fromOnly (DB.query db "SELECT image FROM contact_profiles WHERE display_name = ? LIMIT 1" (Only displayName)) + +getProfileShortDescrByName :: TestCC -> String -> IO (Maybe String) +getProfileShortDescrByName cc displayName = + withTransaction (chatStore $ chatController cc) $ \db -> + join <$> maybeFirstRow fromOnly (DB.query db "SELECT short_descr FROM contact_profiles WHERE display_name = ? LIMIT 1" (Only displayName)) pqSndForContact :: TestCC -> ContactId -> IO PQEncryption pqSndForContact = pqForContact_ pqSndEnabled PQEncOff