From a9600200837ce4f2c706915d1eb6ad6f4be31d81 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 4 Sep 2025 15:56:46 +0400 Subject: [PATCH] core: correct member attention stat for support chat on opening it --- src/Simplex/Chat/Library/Commands.hs | 30 +++++++++++++++++++++++++- src/Simplex/Chat/Store/Messages.hs | 5 +++++ tests/ChatTests/Groups.hs | 32 ++++++++++++++++++++++++++++ 3 files changed, 66 insertions(+), 1 deletion(-) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index b6b7dbe87c..25577841b6 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -517,13 +517,41 @@ processChatCommand vr nm = \case pure $ CRApiChat user (AChat SCTDirect directChat) navInfo CTGroup -> do (groupChat, navInfo) <- withFastStore (\db -> getGroupChat db vr user cId scope_ contentFilter pagination search) - pure $ CRApiChat user (AChat SCTGroup groupChat) navInfo + groupChat' <- checkSupportChatAttention user groupChat + pure $ CRApiChat user (AChat SCTGroup groupChat') navInfo CTLocal -> do when (isJust contentFilter) $ throwCmdError "content filter not supported" (localChat, navInfo) <- withFastStore (\db -> getLocalChat db user cId pagination search) pure $ CRApiChat user (AChat SCTLocal localChat) navInfo CTContactRequest -> throwCmdError "not implemented" CTContactConnection -> throwCmdError "not supported" + where + checkSupportChatAttention :: User -> Chat 'CTGroup -> CM (Chat 'CTGroup) + checkSupportChatAttention user groupChat@Chat {chatInfo, chatItems} = + case chatInfo of + GroupChat gInfo (Just GCSIMemberSupport {groupMember_ = Just scopeMem}) -> do + case correctedMemAttention scopeMem chatItems of + Just newMemAttention -> do + scopeMem' <- withFastStore $ \db -> do + liftIO $ setSupportChatMemberAttention db (groupMemberId' scopeMem) newMemAttention + getGroupMemberById db vr user (groupMemberId' scopeMem) + pure $ groupChat {chatInfo = GroupChat gInfo (Just $ GCSIMemberSupport (Just scopeMem'))} + Nothing -> pure groupChat + _ -> pure groupChat + where + correctedMemAttention :: GroupMember -> [CChatItem 'CTGroup] -> Maybe Int64 + correctedMemAttention scopeMem@GroupMember {supportChat} items = + let numNewFromMember = fromIntegral . length . takeWhile newFromMember $ reverse items + memAttention = maybe 0 memberAttention supportChat + in + if numNewFromMember /= memAttention + then Just numNewFromMember + else Nothing + where + newFromMember :: CChatItem 'CTGroup -> Bool + newFromMember (CChatItem _ ChatItem {chatDir = CIGroupRcv m, meta = CIMeta {itemStatus = CISRcvNew}}) + | groupMemberId' m == groupMemberId' scopeMem = True + newFromMember _ = False APIGetChatItems pagination search -> withUser $ \user -> do chatItems <- withFastStore $ \db -> getAllChatItems db vr user pagination search pure $ CRChatItems user Nothing chatItems diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index d1c147d43c..ded07716f7 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -38,6 +38,7 @@ module Simplex.Chat.Store.Messages MemberAttention (..), updateChatTsStats, setSupportChatTs, + setSupportChatMemberAttention, createNewSndChatItem, createNewRcvChatItem, createNewChatItemNoMsg, @@ -496,6 +497,10 @@ setSupportChatTs :: DB.Connection -> GroupMemberId -> UTCTime -> IO () setSupportChatTs db groupMemberId chatTs = DB.execute db "UPDATE group_members SET support_chat_ts = ? WHERE group_member_id = ?" (chatTs, groupMemberId) +setSupportChatMemberAttention :: DB.Connection -> GroupMemberId -> Int64 -> IO () +setSupportChatMemberAttention db groupMemberId memberAttention = + DB.execute db "UPDATE group_members SET support_chat_items_member_attention = ? WHERE group_member_id = ?" (memberAttention, groupMemberId) + createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem itemForwarded timed live createdAt = createNewChatItem_ db user chatDirection False createdByMsgId (Just sharedMsgId) ciContent quoteRow itemForwarded timed live False createdAt Nothing createdAt diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 365bd16f71..981b46b5c8 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -18,6 +18,7 @@ import Control.Concurrent.Async (concurrently_) import Control.Monad (forM_, void, when) import Data.Bifunctor (second) import qualified Data.ByteString.Char8 as B +import Data.Int (Int64) import Data.List (intercalate, isInfixOf) import qualified Data.Map.Strict as M import qualified Data.Text as T @@ -219,6 +220,7 @@ chatGroupTests = do it "should send messages to admins and members" testSupportCLISendCommand it "should correctly maintain unread stats for support chats on reading chat items" testScopedSupportUnreadStatsOnRead it "should correctly maintain unread stats for support chats on deleting chat items" testScopedSupportUnreadStatsOnDelete + it "should correct member attention stat for support chat on opening it" testScopedSupportUnreadStatsCorrectOnOpen testGroupCheckMessages :: HasCallStack => TestParams -> IO () testGroupCheckMessages = @@ -8041,3 +8043,33 @@ testScopedSupportUnreadStatsOnDelete = testOpts { markRead = False } + +testScopedSupportUnreadStatsCorrectOnOpen :: HasCallStack => TestParams -> IO () +testScopedSupportUnreadStatsCorrectOnOpen = + testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> do + createGroup2 "team" alice bob + + bob #> "#team (support) 1" + alice <# "#team (support: bob) bob> 1" + + bob #> "#team (support) 2" + alice <# "#team (support: bob) bob> 2" + + alice ##> "/member support chats #team" + alice <## "bob (Bob) (id 2): unread: 2, require attention: 2, mentions: 0" + + void $ withCCTransaction alice $ \db -> + DB.execute db "UPDATE group_members SET support_chat_items_member_attention=100 WHERE group_member_id=?" (Only (2 :: Int64)) + + alice ##> "/member support chats #team" + alice <## "bob (Bob) (id 2): unread: 2, require attention: 100, mentions: 0" + + alice #$> ("/_get chat #1(_support:2) count=100", chat, [(0, "1"), (0, "2")]) + + alice ##> "/member support chats #team" + alice <## "bob (Bob) (id 2): unread: 2, require attention: 2, mentions: 0" + where + opts = + testOpts + { markRead = False + }