diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index f8285770e0..e13dbfcbff 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -2932,7 +2932,7 @@ callTimed ct aciContent = case aciContentCallStatus aciContent of Just callStatus | callComplete callStatus -> do - contactCITimed ct + contactCITimed ct _ -> pure Nothing where aciContentCallStatus :: ACIContent -> Maybe CICallStatus @@ -4269,12 +4269,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Right (ACMsg _ chatMsg) -> processEvent chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e Left e -> toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) + forwardMsg_ `catchChatError` \_ -> pure () checkSendRcpt $ rights aChatMsgs - -- currently only a single message is forwarded - let GroupMember {memberRole = membershipMemRole} = membership - when (membershipMemRole >= GRAdmin && not (blockedByAdmin m)) $ case aChatMsgs of - [Right (ACMsg _ chatMsg)] -> forwardMsg_ chatMsg - _ -> pure () where aChatMsgs = parseChatMessages msgBody brokerTs = metaBrokerTs msgMeta @@ -4322,22 +4318,27 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = where aChatMsgHasReceipt (ACMsg _ ChatMessage {chatMsgEvent}) = hasDeliveryReceipt (toCMEventTag chatMsgEvent) - forwardMsg_ :: MsgEncodingI e => ChatMessage e -> CM () - forwardMsg_ chatMsg = - forM_ (forwardedGroupMsg chatMsg) $ \chatMsg' -> do - ChatConfig {highlyAvailable} <- asks config - -- members introduced to this invited member - introducedMembers <- - if memberCategory m == GCInviteeMember - then withStore' $ \db -> getForwardIntroducedMembers db vr user m highlyAvailable - else pure [] - -- invited members to which this member was introduced - invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db vr user m highlyAvailable - let GroupMember {memberId} = m - ms = forwardedToGroupMembers (introducedMembers <> invitedMembers) chatMsg' - msg = XGrpMsgForward memberId chatMsg' brokerTs - unless (null ms) . void $ - sendGroupMessage' user gInfo ms msg + forwardMsg_ :: CM () + forwardMsg_ = do + let GroupMember {memberRole = membershipMemRole} = membership + when (membershipMemRole >= GRAdmin && not (blockedByAdmin m)) $ case aChatMsgs of + -- currently only a single message is forwarded + [Right (ACMsg _ chatMsg)] -> + forM_ (forwardedGroupMsg chatMsg) $ \chatMsg' -> do + ChatConfig {highlyAvailable} <- asks config + -- members introduced to this invited member + introducedMembers <- + if memberCategory m == GCInviteeMember + then withStore' $ \db -> getForwardIntroducedMembers db vr user m highlyAvailable + else pure [] + -- invited members to which this member was introduced + invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db vr user m highlyAvailable + let GroupMember {memberId} = m + ms = forwardedToGroupMembers (introducedMembers <> invitedMembers) chatMsg' + msg = XGrpMsgForward memberId chatMsg' brokerTs + unless (null ms) . void $ + sendGroupMessage' user gInfo ms msg + _ -> pure () RCVD msgMeta msgRcpt -> withAckMessage' agentConnId msgMeta $ groupMsgReceived gInfo m conn msgMeta msgRcpt diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index ff577dc737..4d9d94e24d 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -120,6 +120,7 @@ chatGroupTests = do it "forward file (x.msg.file.descr)" testGroupMsgForwardFile it "forward role change (x.grp.mem.role)" testGroupMsgForwardChangeRole it "forward new member announcement (x.grp.mem.new)" testGroupMsgForwardNewMember + it "forward member leaving (x.grp.leave)" testGroupMsgForwardLeave describe "group history" $ do it "text messages" testGroupHistory it "history is sent when joining via group link" testGroupHistoryGroupLink @@ -4437,6 +4438,18 @@ testGroupMsgForwardNewMember = "dan (Daniel): member" ] +testGroupMsgForwardLeave :: HasCallStack => FilePath -> IO () +testGroupMsgForwardLeave = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + setupGroupForwarding3 "team" alice bob cath + + bob ##> "/leave #team" + bob <## "#team: you left the group" + bob <## "use /d #team to delete the group" + alice <## "#team: bob left the group" + cath <## "#team: bob left the group" + testGroupHistory :: HasCallStack => FilePath -> IO () testGroupHistory = testChat3 aliceProfile bobProfile cathProfile $