From 41fd643eb92c528fdbb45e1a9f778e592dad829f Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Tue, 19 Dec 2023 20:35:54 +0400 Subject: [PATCH] refactor, tests --- src/Simplex/Chat.hs | 88 ++++---- tests/ChatTests/Files.hs | 6 - tests/ChatTests/Groups.hs | 442 +++++++++++++++++++++++++++++++++++++- tests/ChatTests/Utils.hs | 7 +- 4 files changed, 485 insertions(+), 58 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index a3ae7b23cb..4d9ea16a21 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -3605,15 +3605,49 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do when (isCompatibleRange (memberChatVRange' m) batchSendVRange) $ do (errs, items) <- withStore' $ \db -> getGroupHistoryLastItems db user gInfo 100 (errs', events) <- collectForwardEvents items [] [] - toView $ CRChatErrors (Just user) (map ChatErrorStore errs <> errs' ) + toView $ CRChatErrors (Just user) (map ChatErrorStore errs <> errs') forM_ (L.nonEmpty events) $ \events' -> sendBatchedDirectMessages conn events' (GroupId groupId) collectForwardEvents :: [CChatItem 'CTGroup] -> [ChatError] -> [ChatMsgEvent 'Json] -> m ([ChatError], [ChatMsgEvent 'Json]) collectForwardEvents [] errs evts = pure (errs, evts) - collectForwardEvents (ci : items) errs evts = - flip catchChatError (\e -> collectForwardEvents items (e : errs) evts) $ case ci of - (CChatItem SMDRcv ChatItem {chatDir = CIGroupRcv sender, meta, content = CIRcvMsgContent mc, quotedItem, file}) -> do + collectForwardEvents (cci : items) errs evts = + flip catchChatError (\e -> collectForwardEvents items (e : errs) evts) $ case cci of + (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file}) -> do fInvDescr_ <- join <$> forM file getRcvFileInvDescr + processContentItem sender ci mc fInvDescr_ + where + getRcvFileInvDescr :: CIFile 'MDRcv -> m (Maybe (FileInvitation, RcvFileDescrText)) + getRcvFileInvDescr CIFile {fileId, fileName, fileSize, fileProtocol, fileStatus} + | fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled = pure Nothing + | otherwise = do + RcvFileDescr {fileDescrText, fileDescrComplete} <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId + if fileDescrComplete + then do + let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} + fInv = xftpFileInvitation fileName fileSize fInvDescr + pure $ Just (fInv, fileDescrText) + else pure Nothing + (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do + fInvDescr_ <- join <$> forM file getSndFileInvDescr + processContentItem membership ci mc fInvDescr_ + where + getSndFileInvDescr :: CIFile 'MDSnd -> m (Maybe (FileInvitation, RcvFileDescrText)) + getSndFileInvDescr CIFile {fileId, fileName, fileSize, fileProtocol, fileStatus} + | fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled = pure Nothing + | otherwise = do + -- can also lookup in extra_xftp_file_descriptions, though it can be empty; + -- would be best if snd file had a single rcv description for all members saved in files table + RcvFileDescr {fileDescrText, fileDescrComplete} <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId + if fileDescrComplete + then do + let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} + fInv = xftpFileInvitation fileName fileSize fInvDescr + pure $ Just (fInv, fileDescrText) + else pure Nothing + _ -> collectForwardEvents items errs evts + where + processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> m ([ChatError], [ChatMsgEvent Json]) + processContentItem sender ChatItem {meta, quotedItem} mc fInvDescr_ = if isNothing fInvDescr_ && not (msgContentHasText mc) then collectForwardEvents items errs evts else do @@ -3630,52 +3664,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do GroupMember {memberId} = sender msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs) collectForwardEvents items errs (msgForwardEvents <> evts) - where - getRcvFileInvDescr :: CIFile 'MDRcv -> m (Maybe (FileInvitation, RcvFileDescrText)) - getRcvFileInvDescr CIFile {fileId, fileName, fileSize, fileProtocol, fileStatus} - | fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled = pure Nothing - | otherwise = do - RcvFileDescr {fileDescrText, fileDescrComplete} <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId - if fileDescrComplete - then do - let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} - fInv = xftpFileInvitation fileName fileSize fInvDescr - pure $ Just (fInv, fileDescrText) - else pure Nothing - (CChatItem SMDSnd ChatItem {chatDir = CIGroupSnd, meta, content = CISndMsgContent mc, quotedItem, file}) -> do - fInvDescr_ <- join <$> forM file getSndFileInvDescr - if isNothing fInvDescr_ && not (msgContentHasText mc) - then collectForwardEvents items errs evts - else do - let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta - quotedItemId_ = quoteItemId =<< quotedItem - fInv_ = fst <$> fInvDescr_ - (msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ fInv_ itemTimed False - let senderVRange = memberChatVRange' membership - xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer} - fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of - (Just fileDescrText, Just msgId) -> prepareFileDescrEvents fileDescrText msgId - _ -> pure [] - let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents - GroupMember {memberId} = membership - msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs) - collectForwardEvents items errs (msgForwardEvents <> evts) - where - getSndFileInvDescr :: CIFile 'MDSnd -> m (Maybe (FileInvitation, RcvFileDescrText)) - getSndFileInvDescr CIFile {fileId, fileName, fileSize, fileProtocol, fileStatus} - | fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled = pure Nothing - | otherwise = do - -- can also lookup in extra_xftp_file_descriptions, though it can be empty; - -- would be best if snd file had a single rcv description for all members saved in files table - RcvFileDescr {fileDescrText, fileDescrComplete} <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId - if fileDescrComplete - then do - let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} - fInv = xftpFileInvitation fileName fileSize fInvDescr - pure $ Just (fInv, fileDescrText) - else pure Nothing - _ -> collectForwardEvents items errs evts - where prepareFileDescrEvents :: RcvFileDescrText -> SharedMsgId -> m [ChatMsgEvent 'Json] prepareFileDescrEvents fileDescrText msgId = do partSize <- asks $ xftpDescrPartSize . config diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 4396a900dc..b96a16ccc3 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -16,14 +16,11 @@ import Simplex.Chat (roundedFDCount) import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), XFTPFileConfig (..), defaultInlineFilesConfig) import Simplex.Chat.Mobile.File import Simplex.Chat.Options (ChatOpts (..)) -import Simplex.FileTransfer.Client.Main (xftpClientCLI) import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..)) import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Util (unlessM) import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize) -import System.Environment (withArgs) -import System.IO.Silently (capture_) import Test.Hspec chatFileTests :: SpecWith FilePath @@ -1548,9 +1545,6 @@ testProhibitFiles = where cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} -xftpCLI :: [String] -> IO [String] -xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI) - startFileTransfer :: HasCallStack => TestCC -> TestCC -> IO () startFileTransfer alice bob = startFileTransfer' alice bob "test.jpg" "136.5 KiB / 139737 bytes" diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 86298b7758..6b539cc4e1 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -116,7 +116,14 @@ chatGroupTests = do it "forward role change (x.grp.mem.role)" testGroupMsgForwardChangeRole it "forward new member announcement (x.grp.mem.new)" testGroupMsgForwardNewMember describe "group history" $ do - fit "send recent history to invitee - text messages" testGroupHistory + it "text messages" testGroupHistory + it "host's file" testGroupHistoryHostFile + it "member's file" testGroupHistoryMemberFile + it "large file with text" testGroupHistoryLargeFile + it "multiple files" testGroupHistoryMultipleFiles + it "cancelled files are not attached (text message is still sent)" testGroupHistoryFileCancel + it "cancelled files without text are excluded" testGroupHistoryFileCancelNoText + it "quoted messages" testGroupHistoryQuotes where _0 = supportedChatVRange -- don't create direct connections _1 = groupCreateDirectVRange @@ -4160,3 +4167,436 @@ testGroupHistory = [alice, cath] *<# "#team bob> 2" cath #> "#team 3" [alice, bob] *<# "#team cath> 3" + +testGroupHistoryHostFile :: HasCallStack => FilePath -> IO () +testGroupHistoryHostFile = + testChatCfg3 cfg aliceProfile bobProfile cathProfile $ + \alice bob cath -> withXFTPServer $ do + createGroup2 "team" alice bob + + alice #> "/f #team ./tests/fixtures/test.jpg" + alice <## "use /fc 1 to cancel sending" + alice <## "completed uploading file 1 (test.jpg) for #team" + + bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + + connectUsers alice cath + addMember "team" alice cath GRAdmin + cath ##> "/j team" + concurrentlyN_ + [ alice <## "#team: cath joined the group", + cath + <### [ "#team: you joined the group", + WithTime "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]", + "use /fr 1 [/ | ] to receive it [>>]", + "#team: member bob (Bob) is connected" + ], + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + + cath ##> "/fr 1 ./tests/tmp" + cath + <### [ "saving file 1 from alice to ./tests/tmp/test.jpg", + "started receiving file 1 (test.jpg) from alice" + ] + cath <## "completed receiving file 1 (test.jpg) from alice" + src <- B.readFile "./tests/fixtures/test.jpg" + dest <- B.readFile "./tests/tmp/test.jpg" + dest `shouldBe` src + where + cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} + +testGroupHistoryMemberFile :: HasCallStack => FilePath -> IO () +testGroupHistoryMemberFile = + testChatCfg3 cfg aliceProfile bobProfile cathProfile $ + \alice bob cath -> withXFTPServer $ do + createGroup2 "team" alice bob + + bob #> "/f #team ./tests/fixtures/test.jpg" + bob <## "use /fc 1 to cancel sending" + bob <## "completed uploading file 1 (test.jpg) for #team" + + alice <# "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes)" + alice <## "use /fr 1 [/ | ] to receive it" + + connectUsers alice cath + addMember "team" alice cath GRAdmin + cath ##> "/j team" + concurrentlyN_ + [ alice <## "#team: cath joined the group", + cath + <### [ "#team: you joined the group", + WithTime "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]", + "use /fr 1 [/ | ] to receive it [>>]", + "#team: member bob (Bob) is connected" + ], + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + + cath ##> "/fr 1 ./tests/tmp" + cath + <### [ "saving file 1 from bob to ./tests/tmp/test.jpg", + "started receiving file 1 (test.jpg) from bob" + ] + cath <## "completed receiving file 1 (test.jpg) from bob" + src <- B.readFile "./tests/fixtures/test.jpg" + dest <- B.readFile "./tests/tmp/test.jpg" + dest `shouldBe` src + where + cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} + +testGroupHistoryLargeFile :: HasCallStack => FilePath -> IO () +testGroupHistoryLargeFile = + testChatCfg3 cfg aliceProfile bobProfile cathProfile $ + \alice bob cath -> withXFTPServer $ do + xftpCLI ["rand", "./tests/tmp/testfile", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile"] + + createGroup2 "team" alice bob + + bob ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile\", \"msgContent\": {\"text\":\"hello\",\"type\":\"file\"}}" + bob <# "#team hello" + bob <# "/f #team ./tests/tmp/testfile" + bob <## "use /fc 1 to cancel sending" + bob <## "completed uploading file 1 (testfile) for #team" + + alice <# "#team bob> hello" + alice <# "#team bob> sends file testfile (17.0 MiB / 17825792 bytes)" + alice <## "use /fr 1 [/ | ] to receive it" + + connectUsers alice cath + addMember "team" alice cath GRAdmin + cath ##> "/j team" + concurrentlyN_ + [ alice <## "#team: cath joined the group", + cath + <### [ "#team: you joined the group", + WithTime "#team bob> hello [>>]", + WithTime "#team bob> sends file testfile (17.0 MiB / 17825792 bytes) [>>]", + "use /fr 1 [/ | ] to receive it [>>]", + "#team: member bob (Bob) is connected" + ], + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + + cath ##> "/fr 1 ./tests/tmp" + cath + <### [ "saving file 1 from bob to ./tests/tmp/testfile_1", + "started receiving file 1 (testfile) from bob" + ] + cath <## "completed receiving file 1 (testfile) from bob" + src <- B.readFile "./tests/tmp/testfile" + dest <- B.readFile "./tests/tmp/testfile_1" + dest `shouldBe` src + where + cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} + +testGroupHistoryMultipleFiles :: HasCallStack => FilePath -> IO () +testGroupHistoryMultipleFiles = + testChatCfg3 cfg aliceProfile bobProfile cathProfile $ + \alice bob cath -> withXFTPServer $ do + xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"] + xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"] + + createGroup2 "team" alice bob + + bob ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_bob\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}" + bob <# "#team hi alice" + bob <# "/f #team ./tests/tmp/testfile_bob" + bob <## "use /fc 1 to cancel sending" + bob <## "completed uploading file 1 (testfile_bob) for #team" + + alice <# "#team bob> hi alice" + alice <# "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes)" + alice <## "use /fr 1 [/ | ] to receive it" + + threadDelay 1000000 + + alice ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_alice\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}" + alice <# "#team hey bob" + alice <# "/f #team ./tests/tmp/testfile_alice" + alice <## "use /fc 2 to cancel sending" + alice <## "completed uploading file 2 (testfile_alice) for #team" + + bob <# "#team alice> hey bob" + bob <# "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes)" + bob <## "use /fr 2 [/ | ] to receive it" + + connectUsers alice cath + addMember "team" alice cath GRAdmin + cath ##> "/j team" + concurrentlyN_ + [ alice <## "#team: cath joined the group", + cath + <### [ "#team: you joined the group", + WithTime "#team bob> hi alice [>>]", + WithTime "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes) [>>]", + "use /fr 1 [/ | ] to receive it [>>]", + WithTime "#team alice> hey bob [>>]", + WithTime "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes) [>>]", + "use /fr 2 [/ | ] to receive it [>>]", + "#team: member bob (Bob) is connected" + ], + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + + cath ##> "/fr 1 ./tests/tmp" + cath + <### [ "saving file 1 from bob to ./tests/tmp/testfile_bob_1", + "started receiving file 1 (testfile_bob) from bob" + ] + cath <## "completed receiving file 1 (testfile_bob) from bob" + srcBob <- B.readFile "./tests/tmp/testfile_bob" + destBob <- B.readFile "./tests/tmp/testfile_bob_1" + destBob `shouldBe` srcBob + + cath ##> "/fr 2 ./tests/tmp" + cath + <### [ "saving file 2 from alice to ./tests/tmp/testfile_alice_1", + "started receiving file 2 (testfile_alice) from alice" + ] + cath <## "completed receiving file 2 (testfile_alice) from alice" + srcAlice <- B.readFile "./tests/tmp/testfile_alice" + destAlice <- B.readFile "./tests/tmp/testfile_alice_1" + destAlice `shouldBe` srcAlice + + cath ##> "/_get chat #1 count=100" + r <- chatF <$> getTermLine cath + r + `shouldContain` [ ((0, "hi alice"), Just "./tests/tmp/testfile_bob_1"), + ((0, "hey bob"), Just "./tests/tmp/testfile_alice_1") + ] + where + cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} + +testGroupHistoryFileCancel :: HasCallStack => FilePath -> IO () +testGroupHistoryFileCancel = + testChatCfg3 cfg aliceProfile bobProfile cathProfile $ + \alice bob cath -> withXFTPServer $ do + xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"] + xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"] + + createGroup2 "team" alice bob + + bob ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_bob\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}" + bob <# "#team hi alice" + bob <# "/f #team ./tests/tmp/testfile_bob" + bob <## "use /fc 1 to cancel sending" + bob <## "completed uploading file 1 (testfile_bob) for #team" + + alice <# "#team bob> hi alice" + alice <# "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes)" + alice <## "use /fr 1 [/ | ] to receive it" + + bob ##> "/fc 1" + bob <## "cancelled sending file 1 (testfile_bob) to alice" + alice <## "bob cancelled sending file 1 (testfile_bob)" + + threadDelay 1000000 + + alice ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_alice\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}" + alice <# "#team hey bob" + alice <# "/f #team ./tests/tmp/testfile_alice" + alice <## "use /fc 2 to cancel sending" + alice <## "completed uploading file 2 (testfile_alice) for #team" + + bob <# "#team alice> hey bob" + bob <# "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes)" + bob <## "use /fr 2 [/ | ] to receive it" + + alice ##> "/fc 2" + alice <## "cancelled sending file 2 (testfile_alice) to bob" + bob <## "alice cancelled sending file 2 (testfile_alice)" + + connectUsers alice cath + addMember "team" alice cath GRAdmin + cath ##> "/j team" + concurrentlyN_ + [ alice <## "#team: cath joined the group", + cath + <### [ "#team: you joined the group", + WithTime "#team bob> hi alice [>>]", + WithTime "#team alice> hey bob [>>]", + "#team: member bob (Bob) is connected" + ], + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + where + cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} + +testGroupHistoryFileCancelNoText :: HasCallStack => FilePath -> IO () +testGroupHistoryFileCancelNoText = + testChatCfg3 cfg aliceProfile bobProfile cathProfile $ + \alice bob cath -> withXFTPServer $ do + xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"] + xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"] + + createGroup2 "team" alice bob + + alice #> "#team hello" + bob <# "#team alice> hello" + + -- bob file + + bob #> "/f #team ./tests/tmp/testfile_bob" + bob <## "use /fc 1 to cancel sending" + bob <## "completed uploading file 1 (testfile_bob) for #team" + + alice <# "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes)" + alice <## "use /fr 1 [/ | ] to receive it" + + bob ##> "/fc 1" + bob <## "cancelled sending file 1 (testfile_bob) to alice" + alice <## "bob cancelled sending file 1 (testfile_bob)" + + -- alice file + + alice #> "/f #team ./tests/tmp/testfile_alice" + alice <## "use /fc 2 to cancel sending" + alice <## "completed uploading file 2 (testfile_alice) for #team" + + bob <# "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes)" + bob <## "use /fr 2 [/ | ] to receive it" + + alice ##> "/fc 2" + alice <## "cancelled sending file 2 (testfile_alice) to bob" + bob <## "alice cancelled sending file 2 (testfile_alice)" + + -- other messages are sent + + bob #> "#team hey!" + alice <# "#team bob> hey!" + + connectUsers alice cath + addMember "team" alice cath GRAdmin + cath ##> "/j team" + concurrentlyN_ + [ alice <## "#team: cath joined the group", + cath + <### [ "#team: you joined the group", + WithTime "#team alice> hello [>>]", + WithTime "#team bob> hey! [>>]", + "#team: member bob (Bob) is connected" + ], + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + where + cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} + +testGroupHistoryQuotes :: HasCallStack => FilePath -> IO () +testGroupHistoryQuotes = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup2 "team" alice bob + + threadDelay 1000000 + + alice #> "#team ALICE" + bob <# "#team alice> ALICE" + + threadDelay 1000000 + + bob #> "#team BOB" + alice <# "#team bob> BOB" + + threadDelay 1000000 + + alice `send` "> #team @alice (ALICE) 1" + alice <# "#team > alice ALICE" + alice <## " 1" + bob <# "#team alice> > alice ALICE" + bob <## " 1" + + threadDelay 1000000 + + alice `send` "> #team @bob (BOB) 2" + alice <# "#team > bob BOB" + alice <## " 2" + bob <# "#team alice> > bob BOB" + bob <## " 2" + + threadDelay 1000000 + + bob `send` "> #team @alice (ALICE) 3" + bob <# "#team > alice ALICE" + bob <## " 3" + alice <# "#team bob> > alice ALICE" + alice <## " 3" + + threadDelay 1000000 + + bob `send` "> #team @bob (BOB) 4" + bob <# "#team > bob BOB" + bob <## " 4" + alice <# "#team bob> > bob BOB" + alice <## " 4" + + alice + #$> ( "/_get chat #1 count=6", + chat', + [ ((1, "ALICE"), Nothing), + ((0, "BOB"), Nothing), + ((1, "1"), Just (1, "ALICE")), + ((1, "2"), Just (0, "BOB")), + ((0, "3"), Just (1, "ALICE")), + ((0, "4"), Just (0, "BOB")) + ] + ) + bob + #$> ( "/_get chat #1 count=6", + chat', + [ ((0, "ALICE"), Nothing), + ((1, "BOB"), Nothing), + ((0, "1"), Just (0, "ALICE")), + ((0, "2"), Just (1, "BOB")), + ((1, "3"), Just (0, "ALICE")), + ((1, "4"), Just (1, "BOB")) + ] + ) + + connectUsers alice cath + addMember "team" alice cath GRAdmin + cath ##> "/j team" + concurrentlyN_ + [ alice <## "#team: cath joined the group", + cath + <### [ "#team: you joined the group", + WithTime "#team alice> ALICE [>>]", + WithTime "#team bob> BOB [>>]", + WithTime "#team alice> > alice ALICE [>>]", + " 1 [>>]", + WithTime "#team alice> > bob BOB [>>]", + " 2 [>>]", + WithTime "#team bob> > alice ALICE [>>]", + " 3 [>>]", + WithTime "#team bob> > bob BOB [>>]", + " 4 [>>]", + "#team: member bob (Bob) is connected" + ], + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + + cath ##> "/_get chat #1 count=100" + r <- chat' <$> getTermLine cath + r + `shouldContain` [ ((0, "ALICE"), Nothing), + ((0, "BOB"), Nothing), + ((0, "1"), Just (0, "ALICE")), + ((0, "2"), Just (0, "BOB")), + ((0, "3"), Just (0, "ALICE")), + ((0, "4"), Just (0, "BOB")) + ] diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 3f89e9b177..007dd9a42e 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -23,13 +23,15 @@ import Simplex.Chat.Protocol import Simplex.Chat.Store.Profiles (getUserContactProfiles) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences +import Simplex.FileTransfer.Client.Main (xftpClientCLI) import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow, withTransaction) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import Simplex.Messaging.Encoding.String import Simplex.Messaging.Version import System.Directory (doesFileExist) -import System.Environment (lookupEnv) +import System.Environment (lookupEnv, withArgs) import System.FilePath (()) +import System.IO.Silently (capture_) import System.Info (os) import Test.Hspec @@ -597,3 +599,6 @@ linkAnotherSchema link | "simplex:/" `isPrefixOf` link = T.unpack $ T.replace "simplex:/" "https://simplex.chat/" $ T.pack link | otherwise = error "link starts with neither https://simplex.chat/ nor simplex:/" + +xftpCLI :: [String] -> IO [String] +xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI)