core: test forwarded message deduplication, mute terminal error (#3414)

src/Simplex/Chat/View.hs

@@ -360,8 +360,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRAgentConnDeleted acId -> ["completed deleting connection, agent connection id: " <> sShow acId | logLevel <= CLLInfo]
   CRAgentUserDeleted auId -> ["completed deleting user" <> if logLevel <= CLLInfo then ", agent user id: " <> sShow auId else ""]
   CRMessageError u prefix err -> ttyUser u [plain prefix <> ": " <> plain err | prefix == "error" || logLevel <= CLLWarning]
-  CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel e
+  CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel testView e
-  CRChatError u e -> ttyUser' u $ viewChatError logLevel e
+  CRChatError u e -> ttyUser' u $ viewChatError logLevel testView e
   CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
   CRTimedAction _ _ -> []
   where
@@ -1737,8 +1737,8 @@ viewRemoteCtrl :: RemoteCtrlInfo -> StyledString
 viewRemoteCtrl RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName} =
   plain $ tshow remoteCtrlId <> ". " <> ctrlDeviceName
 
-viewChatError :: ChatLogLevel -> ChatError -> [StyledString]
+viewChatError :: ChatLogLevel -> Bool -> ChatError -> [StyledString]
-viewChatError logLevel = \case
+viewChatError logLevel testView = \case
   ChatError err -> case err of
     CENoActiveUser -> ["error: active user is required"]
     CENoConnectionUser agentConnId -> ["error: message user not found, conn id: " <> sShow agentConnId | logLevel <= CLLError]
@@ -1848,6 +1848,9 @@ viewChatError logLevel = \case
     SEGroupLinkNotFound g -> ["no group link, to create: " <> highlight ("/create link #" <> viewGroupName g)]
     SERemoteCtrlNotFound rcId -> ["no remote controller " <> sShow rcId]
     SERemoteHostNotFound rhId -> ["no remote host " <> sShow rhId]
+    SEDuplicateGroupMessage {groupId, sharedMsgId}
+      | testView -> ["duplicate group message, group id: " <> sShow groupId <> ", message id: " <> sShow sharedMsgId]
+      | otherwise -> []
     e -> ["chat db error: " <> sShow e]
   ChatErrorDatabase err -> case err of
     DBErrorEncrypted -> ["error: chat database is already encrypted"]

tests/ChatTests/Groups.hs

@@ -9,6 +9,7 @@ import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (concurrently_)
 import Control.Monad (when, void)
 import qualified Data.ByteString as B
+import Data.List (isInfixOf)
 import qualified Data.Text as T
 import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
 import Simplex.Chat.Protocol (supportedChatVRange)
@@ -107,6 +108,7 @@ chatGroupTests = do
     it "sends and updates profile when creating contact" testMemberContactProfileUpdate
   describe "group message forwarding" $ do
     it "forward messages between invitee and introduced (x.msg.new)" testGroupMsgForward
+    it "deduplicate forwarded messages" testGroupMsgForwardDeduplicate
     it "forward message edit (x.msg.update)" testGroupMsgForwardEdit
     it "forward message reaction (x.msg.react)" testGroupMsgForwardReaction
     it "forward message deletion (x.msg.del)" testGroupMsgForwardDeletion
@@ -3947,6 +3949,44 @@ setupGroupForwarding3 gName alice bob cath = do
   void $ withCCTransaction alice $ \db ->
     DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'"
 
+testGroupMsgForwardDeduplicate :: HasCallStack => FilePath -> IO ()
+testGroupMsgForwardDeduplicate =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup3 "team" alice bob cath
+
+      threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected
+
+      void $ withCCTransaction alice $ \db ->
+        DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'"
+
+      bob #> "#team hi there"
+      alice <# "#team bob> hi there"
+      cath
+        <### [ Predicate ("#team bob> hi there" `isInfixOf`),
+               StartsWith "duplicate group message, group id: 1"
+             ]
+
+      threadDelay 1000000
+
+      -- cath sends x.grp.mem.con on deduplication, so alice doesn't forward anymore
+
+      cath #> "#team hey team"
+      alice <# "#team cath> hey team"
+      bob <# "#team cath> hey team"
+
+      alice ##> "/tail #team 2"
+      alice <# "#team bob> hi there"
+      alice <# "#team cath> hey team"
+
+      bob ##> "/tail #team 2"
+      bob <# "#team hi there"
+      bob <# "#team cath> hey team"
+
+      cath ##> "/tail #team 2"
+      cath <#. "#team bob> hi there"
+      cath <# "#team hey team"
+
 testGroupMsgForwardEdit :: HasCallStack => FilePath -> IO ()
 testGroupMsgForwardEdit =
   testChat3 aliceProfile bobProfile cathProfile $

tests/ChatTests/Utils.hs

@@ -282,8 +282,12 @@ cc <##.. ls = do
   unless prefix $ print ("expected to start from one of: " <> show ls, ", got: " <> l)
   prefix `shouldBe` True
 
-data ConsoleResponse = ConsoleString String | WithTime String | EndsWith String | StartsWith String
+data ConsoleResponse
-  deriving (Show)
+  = ConsoleString String
+  | WithTime String
+  | EndsWith String
+  | StartsWith String
+  | Predicate (String -> Bool)
 
 instance IsString ConsoleResponse where fromString = ConsoleString
 
@@ -303,6 +307,7 @@ getInAnyOrder f cc ls = do
       WithTime s -> dropTime_ l == Just s
       EndsWith s -> s `isSuffixOf` l
       StartsWith s -> s `isPrefixOf` l
+      Predicate p -> p l
     filterFirst :: (a -> Bool) -> [a] -> [a]
     filterFirst _ [] = []
     filterFirst p (x:xs)