diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 54a7f1ef0b..dc3b4b2e54 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -2906,6 +2906,7 @@ processChatCommand' vr = \case (msgContainers, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_ msgs_ <- sendDirectContactMessages user ct $ L.map XMsgNew msgContainers let itemsData = prepareSndItemsData msgs_ cmrs ciFiles_ quotedItems_ + when (length itemsData /= length cmrs) $ logError "sendContactContentMessages: cmrs and itemsData length mismatch" (errs, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) itemsData timed_ live unless (null errs) $ toView $ CRChatErrors (Just user) errs forM_ (timed_ >>= timedDeleteAt') $ \deleteAt -> @@ -2969,6 +2970,7 @@ processChatCommand' vr = \case (msgs_, gsr) <- sendGroupMessages user gInfo ms $ L.map XMsgNew msgContainers let itemsData = prepareSndItemsData (L.toList msgs_) cmrs ciFiles_ quotedItems_ cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData timed_ live + when (length itemsData /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch" createMemberSndStatuses cis_ msgs_ gsr let (errs, cis) = partitionEithers cis_ unless (null errs) $ toView $ CRChatErrors (Just user) errs @@ -7038,6 +7040,7 @@ batchSendConnMessagesB _user conn msgFlags msgs_ = do delivered <- deliverMessagesB msgReqs let msgs' = concat $ L.zipWith flattenMsgs batched' delivered pqEnc = findLastPQEnc delivered + when (length msgs' /= length msgs_) $ logError "batchSendConnMessagesB: msgs_ and msgs' length mismatch" pure (msgs', pqEnc) Nothing -> pure ([], Nothing) where @@ -7190,6 +7193,7 @@ sendGroupMessages_ _user gInfo@GroupInfo {groupId} members events = do -- Save as pending for toPending members let (pendingMemIds, pendingReqs) = preparePending sndMsgs_ toPending stored <- lift $ withStoreBatch (\db -> map (bindRight $ createPendingMsg db) pendingReqs) + when (length stored /= length pendingMemIds) $ logError "sendGroupMessages_: pendingMemIds and stored length mismatch" -- Zip for easier access to results let sentTo = zipWith3 (\mId mReq r -> (mId, fmap (\(_, _, _, msgIds) -> msgIds) mReq, r)) sendToMemIds msgReqs delivered pending = zipWith3 (\mId pReq r -> (mId, fmap snd pReq, r)) pendingMemIds pendingReqs stored diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 78e3b4c640..f6c59cbcb5 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -336,6 +336,9 @@ aChatItemId (AChatItem _ _ _ ci) = chatItemId' ci aChatItemTs :: AChatItem -> UTCTime aChatItemTs (AChatItem _ _ _ ci) = chatItemTs' ci +aChatItemDir :: AChatItem -> MsgDirection +aChatItemDir (AChatItem _ sMsgDir _ _) = toMsgDirection sMsgDir + updateFileStatus :: forall c d. ChatItem c d -> CIFileStatus d -> ChatItem c d updateFileStatus ci@ChatItem {file} status = case file of Just f -> ci {file = Just (f :: CIFile d) {fileStatus = status}} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index dd2bf94467..2158599c4b 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} @@ -120,10 +121,16 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code] CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView - CRNewChatItems u chatItems -> - concatMap - (\(AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewChatItem chat item False ts tz <> viewItemReactions item) - chatItems + CRNewChatItems u chatItems + | length chatItems > 20 -> + if + | all (\aci -> aChatItemDir aci == MDRcv) chatItems -> ttyUser u [sShow (length chatItems) <> " new messages"] + | all (\aci -> aChatItemDir aci == MDSnd) chatItems -> ttyUser u [sShow (length chatItems) <> " messages sent"] + | otherwise -> ttyUser u [sShow (length chatItems) <> " new messages created"] + | otherwise -> + concatMap + (\(AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewChatItem chat item False ts tz <> viewItemReactions item) + chatItems CRChatItems u _ chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId] diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 86c51f6aaa..9980b3b723 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -17,6 +17,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.List (intercalate) import qualified Data.Text as T +import Database.SQLite.Simple (Only (..)) import Simplex.Chat.AppSettings (defaultAppSettings) import qualified Simplex.Chat.AppSettings as AS import Simplex.Chat.Call @@ -25,6 +26,7 @@ import Simplex.Chat.Options (ChatOpts (..)) import Simplex.Chat.Protocol (supportedChatVRange) import Simplex.Chat.Store (agentStoreFile, chatStoreFile) import Simplex.Chat.Types (VersionRangeChat, authErrDisableCount, sameVerificationCode, verificationCode, pattern VersionChat) +import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Util (safeDecodeUtf8) import Simplex.Messaging.Version @@ -52,7 +54,11 @@ chatDirectTests = do it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact it "should send multiline message" testMultilineMessage it "send large message" testLargeMessage + describe "batch send messages" $ do it "send multiple messages api" testSendMulti + it "send multiple timed messages" testSendMultiTimed + it "send multiple messages, including quote" testSendMultiWithQuote + it "send multiple messages (many chat batches)" testSendMultiManyBatches describe "duplicate contacts" $ do it "duplicate contacts are separate (contacts don't merge)" testDuplicateContactsSeparate it "new contact is separate with multiple duplicate contacts (contacts don't merge)" testDuplicateContactsMultipleSeparate @@ -716,22 +722,27 @@ testDirectMessageDeleteMultipleManyBatches = \alice bob -> do connectUsers alice bob - alice #> "@bob message 0" - bob <# "alice> message 0" - msgIdFirst <- lastItemId alice + msgIdZero <- lastItemId alice - forM_ [(1 :: Int) .. 300] $ \i -> do - alice #> ("@bob message " <> show i) - bob <# ("alice> message " <> show i) + let cm i = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message " <> show i <> "\"}}" + cms = intercalate ", " (map cm [1 .. 300 :: Int]) + + alice `send` ("/_send @2 json [" <> cms <> "]") + _ <- getTermLine alice + + alice <## "300 messages sent" msgIdLast <- lastItemId alice - let mIdFirst = read msgIdFirst :: Int + forM_ [(1 :: Int) .. 300] $ \i -> do + bob <# ("alice> message " <> show i) + + let mIdFirst = (read msgIdZero :: Int) + 1 mIdLast = read msgIdLast :: Int deleteIds = intercalate "," (map show [mIdFirst .. mIdLast]) alice `send` ("/_delete item @2 " <> deleteIds <> " broadcast") _ <- getTermLine alice - alice <## "301 messages deleted" - forM_ [(0 :: Int) .. 300] $ \i -> do + alice <## "300 messages deleted" + forM_ [(1 :: Int) .. 300] $ \i -> do bob <# ("alice> [marked deleted] message " <> show i) testDirectLiveMessage :: HasCallStack => FilePath -> IO () @@ -852,6 +863,100 @@ testSendMulti = bob <# "alice> test 1" bob <# "alice> test 2" +testSendMultiTimed :: HasCallStack => FilePath -> IO () +testSendMultiTimed = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + + alice ##> "/_send @2 ttl=1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]" + alice <# "@bob test 1" + alice <# "@bob test 2" + bob <# "alice> test 1" + bob <# "alice> test 2" + + alice + <### [ "timed message deleted: test 1", + "timed message deleted: test 2" + ] + bob + <### [ "timed message deleted: test 1", + "timed message deleted: test 2" + ] + +testSendMultiWithQuote :: HasCallStack => FilePath -> IO () +testSendMultiWithQuote = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + + alice #> "@bob hello" + bob <# "alice> hello" + msgId1 <- lastItemId alice + + threadDelay 1000000 + + bob #> "@alice hi" + alice <# "bob> hi" + msgId2 <- lastItemId alice + + let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message 1\"}}" + cm2 = "{\"quotedItemId\": " <> msgId1 <> ", \"msgContent\": {\"type\": \"text\", \"text\": \"message 2\"}}" + cm3 = "{\"quotedItemId\": " <> msgId2 <> ", \"msgContent\": {\"type\": \"text\", \"text\": \"message 3\"}}" + + alice ##> ("/_send @2 json [" <> cm1 <> ", " <> cm2 <> ", " <> cm3 <> "]") + alice <## "bad chat command: invalid multi send: live and more than one quote not supported" + + alice ##> ("/_send @2 json [" <> cm1 <> ", " <> cm2 <> "]") + + alice <# "@bob message 1" + alice <# "@bob >> hello" + alice <## " message 2" + + bob <# "alice> message 1" + bob <# "alice> >> hello" + bob <## " message 2" + + alice ##> ("/_send @2 json [" <> cm3 <> ", " <> cm1 <> "]") + + alice <# "@bob > hi" + alice <## " message 3" + alice <# "@bob message 1" + + bob <# "alice> > hi" + bob <## " message 3" + bob <# "alice> message 1" + +testSendMultiManyBatches :: HasCallStack => FilePath -> IO () +testSendMultiManyBatches = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + + threadDelay 1000000 + + msgIdAlice <- lastItemId alice + msgIdBob <- lastItemId bob + + let cm i = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message " <> show i <> "\"}}" + cms = intercalate ", " (map cm [1 .. 300 :: Int]) + + alice `send` ("/_send @2 json [" <> cms <> "]") + _ <- getTermLine alice + + alice <## "300 messages sent" + + forM_ [(1 :: Int) .. 300] $ \i -> + bob <# ("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]] + testGetSetSMPServers :: HasCallStack => FilePath -> IO () testGetSetSMPServers = testChat2 aliceProfile bobProfile $ diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 32f3c02c29..c97193186b 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -36,6 +36,9 @@ chatFileTests = do it "send and receive image with text and quote" testSendImageWithTextAndQuote it "send and receive image to group" testGroupSendImage it "send and receive image with text and quote to group" testGroupSendImageWithTextAndQuote + describe "batch send messages with files" $ do + it "with files folder: send multiple files to contact" testSendMultiFilesDirect + it "with files folder: send multiple files to group" testSendMultiFilesGroup describe "file transfer over XFTP" $ do it "round file description count" $ const testXFTPRoundFDCount it "send and receive file" testXFTPFileTransfer @@ -406,6 +409,166 @@ testGroupSendImageWithTextAndQuote = cath #$> ("/_get chat #1 count=2", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")]) cath @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")] +testSendMultiFilesDirect :: HasCallStack => FilePath -> IO () +testSendMultiFilesDirect = + testChat2 aliceProfile bobProfile $ \alice bob -> do + withXFTPServer $ do + connectUsers alice bob + + alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok") + copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" + copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" + bob #$> ("/_files_folder ./tests/tmp/bob_app_files", id, "ok") + + let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}" + cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}" + cm3 = "{\"filePath\": \"test.pdf\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 2\"}}" + alice ##> ("/_send @2 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "]") + + alice <# "@bob message without file" + + alice <# "@bob sending file 1" + alice <# "/f @bob test.jpg" + alice <## "use /fc 1 to cancel sending" + + alice <# "@bob sending file 2" + alice <# "/f @bob test.pdf" + alice <## "use /fc 2 to cancel sending" + + bob <# "alice> message without file" + + bob <# "alice> sending file 1" + bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + + bob <# "alice> sending file 2" + bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" + bob <## "use /fr 2 [/ | ] to receive it" + + alice <## "completed uploading file 1 (test.jpg) for bob" + alice <## "completed uploading file 2 (test.pdf) for bob" + + bob ##> "/fr 1" + bob + <### [ "saving file 1 from alice to test.jpg", + "started receiving file 1 (test.jpg) from alice" + ] + bob <## "completed receiving file 1 (test.jpg) from alice" + + bob ##> "/fr 2" + bob + <### [ "saving file 2 from alice to test.pdf", + "started receiving file 2 (test.pdf) from alice" + ] + bob <## "completed receiving file 2 (test.pdf) from alice" + + src1 <- B.readFile "./tests/tmp/alice_app_files/test.jpg" + dest1 <- B.readFile "./tests/tmp/bob_app_files/test.jpg" + dest1 `shouldBe` src1 + + src2 <- B.readFile "./tests/tmp/alice_app_files/test.pdf" + dest2 <- B.readFile "./tests/tmp/bob_app_files/test.pdf" + dest2 `shouldBe` src2 + + alice #$> ("/_get chat @2 count=3", chatF, [((1, "message without file"), Nothing), ((1, "sending file 1"), Just "test.jpg"), ((1, "sending file 2"), Just "test.pdf")]) + bob #$> ("/_get chat @2 count=3", chatF, [((0, "message without file"), Nothing), ((0, "sending file 1"), Just "test.jpg"), ((0, "sending file 2"), Just "test.pdf")]) + +testSendMultiFilesGroup :: HasCallStack => FilePath -> IO () +testSendMultiFilesGroup = + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do + withXFTPServer $ do + createGroup3 "team" alice bob cath + + threadDelay 1000000 + + alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok") + copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" + copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" + bob #$> ("/_files_folder ./tests/tmp/bob_app_files", id, "ok") + cath #$> ("/_files_folder ./tests/tmp/cath_app_files", id, "ok") + + let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}" + cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}" + cm3 = "{\"filePath\": \"test.pdf\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 2\"}}" + alice ##> ("/_send #1 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "]") + + alice <# "#team message without file" + + alice <# "#team sending file 1" + alice <# "/f #team test.jpg" + alice <## "use /fc 1 to cancel sending" + + alice <# "#team sending file 2" + alice <# "/f #team test.pdf" + alice <## "use /fc 2 to cancel sending" + + bob <# "#team alice> message without file" + + bob <# "#team alice> sending file 1" + bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + + bob <# "#team alice> sending file 2" + bob <# "#team alice> sends file test.pdf (266.0 KiB / 272376 bytes)" + bob <## "use /fr 2 [/ | ] to receive it" + + cath <# "#team alice> message without file" + + cath <# "#team alice> sending file 1" + cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + cath <## "use /fr 1 [/ | ] to receive it" + + cath <# "#team alice> sending file 2" + cath <# "#team alice> sends file test.pdf (266.0 KiB / 272376 bytes)" + cath <## "use /fr 2 [/ | ] to receive it" + + alice <## "completed uploading file 1 (test.jpg) for #team" + alice <## "completed uploading file 2 (test.pdf) for #team" + + bob ##> "/fr 1" + bob + <### [ "saving file 1 from alice to test.jpg", + "started receiving file 1 (test.jpg) from alice" + ] + bob <## "completed receiving file 1 (test.jpg) from alice" + + bob ##> "/fr 2" + bob + <### [ "saving file 2 from alice to test.pdf", + "started receiving file 2 (test.pdf) from alice" + ] + bob <## "completed receiving file 2 (test.pdf) from alice" + + cath ##> "/fr 1" + cath + <### [ "saving file 1 from alice to test.jpg", + "started receiving file 1 (test.jpg) from alice" + ] + cath <## "completed receiving file 1 (test.jpg) from alice" + + cath ##> "/fr 2" + cath + <### [ "saving file 2 from alice to test.pdf", + "started receiving file 2 (test.pdf) from alice" + ] + cath <## "completed receiving file 2 (test.pdf) from alice" + + src1 <- B.readFile "./tests/tmp/alice_app_files/test.jpg" + dest1_1 <- B.readFile "./tests/tmp/bob_app_files/test.jpg" + dest1_2 <- B.readFile "./tests/tmp/cath_app_files/test.jpg" + dest1_1 `shouldBe` src1 + dest1_2 `shouldBe` src1 + + src2 <- B.readFile "./tests/tmp/alice_app_files/test.pdf" + dest2_1 <- B.readFile "./tests/tmp/bob_app_files/test.pdf" + dest2_2 <- B.readFile "./tests/tmp/cath_app_files/test.pdf" + dest2_1 `shouldBe` src2 + dest2_2 `shouldBe` src2 + + alice #$> ("/_get chat #1 count=3", chatF, [((1, "message without file"), Nothing), ((1, "sending file 1"), Just "test.jpg"), ((1, "sending file 2"), Just "test.pdf")]) + bob #$> ("/_get chat #1 count=3", chatF, [((0, "message without file"), Nothing), ((0, "sending file 1"), Just "test.jpg"), ((0, "sending file 2"), Just "test.pdf")]) + cath #$> ("/_get chat #1 count=3", chatF, [((0, "message without file"), Nothing), ((0, "sending file 1"), Just "test.jpg"), ((0, "sending file 2"), Just "test.pdf")]) + testXFTPRoundFDCount :: Expectation testXFTPRoundFDCount = do roundedFDCount (-100) `shouldBe` 4 diff --git a/tests/ChatTests/Forward.hs b/tests/ChatTests/Forward.hs index 221a2426b1..b339053abf 100644 --- a/tests/ChatTests/Forward.hs +++ b/tests/ChatTests/Forward.hs @@ -35,6 +35,8 @@ chatForwardTests = do it "with relative paths: from notes to group" testForwardFileNotesToGroup describe "multi forward api" $ do it "from contact to contact" testForwardContactToContactMulti + it "from group to group" testForwardGroupToGroupMulti + it "with relative paths: multiple files from contact to contact" testMultiForwardFiles testForwardContactToContact :: HasCallStack => FilePath -> IO () testForwardContactToContact = @@ -620,3 +622,188 @@ testForwardContactToContactMulti = cath <## " hi" cath <# "alice> -> forwarded" cath <## " hey" + +testForwardGroupToGroupMulti :: HasCallStack => FilePath -> IO () +testForwardGroupToGroupMulti = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup2 "team" alice bob + createGroup2 "club" alice cath + + threadDelay 1000000 + + alice #> "#team hi" + bob <# "#team alice> hi" + msgId1 <- lastItemId alice + + threadDelay 1000000 + + bob #> "#team hey" + alice <# "#team bob> hey" + msgId2 <- lastItemId alice + + alice ##> ("/_forward #2 #1 " <> msgId1 <> "," <> msgId2) + alice <# "#club <- you #team" + alice <## " hi" + alice <# "#club <- #team" + alice <## " hey" + cath <# "#club alice> -> forwarded" + cath <## " hi" + cath <# "#club alice> -> forwarded" + cath <## " hey" + + -- read chat + alice ##> "/tail #club 2" + alice <# "#club <- you #team" + alice <## " hi" + alice <# "#club <- #team" + alice <## " hey" + + cath ##> "/tail #club 2" + cath <# "#club alice> -> forwarded" + cath <## " hi" + cath <# "#club alice> -> forwarded" + cath <## " hey" + +testMultiForwardFiles :: HasCallStack => FilePath -> IO () +testMultiForwardFiles = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> withXFTPServer $ do + setRelativePaths alice "./tests/tmp/alice_app_files" "./tests/tmp/alice_xftp" + copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" + copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" + setRelativePaths bob "./tests/tmp/bob_app_files" "./tests/tmp/bob_xftp" + setRelativePaths cath "./tests/tmp/cath_app_files" "./tests/tmp/cath_xftp" + connectUsers alice bob + connectUsers bob cath + + threadDelay 1000000 + + msgIdZero <- lastItemId bob + + bob #> "@alice hi" + alice <# "bob> hi" + + -- send original files + let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}" + cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}" + cm3 = "{\"filePath\": \"test.pdf\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 2\"}}" + alice ##> ("/_send @2 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "]") + + alice <# "@bob message without file" + + alice <# "@bob sending file 1" + alice <# "/f @bob test.jpg" + alice <## "use /fc 1 to cancel sending" + + alice <# "@bob sending file 2" + alice <# "/f @bob test.pdf" + alice <## "use /fc 2 to cancel sending" + + bob <# "alice> message without file" + + bob <# "alice> sending file 1" + bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + + bob <# "alice> sending file 2" + bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" + bob <## "use /fr 2 [/ | ] to receive it" + + alice <## "completed uploading file 1 (test.jpg) for bob" + alice <## "completed uploading file 2 (test.pdf) for bob" + + bob ##> "/fr 1" + bob + <### [ "saving file 1 from alice to test.jpg", + "started receiving file 1 (test.jpg) from alice" + ] + bob <## "completed receiving file 1 (test.jpg) from alice" + + bob ##> "/fr 2" + bob + <### [ "saving file 2 from alice to test.pdf", + "started receiving file 2 (test.pdf) from alice" + ] + bob <## "completed receiving file 2 (test.pdf) from alice" + + src1 <- B.readFile "./tests/tmp/alice_app_files/test.jpg" + dest1 <- B.readFile "./tests/tmp/bob_app_files/test.jpg" + dest1 `shouldBe` src1 + + src2 <- B.readFile "./tests/tmp/alice_app_files/test.pdf" + dest2 <- B.readFile "./tests/tmp/bob_app_files/test.pdf" + dest2 `shouldBe` src2 + + -- forward file + let msgId1 = (read msgIdZero :: Int) + 1 + bob ##> ("/_forward @3 @2 " <> show msgId1 <> "," <> show (msgId1 + 1) <> "," <> show (msgId1 + 2) <> "," <> show (msgId1 + 3)) + + -- messages printed for bob + bob <# "@cath <- you @alice" + bob <## " hi" + + bob <# "@cath <- @alice" + bob <## " message without file" + + bob <# "@cath <- @alice" + bob <## " sending file 1" + bob <# "/f @cath test_1.jpg" + bob <## "use /fc 3 to cancel sending" + + bob <# "@cath <- @alice" + bob <## " sending file 2" + bob <# "/f @cath test_1.pdf" + bob <## "use /fc 4 to cancel sending" + + -- messages printed for cath + cath <# "bob> -> forwarded" + cath <## " hi" + + cath <# "bob> -> forwarded" + cath <## " message without file" + + cath <# "bob> -> forwarded" + cath <## " sending file 1" + cath <# "bob> sends file test_1.jpg (136.5 KiB / 139737 bytes)" + cath <## "use /fr 1 [/ | ] to receive it" + + cath <# "bob> -> forwarded" + cath <## " sending file 2" + cath <# "bob> sends file test_1.pdf (266.0 KiB / 272376 bytes)" + cath <## "use /fr 2 [/ | ] to receive it" + + -- file transfer + bob <## "completed uploading file 3 (test_1.jpg) for cath" + bob <## "completed uploading file 4 (test_1.pdf) for cath" + + cath ##> "/fr 1" + cath + <### [ "saving file 1 from bob to test_1.jpg", + "started receiving file 1 (test_1.jpg) from bob" + ] + cath <## "completed receiving file 1 (test_1.jpg) from bob" + + cath ##> "/fr 2" + cath + <### [ "saving file 2 from bob to test_1.pdf", + "started receiving file 2 (test_1.pdf) from bob" + ] + cath <## "completed receiving file 2 (test_1.pdf) from bob" + + src1B <- B.readFile "./tests/tmp/bob_app_files/test_1.jpg" + src1B `shouldBe` dest1 + dest1C <- B.readFile "./tests/tmp/cath_app_files/test_1.jpg" + dest1C `shouldBe` src1B + + src2B <- B.readFile "./tests/tmp/bob_app_files/test_1.pdf" + src2B `shouldBe` dest2 + dest2C <- B.readFile "./tests/tmp/cath_app_files/test_1.pdf" + dest2C `shouldBe` src2B + + -- deleting original file doesn't delete forwarded file + checkActionDeletesFile "./tests/tmp/bob_app_files/test.jpg" $ do + bob ##> "/clear alice" + bob <## "alice: all messages are removed locally ONLY" + fwdFileExists <- doesFileExist "./tests/tmp/bob_app_files/test_1.jpg" + fwdFileExists `shouldBe` True diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 1ff01a911c..d3e65ce5df 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -14,6 +14,7 @@ import Control.Monad (forM_, void, when) import qualified Data.ByteString.Char8 as B import Data.List (intercalate, isInfixOf) import qualified Data.Text as T +import Database.SQLite.Simple (Only (..)) import Simplex.Chat.Controller (ChatConfig (..)) import Simplex.Chat.Options import Simplex.Chat.Protocol (supportedChatVRange) @@ -64,7 +65,10 @@ chatGroupTests = do it "moderate message of another group member (full delete)" testGroupModerateFullDelete it "moderate message that arrives after the event of moderation" testGroupDelayedModeration it "moderate message that arrives after the event of moderation (full delete)" testGroupDelayedModerationFullDelete + describe "batch send messages" $ do it "send multiple messages api" testSendMulti + it "send multiple timed messages" testSendMultiTimed + it "send multiple messages (many chat batches)" testSendMultiManyBatches describe "async group connections" $ do xit "create and join group when clients go offline" testGroupAsync describe "group links" $ do @@ -1305,26 +1309,29 @@ testGroupMessageDeleteMultipleManyBatches = cath ##> "/set receipts all off" cath <## "ok" - alice #> "#team message 0" - concurrently_ - (bob <# "#team alice> message 0") - (cath <# "#team alice> message 0") - msgIdFirst <- lastItemId alice + msgIdZero <- lastItemId alice + + let cm i = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message " <> show i <> "\"}}" + cms = intercalate ", " (map cm [1 .. 300 :: Int]) + + alice `send` ("/_send #1 json [" <> cms <> "]") + _ <- getTermLine alice + + alice <## "300 messages sent" forM_ [(1 :: Int) .. 300] $ \i -> do - alice #> ("#team message " <> show i) concurrently_ (bob <# ("#team alice> message " <> show i)) (cath <# ("#team alice> message " <> show i)) msgIdLast <- lastItemId alice - let mIdFirst = read msgIdFirst :: Int + let mIdFirst = (read msgIdZero :: Int) + 1 mIdLast = read msgIdLast :: Int deleteIds = intercalate "," (map show [mIdFirst .. mIdLast]) alice `send` ("/_delete item #1 " <> deleteIds <> " broadcast") _ <- getTermLine alice - alice <## "301 messages deleted" - forM_ [(0 :: Int) .. 300] $ \i -> + alice <## "300 messages deleted" + forM_ [(1 :: Int) .. 300] $ \i -> concurrently_ (bob <# ("#team alice> [marked deleted] message " <> show i)) (cath <# ("#team alice> [marked deleted] message " <> show i)) @@ -1821,15 +1828,89 @@ testGroupDelayedModerationFullDelete tmp = do testSendMulti :: HasCallStack => FilePath -> IO () testSendMulti = - testChat2 aliceProfile bobProfile $ - \alice bob -> do - createGroup2 "team" alice bob + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup3 "team" alice bob cath alice ##> "/_send #1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]" alice <# "#team test 1" alice <# "#team test 2" bob <# "#team alice> test 1" bob <# "#team alice> test 2" + cath <# "#team alice> test 1" + cath <# "#team alice> test 2" + +testSendMultiTimed :: HasCallStack => FilePath -> IO () +testSendMultiTimed = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup3 "team" alice bob cath + + alice ##> "/set disappear #team on 1" + alice <## "updated group preferences:" + alice <## "Disappearing messages: on (1 sec)" + bob <## "alice updated group #team:" + bob <## "updated group preferences:" + bob <## "Disappearing messages: on (1 sec)" + cath <## "alice updated group #team:" + cath <## "updated group preferences:" + cath <## "Disappearing messages: on (1 sec)" + + alice ##> "/_send #1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]" + alice <# "#team test 1" + alice <# "#team test 2" + bob <# "#team alice> test 1" + bob <# "#team alice> test 2" + cath <# "#team alice> test 1" + cath <# "#team alice> test 2" + + alice + <### [ "timed message deleted: test 1", + "timed message deleted: test 2" + ] + bob + <### [ "timed message deleted: test 1", + "timed message deleted: test 2" + ] + cath + <### [ "timed message deleted: test 1", + "timed message deleted: test 2" + ] + +testSendMultiManyBatches :: HasCallStack => FilePath -> IO () +testSendMultiManyBatches = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup3 "team" alice bob cath + + msgIdAlice <- lastItemId alice + msgIdBob <- lastItemId bob + msgIdCath <- lastItemId cath + + let cm i = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message " <> show i <> "\"}}" + cms = intercalate ", " (map cm [1 .. 300 :: Int]) + + alice `send` ("/_send #1 json [" <> cms <> "]") + _ <- getTermLine alice + + alice <## "300 messages sent" + + forM_ [(1 :: Int) .. 300] $ \i -> do + concurrently_ + (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]] testGroupAsync :: HasCallStack => FilePath -> IO () testGroupAsync tmp = do diff --git a/tests/ChatTests/Local.hs b/tests/ChatTests/Local.hs index f097edbc0c..da9c043648 100644 --- a/tests/ChatTests/Local.hs +++ b/tests/ChatTests/Local.hs @@ -17,12 +17,14 @@ chatLocalChatsTests :: SpecWith FilePath chatLocalChatsTests = do describe "note folders" $ do it "create folders, add notes, read, search" testNotes - it "create multiple messages api" testCreateMulti it "switch users" testUserNotes it "preview pagination for notes" testPreviewsPagination it "chat pagination" testChatPagination it "stores files" testFiles it "deleting files does not interfere with other chat types" testOtherFiles + describe "batch create messages" $ do + it "create multiple messages api" testCreateMulti + it "create multiple messages with files" testCreateMultiFiles testNotes :: FilePath -> IO () testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do @@ -53,14 +55,6 @@ testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do alice ##> "/tail *" alice <# "* Greetings." -testCreateMulti :: FilePath -> IO () -testCreateMulti tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do - createCCNoteFolder alice - - alice ##> "/_create *1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]" - alice <# "* test 1" - alice <# "* test 2" - testUserNotes :: FilePath -> IO () testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do createCCNoteFolder alice @@ -197,3 +191,36 @@ testOtherFiles = doesFileExist "./tests/tmp/test.jpg" `shouldReturn` True where cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, receiveChunks = 100}} + +testCreateMulti :: FilePath -> IO () +testCreateMulti tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do + createCCNoteFolder alice + + alice ##> "/_create *1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]" + alice <# "* test 1" + alice <# "* test 2" + +testCreateMultiFiles :: FilePath -> IO () +testCreateMultiFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do + createCCNoteFolder alice + alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok") + copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" + copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" + + let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}" + cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}" + cm3 = "{\"filePath\": \"test.pdf\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 2\"}}" + alice ##> ("/_create *1 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "]") + + alice <# "* message without file" + alice <# "* sending file 1" + alice <# "* file 1 (test.jpg)" + alice <# "* sending file 2" + alice <# "* file 2 (test.pdf)" + + doesFileExist "./tests/tmp/alice_app_files/test.jpg" `shouldReturn` True + doesFileExist "./tests/tmp/alice_app_files/test.pdf" `shouldReturn` True + + alice ##> "/_get chat *1 count=3" + r <- chatF <$> getTermLine alice + r `shouldBe` [((1, "message without file"), Nothing), ((1, "sending file 1"), Just "test.jpg"), ((1, "sending file 2"), Just "test.pdf")]