diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index bf568f7946..587f948941 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -678,7 +678,7 @@ processChatCommand' vr = \case let msgIds = itemsMsgIds items events = L.nonEmpty $ map (`XMsgDel` Nothing) msgIds mapM_ (sendGroupMessages user gInfo ms) events - delGroupChatItems user gInfo items Nothing + delGroupChatItems user gInfo items False CTLocal -> do (nf, items) <- getCommandLocalChatItems user chatId itemIds deleteLocalCIs user nf items True False @@ -706,7 +706,7 @@ processChatCommand' vr = \case let msgMemIds = itemsMsgMemIds gInfo items events = L.nonEmpty $ map (\(msgId, memId) -> XMsgDel msgId (Just memId)) msgMemIds mapM_ (sendGroupMessages user gInfo ms) events - delGroupChatItems user gInfo items (Just membership) + delGroupChatItems user gInfo items True where assertDeletable :: GroupInfo -> [CChatItem 'CTGroup] -> CM () assertDeletable GroupInfo {membership = GroupMember {memberRole = membershipMemRole}} items = @@ -2707,15 +2707,16 @@ processChatCommand' vr = \case when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g) when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved unless (memberActive membership) $ throwChatError CEGroupMemberNotActive - delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Maybe GroupMember -> CM ChatResponse - delGroupChatItems user gInfo items byGroupMember = do + delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> CM ChatResponse + delGroupChatItems user gInfo@GroupInfo {membership} items moderation = do deletedTs <- liftIO getCurrentTime - forM_ byGroupMember $ \byMember -> do - ciIds <- concat <$> withStore' (\db -> forM items $ \(CChatItem _ ci) -> markMessageReportsDeleted db user gInfo ci byMember deletedTs) - unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds False (Just byMember) - if groupFeatureAllowed SGFFullDelete gInfo - then deleteGroupCIs user gInfo items True False byGroupMember deletedTs - else markGroupCIsDeleted user gInfo items True byGroupMember deletedTs + when moderation $ do + ciIds <- concat <$> withStore' (\db -> forM items $ \(CChatItem _ ci) -> markMessageReportsDeleted db user gInfo ci membership deletedTs) + unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds False (Just membership) + let m = if moderation then Just membership else Nothing + if groupFeatureMemberAllowed SGFFullDelete membership gInfo + then deleteGroupCIs user gInfo items True False m deletedTs + else markGroupCIsDeleted user gInfo items True m deletedTs updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse updateGroupProfileByName gName update = withUser $ \user -> do g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db -> @@ -3919,7 +3920,7 @@ chatCommandP = "/set reactions #" *> (SetGroupFeature (AGFNR SGFReactions) <$> displayNameP <*> (A.space *> strP)), "/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayNameP <*> optional (A.space *> strP)), "/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP), - "/set delete #" *> (SetGroupFeature (AGFNR SGFFullDelete) <$> displayNameP <*> (A.space *> strP)), + "/set delete #" *> (SetGroupFeatureRole (AGFR SGFFullDelete) <$> displayNameP <*> _strP <*> optional memberRole), "/set delete @" *> (SetContactFeature (ACF SCFFullDelete) <$> displayNameP <*> optional (A.space *> strP)), "/set delete " *> (SetUserFeature (ACF SCFFullDelete) <$> strP), "/set direct #" *> (SetGroupFeatureRole (AGFR SGFDirectMessages) <$> displayNameP <*> _strP <*> optional memberRole), diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index e55e160df0..abef8b579b 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -1742,7 +1742,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = live' = fromMaybe False live_ ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc createBlockedByAdmin - | groupFeatureAllowed SGFFullDelete gInfo = do + | groupFeatureAllowed SGFFullDelete gInfo = do -- ignores member role when blocked by admin ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvBlocked Nothing timed' False ci' <- withStore' $ \db -> updateGroupCIBlockedByAdmin db user gInfo ci brokerTs groupMsgToView gInfo ci' @@ -1754,7 +1754,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = applyModeration CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, moderatedAt} | moderatorRole < GRModerator || moderatorRole < memberRole = createContentItem - | groupFeatureAllowed SGFFullDelete gInfo = do + | groupFeatureMemberAllowed SGFFullDelete moderator gInfo = do ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed' False ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt groupMsgToView gInfo ci' @@ -1854,7 +1854,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | otherwise = a delete :: CChatItem 'CTGroup -> Maybe GroupMember -> CM ChatResponse delete cci byGroupMember - | groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCIs user gInfo [cci] False False byGroupMember brokerTs + | groupFeatureMemberAllowed SGFFullDelete m gInfo = deleteGroupCIs user gInfo [cci] False False byGroupMember brokerTs | otherwise = markGroupCIsDeleted user gInfo [cci] False byGroupMember brokerTs archiveMessageReports :: CChatItem 'CTGroup -> GroupMember -> CM () archiveMessageReports (CChatItem _ ci) byMember = do diff --git a/src/Simplex/Chat/Types/Preferences.hs b/src/Simplex/Chat/Types/Preferences.hs index 07e32e7d56..001dd27172 100644 --- a/src/Simplex/Chat/Types/Preferences.hs +++ b/src/Simplex/Chat/Types/Preferences.hs @@ -377,7 +377,7 @@ defaultGroupPrefs = FullGroupPreferences { timedMessages = TimedMessagesGroupPreference {enable = FEOff, ttl = Just 86400}, directMessages = DirectMessagesGroupPreference {enable = FEOff, role = Nothing}, - fullDelete = FullDeleteGroupPreference {enable = FEOff}, + fullDelete = FullDeleteGroupPreference {enable = FEOn, role = Just GRModerator}, reactions = ReactionsGroupPreference {enable = FEOn}, voice = VoiceGroupPreference {enable = FEOn, role = Nothing}, files = FilesGroupPreference {enable = FEOn, role = Nothing}, @@ -392,7 +392,7 @@ businessGroupPrefs :: Preferences -> GroupPreferences businessGroupPrefs Preferences {timedMessages, fullDelete, reactions, voice} = defaultBusinessGroupPrefs { timedMessages = Just TimedMessagesGroupPreference {enable = maybe FEOff enableFeature timedMessages, ttl = maybe Nothing prefParam timedMessages}, - fullDelete = Just FullDeleteGroupPreference {enable = maybe FEOff enableFeature fullDelete}, + fullDelete = Just FullDeleteGroupPreference {enable = maybe FEOff enableFeature fullDelete, role = Just GRModerator}, reactions = Just ReactionsGroupPreference {enable = maybe FEOn enableFeature reactions}, voice = Just VoiceGroupPreference {enable = maybe FEOff enableFeature voice, role = Nothing} } @@ -407,7 +407,7 @@ defaultBusinessGroupPrefs = GroupPreferences { timedMessages = Just $ TimedMessagesGroupPreference FEOff Nothing, directMessages = Just $ DirectMessagesGroupPreference FEOff Nothing, - fullDelete = Just $ FullDeleteGroupPreference FEOff, + fullDelete = Just $ FullDeleteGroupPreference FEOn (Just GRModerator), reactions = Just $ ReactionsGroupPreference FEOn, voice = Just $ VoiceGroupPreference FEOff Nothing, files = Just $ FilesGroupPreference FEOn Nothing, @@ -493,7 +493,7 @@ data DirectMessagesGroupPreference = DirectMessagesGroupPreference deriving (Eq, Show) data FullDeleteGroupPreference = FullDeleteGroupPreference - {enable :: GroupFeatureEnabled} + {enable :: GroupFeatureEnabled, role :: Maybe GroupMemberRole} deriving (Eq, Show) data ReactionsGroupPreference = ReactionsGroupPreference @@ -569,7 +569,7 @@ instance GroupFeatureI 'GFFullDelete where type GroupFeaturePreference 'GFFullDelete = FullDeleteGroupPreference sGroupFeature = SGFFullDelete groupPrefParam _ = Nothing - groupPrefRole _ = Nothing + groupPrefRole FullDeleteGroupPreference {role} = role instance GroupFeatureI 'GFReactions where type GroupFeaturePreference 'GFReactions = ReactionsGroupPreference @@ -612,6 +612,9 @@ instance GroupFeatureNoRoleI 'GFHistory instance HasField "role" DirectMessagesGroupPreference (Maybe GroupMemberRole) where hasField p@DirectMessagesGroupPreference {role} = (\r -> p {role = r}, role) +instance HasField "role" FullDeleteGroupPreference (Maybe GroupMemberRole) where + hasField p@FullDeleteGroupPreference {role} = (\r -> p {role = r}, role) + instance HasField "role" VoiceGroupPreference (Maybe GroupMemberRole) where hasField p@VoiceGroupPreference {role} = (\r -> p {role = r}, role) @@ -623,6 +626,8 @@ instance HasField "role" SimplexLinksGroupPreference (Maybe GroupMemberRole) whe instance GroupFeatureRoleI 'GFDirectMessages +instance GroupFeatureRoleI 'GFFullDelete + instance GroupFeatureRoleI 'GFVoice instance GroupFeatureRoleI 'GFFiles diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 6042d19195..4bf5003a31 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -1249,6 +1249,7 @@ testGroupMessageDelete = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath threadDelay 1000000 -- alice, bob: msg id 5, cath: msg id 4 (after group invitations & group events) alice #> "#team hello!" @@ -1260,7 +1261,7 @@ testGroupMessageDelete = msgItemId1 <- lastItemId alice alice #$> ("/_delete item #1 " <> msgItemId1 <> " internal", id, "message deleted") - alice #$> ("/_get chat #1 count=1", chat, [(0, "connected")]) + alice #$> ("/_get chat #1 count=2", chat, [(0, "connected"), (1, "Full deletion: off")]) bob #$> ("/_get chat #1 count=1", chat, [(0, "hello!")]) cath #$> ("/_get chat #1 count=1", chat, [(0, "hello!")]) @@ -1286,7 +1287,7 @@ testGroupMessageDelete = msgItemId2 <- lastItemId alice alice #$> ("/_delete item #1 " <> msgItemId2 <> " internal", id, "message deleted") - alice #$> ("/_get chat #1 count=1", chat', [((0, "connected"), Nothing)]) + alice #$> ("/_get chat #1 count=2", chat', [((0, "connected"), Nothing), ((1, "Full deletion: off"), Nothing)]) bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))]) cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))]) @@ -1333,6 +1334,7 @@ testGroupMessageDeleteMultiple = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath threadDelay 1000000 alice #> "#team hello" @@ -1369,6 +1371,7 @@ testGroupMessageDeleteMultipleManyBatches = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath bob ##> "/set receipts all off" bob <## "ok" @@ -1606,6 +1609,9 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile alice ##> "/g team" alice <## "group #team is created" alice <## "to add members use /a team or /create link #team" + alice ##> "/set delete #team off" + alice <## "updated group preferences:" + alice <## "Full deletion: off" addMember "team" alice bob GRAdmin bob ##> "/j team" concurrentlyN_ @@ -1676,6 +1682,7 @@ testGroupModerate = testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath alice ##> "/mr team cath member" concurrentlyN_ [ alice <## "#team: you changed the role of cath from admin to member", @@ -1707,6 +1714,7 @@ testGroupModerateOwn = testChat2 aliceProfile bobProfile $ \alice bob -> do createGroup2 "team" alice bob + disableFullDeletion2 "team" alice bob threadDelay 1000000 alice #> "#team hello" bob <# "#team alice> hello" @@ -1721,6 +1729,7 @@ testGroupModerateMultiple = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath threadDelay 1000000 alice #> "#team hello" @@ -1756,6 +1765,7 @@ testGroupModerateFullDelete = testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath alice ##> "/mr team cath member" concurrentlyN_ [ alice <## "#team: you changed the role of cath from admin to member", @@ -1794,6 +1804,7 @@ testGroupDelayedModeration ps = do withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do withNewTestChatCfg ps cfg "bob" bobProfile $ \bob -> do createGroup2 "team" alice bob + disableFullDeletion2 "team" alice bob withNewTestChatCfg ps cfg "cath" cathProfile $ \cath -> do connectUsers alice cath addMember "team" alice cath GRMember @@ -1840,6 +1851,7 @@ testGroupDelayedModerationFullDelete ps = do withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do withNewTestChatCfg ps cfg "bob" bobProfile $ \bob -> do createGroup2 "team" alice bob + disableFullDeletion2 "team" alice bob withNewTestChatCfg ps cfg "cath" cathProfile $ \cath -> do connectUsers alice cath addMember "team" alice cath GRMember @@ -4775,6 +4787,7 @@ testGroupMsgForwardDeletion = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do setupGroupForwarding3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath bob #> "#team hi there" alice <# "#team bob> hi there" @@ -5492,6 +5505,7 @@ testGroupHistoryDeletedMessage = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup2 "team" alice bob + disableFullDeletion2 "team" alice bob alice #> "#team hello" bob <# "#team alice> hello" @@ -6181,6 +6195,7 @@ testBlockForAllMarkedBlocked = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath threadDelay 1000000 @@ -6268,6 +6283,7 @@ testBlockForAllFullDelete = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath alice ##> "/set delete #team on" alice <## "updated group preferences:" @@ -6348,6 +6364,7 @@ testBlockForAllAnotherAdminUnblocks = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath bob #> "#team 1" [alice, cath] *<# "#team bob> 1" @@ -6376,6 +6393,7 @@ testBlockForAllBeforeJoining = testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath bob #> "#team 1" [alice, cath] *<# "#team bob> 1" @@ -6444,6 +6462,7 @@ testBlockForAllCantRepeat = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath + disableFullDeletion3 "team" alice bob cath alice ##> "/unblock for all #team bob" alice <## "bad chat command: already unblocked" @@ -6560,6 +6579,7 @@ testGroupMemberReports = testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do createGroup3 "jokes" alice bob cath + disableFullDeletion3 "jokes" alice bob cath alice ##> "/mr jokes bob moderator" concurrentlyN_ [ alice <## "#jokes: you changed the role of bob from admin to moderator", diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 9dc7a10026..9cb8439500 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -300,7 +300,7 @@ groupFeatures'' dir = [ ((dir, e2eeInfoNoPQStr), Nothing, Nothing), ((dir, "Disappearing messages: off"), Nothing, Nothing), ((dir, "Direct messages: on"), Nothing, Nothing), - ((dir, "Full deletion: off"), Nothing, Nothing), + ((dir, "Full deletion: on for moderators"), Nothing, Nothing), ((dir, "Message reactions: on"), Nothing, Nothing), ((dir, "Voice messages: on"), Nothing, Nothing), ((dir, "Files and media: on"), Nothing, Nothing), @@ -632,6 +632,16 @@ createGroup2' gName cc1 cc2 doConnectUsers = do (cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group")) (cc2 <## ("#" <> gName <> ": you joined the group")) +disableFullDeletion2 :: HasCallStack => String -> TestCC -> TestCC -> IO () +disableFullDeletion2 gName cc1 cc2 = do + cc1 ##> ("/set delete #" <> gName <> " off") + cc1 <## "updated group preferences:" + cc1 <## "Full deletion: off" + name1 <- userName cc1 + cc2 <## (name1 <> " updated group #" <> gName <> ":") + cc2 <## "updated group preferences:" + cc2 <## "Full deletion: off" + createGroup3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO () createGroup3 gName cc1 cc2 cc3 = do createGroup2 gName cc1 cc2 @@ -652,6 +662,14 @@ createGroup3 gName cc1 cc2 cc3 = do cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected") ] +disableFullDeletion3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO () +disableFullDeletion3 gName cc1 cc2 cc3 = do + disableFullDeletion2 gName cc1 cc2 + name1 <- userName cc1 + cc3 <## (name1 <> " updated group #" <> gName <> ":") + cc3 <## "updated group preferences:" + cc3 <## "Full deletion: off" + create2Groups3 :: HasCallStack => String -> String -> TestCC -> TestCC -> TestCC -> IO () create2Groups3 gName1 gName2 cc1 cc2 cc3 = do createGroup3 gName1 cc1 cc2 cc3