refactor, tests

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

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"

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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] to receive it [>>]",
+                   WithTime "#team alice> hey bob [>>]",
+                   WithTime "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes) [>>]",
+                   "use /fr 2 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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"))
+                        ]

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)