core: show/keep message as moderated for moderator (#1916)

src/Simplex/Chat.hs

@@ -557,19 +557,19 @@ processChatCommand = \case
         (CIDMBroadcast, SMDSnd, Just itemSharedMId) -> do
           assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier
           SndMessage {msgId} <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId Nothing
-          delGroupChatItem user gInfo ci msgId
+          delGroupChatItem user gInfo ci msgId Nothing
         (CIDMBroadcast, _, _) -> throwChatError CEInvalidChatItemDelete
     CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
     CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
   APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withChatLock "deleteChatItem" $ do
-    Group gInfo ms <- withStore $ \db -> getGroup db user gId
+    Group gInfo@GroupInfo {membership} ms <- withStore $ \db -> getGroup db user gId
     ci@(CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) <- withStore $ \db -> getGroupChatItem db user gId itemId
     case (chatDir, itemSharedMsgId) of
       (CIGroupRcv GroupMember {groupMemberId, memberRole, memberId}, Just itemSharedMId) -> do
         when (groupMemberId /= mId) $ throwChatError CEInvalidChatItemDelete
         assertUserGroupRole gInfo $ max GRAdmin memberRole
         SndMessage {msgId} <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId $ Just memberId
-        delGroupChatItem user gInfo ci msgId
+        delGroupChatItem user gInfo ci msgId (Just membership)
       (_, _) -> throwChatError CEInvalidChatItemDelete
   APIChatRead (ChatRef cType chatId) fromToIds -> withUser $ \_ -> case cType of
     CTDirect -> do
@@ -1482,12 +1482,12 @@ processChatCommand = \case
       when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g)
       when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved
       unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
-    delGroupChatItem :: User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> m ChatResponse
+    delGroupChatItem :: User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> m ChatResponse
-    delGroupChatItem user gInfo@GroupInfo {localDisplayName = gName} ci msgId = do
+    delGroupChatItem user gInfo@GroupInfo {localDisplayName = gName} ci msgId byGroupMember = do
       setActive $ ActiveG gName
       if groupFeatureAllowed SGFFullDelete gInfo
-        then deleteGroupCI user gInfo ci True False Nothing
+        then deleteGroupCI user gInfo ci True False byGroupMember
-        else markGroupCIDeleted user gInfo ci msgId True Nothing
+        else markGroupCIDeleted user gInfo ci msgId True byGroupMember
     updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> m ChatResponse
     updateGroupProfileByName gName update = withUser $ \user -> do
       g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db ->

src/Simplex/Chat/Messages.hs

@@ -90,6 +90,11 @@ chatInfoToRef = \case
   ContactRequest UserContactRequest {contactRequestId} -> ChatRef CTContactRequest contactRequestId
   ContactConnection PendingContactConnection {pccConnId} -> ChatRef CTContactConnection pccConnId
 
+chatInfoMembership :: ChatInfo c -> Maybe GroupMember
+chatInfoMembership = \case
+  GroupChat GroupInfo {membership} -> Just membership
+  _ -> Nothing
+
 data JSONChatInfo
   = JCInfoDirect {contact :: Contact}
   | JCInfoGroup {groupInfo :: GroupInfo}

src/Simplex/Chat/View.hs

@@ -244,19 +244,19 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
     testViewChats chats = [sShow $ map toChatView chats]
       where
         toChatView :: AChat -> (Text, Text, Maybe ConnStatus)
-        toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items, Just $ connStatus activeConn)
+        toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items Nothing, Just $ connStatus activeConn)
-        toChatView (AChat _ (Chat (GroupChat GroupInfo {localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items, Nothing)
+        toChatView (AChat _ (Chat (GroupChat GroupInfo {membership, localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items (Just membership), Nothing)
-        toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items, Nothing)
+        toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items Nothing, Nothing)
-        toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items, Just pccConnStatus)
+        toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items Nothing, Just pccConnStatus)
-        toCIPreview :: [CChatItem c] -> Text
+        toCIPreview :: [CChatItem c] -> Maybe GroupMember -> Text
-        toCIPreview (ci : _) = testViewItem ci
+        toCIPreview (ci : _) membership_ = testViewItem ci membership_
-        toCIPreview _ = ""
+        toCIPreview _ _ = ""
     testViewChat :: AChat -> [StyledString]
-    testViewChat (AChat _ Chat {chatItems}) = [sShow $ map toChatView chatItems]
+    testViewChat (AChat _ Chat {chatInfo, chatItems}) = [sShow $ map toChatView chatItems]
       where
         toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text), Maybe String)
         toChatView ci@(CChatItem dir ChatItem {quotedItem, file}) =
-          ((msgDirectionInt $ toMsgDirection dir, testViewItem ci), qItem, fPath)
+          ((msgDirectionInt $ toMsgDirection dir, testViewItem ci (chatInfoMembership chatInfo)), qItem, fPath)
           where
             qItem = case quotedItem of
               Nothing -> Nothing
@@ -265,8 +265,10 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
             fPath = case file of
               Just CIFile {filePath = Just fp} -> Just fp
               _ -> Nothing
-    testViewItem :: CChatItem c -> Text
+    testViewItem :: CChatItem c -> Maybe GroupMember -> Text
-    testViewItem (CChatItem _ ci@ChatItem {meta = CIMeta {itemText}}) = itemText <> maybe "" (\t -> " [" <> t <> "]") (chatItemDeletedText ci)
+    testViewItem (CChatItem _ ci@ChatItem {meta = CIMeta {itemText}}) membership_ =
+      let deleted_ = maybe "" (\t -> " [" <> t <> "]") (chatItemDeletedText ci membership_)
+       in itemText <> deleted_
     viewErrorsSummary :: [a] -> StyledString -> [StyledString]
     viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)]
     contactList :: [ContactRef] -> String
@@ -276,14 +278,17 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
       | muted chat chatItem = []
       | otherwise = s
 
-chatItemDeletedText :: ChatItem c d -> Maybe Text
+chatItemDeletedText :: ChatItem c d -> Maybe GroupMember -> Maybe Text
-chatItemDeletedText ci = deletedStateToText <$> chatItemDeletedState ci
+chatItemDeletedText ci membership_ = deletedStateToText <$> chatItemDeletedState ci
   where
     deletedStateToText = \CIDeletedState {markedDeleted, deletedByMember} ->
       if markedDeleted
         then "marked deleted" <> byMember deletedByMember
         else "deleted" <> byMember deletedByMember
-    byMember m_ = maybe "" (\GroupMember {localDisplayName = m} -> " by " <> m) m_
+    byMember m_ = case (m_, membership_) of
+      (Just GroupMember {groupMemberId = mId, localDisplayName = n}, Just GroupMember {groupMemberId = membershipId}) ->
+        " by " <> if mId == membershipId then "you" else n
+      _ -> ""
 
 viewUsersList :: [UserInfo] -> [StyledString]
 viewUsersList = map userInfo . sortOn ldn
@@ -325,7 +330,7 @@ viewChats ts = concatMap chatPreview . reverse
           _ -> []
 
 viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString]
-viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemDeleted}, content, quotedItem, file} doShow ts =
+viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} doShow ts =
   withItemDeleted <$> case chat of
     DirectChat c -> case chatDir of
       CIDirectSnd -> case content of
@@ -361,7 +366,9 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemDeleted}, conten
         quote = maybe [] (groupQuote g) quotedItem
     _ -> []
   where
-    withItemDeleted item = if isJust itemDeleted then item <> styled (colored Red) (T.unpack $ maybe "" (\t -> " [" <> t <> "]") (chatItemDeletedText ci)) else item
+    withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of
+      Nothing -> item
+      Just t -> item <> styled (colored Red) (" [" <> t <> "]")
     withSndFile = withFile viewSentFileInvitation
     withRcvFile = withFile viewReceivedFileInvitation
     withFile view dir l = maybe l (\f -> l <> view dir f ts meta) file
@@ -434,7 +441,7 @@ viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} toItem by
     deletedText_ :: Maybe Text
     deletedText_ = case toItem of
       Nothing -> Just "deleted"
-      Just (AChatItem _ _ _ ci) -> chatItemDeletedText ci
+      Just (AChatItem _ _ _ ci) -> chatItemDeletedText ci $ chatInfoMembership chat
     prohibited = [styled (colored Red) ("[unexpected message deletion, please report to developers]" :: String)]
 
 directQuote :: forall d'. MsgDirectionI d' => CIDirection 'CTDirect d' -> CIQuote 'CTDirect -> [StyledString]

tests/ChatTests/Groups.hs

@@ -1220,12 +1220,12 @@ testGroupMemberMessageDelete =
         (alice <# "#team cath> hi")
         (bob <# "#team cath> hi")
       bob ##> "\\\\ #team @cath hi"
-      bob <## "message marked deleted"
+      bob <## "message marked deleted by you"
       concurrently_
         (alice <# "#team cath> [marked deleted by bob] hi")
         (cath <# "#team cath> [marked deleted by bob] hi")
       alice #$> ("/_get chat #1 count=1", chat, [(0, "hi [marked deleted by bob]")])
-      bob #$> ("/_get chat #1 count=1", chat, [(0, "hi [marked deleted]")])
+      bob #$> ("/_get chat #1 count=1", chat, [(0, "hi [marked deleted by you]")])
       cath #$> ("/_get chat #1 count=1", chat, [(1, "hi [marked deleted by bob]")])
 
 testGroupMemberMessageFullDelete :: HasCallStack => FilePath -> IO ()
@@ -1258,12 +1258,12 @@ testGroupMemberMessageFullDelete =
         (alice <# "#team cath> hi")
         (bob <# "#team cath> hi")
       bob ##> "\\\\ #team @cath hi"
-      bob <## "message deleted"
+      bob <## "message deleted by you"
       concurrently_
         (alice <# "#team cath> [deleted by bob] hi")
         (cath <# "#team cath> [deleted by bob] hi")
       alice #$> ("/_get chat #1 count=1", chat, [(0, "moderated [deleted by bob]")])
-      bob #$> ("/_get chat #1 count=1", chat, [(0, "Full deletion: on")]) -- fully deleted for bob
+      bob #$> ("/_get chat #1 count=1", chat, [(0, "moderated [deleted by you]")])
       cath #$> ("/_get chat #1 count=1", chat, [(1, "moderated [deleted by bob]")])
 
 testGroupAsync :: HasCallStack => FilePath -> IO ()