diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 119d19e62..fc37569fd 100644 --- a/src/Simplex/Chat/View.hs +++ b/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 - CRChatError u e -> ttyUser' u $ viewChatError logLevel e + CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel testView 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 logLevel = \case +viewChatError :: ChatLogLevel -> Bool -> ChatError -> [StyledString] +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"] diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 9278d4071..03ddf7d57 100644 --- a/tests/ChatTests/Groups.hs +++ b/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 $ diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 83b0d507b..40fe0e6da 100644 --- a/tests/ChatTests/Utils.hs +++ b/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 - deriving (Show) +data ConsoleResponse + = 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)