core: role for full delete preference (#5572)

* core: role for full delete preference

* fix

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 -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> CM ChatResponse
-    delGroupChatItems user gInfo items byGroupMember = do
+    delGroupChatItems user gInfo@GroupInfo {membership} items moderation = do
       deletedTs <- liftIO getCurrentTime
-      forM_ byGroupMember $ \byMember -> do
+      when moderation $ do
-        ciIds <- concat <$> withStore' (\db -> forM items $ \(CChatItem _ ci) -> markMessageReportsDeleted db user gInfo ci byMember deletedTs)
+        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 byMember)
+        unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds False (Just membership)
-      if groupFeatureAllowed SGFFullDelete gInfo
+      let m = if moderation then Just membership else Nothing
-        then deleteGroupCIs user gInfo items True False byGroupMember deletedTs
+      if groupFeatureMemberAllowed SGFFullDelete membership gInfo
-        else markGroupCIsDeleted user gInfo items True byGroupMember deletedTs
+        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),

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

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

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 <name> 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",

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