From bd3325a889285d2ef53c338716a9b06c6d4ebb7a Mon Sep 17 00:00:00 2001 From: JRoberts <8711996+jr-simplex@users.noreply.github.com> Date: Wed, 8 Feb 2023 22:29:36 +0400 Subject: [PATCH] core: show/keep message as moderated for moderator (#1916) --- src/Simplex/Chat.hs | 14 ++++++------ src/Simplex/Chat/Messages.hs | 5 +++++ src/Simplex/Chat/View.hs | 41 +++++++++++++++++++++--------------- tests/ChatTests/Groups.hs | 8 +++---- 4 files changed, 40 insertions(+), 28 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 4107f43d16..3d07f6cfdf 100644 --- a/src/Simplex/Chat.hs +++ b/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 gInfo@GroupInfo {localDisplayName = gName} ci msgId = do + delGroupChatItem :: User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> m ChatResponse + 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 - else markGroupCIDeleted user gInfo ci msgId True Nothing + then deleteGroupCI user gInfo ci True False byGroupMember + 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 -> diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index f5a8c30468..d94cff5002 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/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} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index e99f800e57..5a20105b92 100644 --- a/src/Simplex/Chat/View.hs +++ b/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 (GroupChat GroupInfo {localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items, Nothing) - toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items, Nothing) - toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items, Just pccConnStatus) - toCIPreview :: [CChatItem c] -> Text - toCIPreview (ci : _) = testViewItem ci - toCIPreview _ = "" + toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items Nothing, Just $ connStatus activeConn) + 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, Nothing) + toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items Nothing, Just pccConnStatus) + toCIPreview :: [CChatItem c] -> Maybe GroupMember -> Text + toCIPreview (ci : _) membership_ = testViewItem ci membership_ + 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 _ ci@ChatItem {meta = CIMeta {itemText}}) = itemText <> maybe "" (\t -> " [" <> t <> "]") (chatItemDeletedText ci) + testViewItem :: CChatItem c -> Maybe GroupMember -> Text + 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 ci = deletedStateToText <$> chatItemDeletedState ci +chatItemDeletedText :: ChatItem c d -> Maybe GroupMember -> Maybe Text +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] diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 281d069cba..b09cd2a0ea 100644 --- a/tests/ChatTests/Groups.hs +++ b/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 ()