core: member support chat stats (#5803)

* core: member support chat stats * schema * update counts * mark read wip * dec counts on read * rename * plans * test, fixes * plans * refactor * rename --------- Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2026-05-29 17:55:39 +00:00 · 2025-04-05 11:25:45 +00:00
parent c12817ac81
commit d85ac4af04
15 changed files with 475 additions and 216 deletions
@@ -989,7 +989,7 @@ processChatCommand' vr = \case
            pure $ prefix <> formattedDate <> ext
  APIUserRead userId -> withUserId userId $ \user -> withFastStore' (`setUserChatsRead` user) >> ok user
  UserRead -> withUser $ \User {userId} -> processChatCommand $ APIUserRead userId
-  APIChatRead chatRef@(ChatRef cType chatId _scope) -> withUser $ \_ -> case cType of
+  APIChatRead chatRef@(ChatRef cType chatId scope) -> withUser $ \_ -> case cType of
    CTDirect -> do
      user <- withFastStore $ \db -> getUserByContactId db chatId
      ts <- liftIO getCurrentTime
@@ -1000,11 +1000,14 @@ processChatCommand' vr = \case
      forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt
      ok user
    CTGroup -> do
-      user <- withFastStore $ \db -> getUserByGroupId db chatId
+      (user, gInfo) <- withFastStore $ \db -> do
+        user <- getUserByGroupId db chatId
+        gInfo <- getGroupInfo db vr user chatId
+        pure (user, gInfo)
      ts <- liftIO getCurrentTime
      timedItems <- withFastStore' $ \db -> do
        timedItems <- getGroupUnreadTimedItems db user chatId
-        updateGroupChatItemsRead db user chatId
+        updateGroupChatItemsRead db user gInfo scope
        setGroupChatItemsDeleteAt db user chatId timedItems ts
      forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt
      ok user
@@ -1014,8 +1017,7 @@ processChatCommand' vr = \case
      ok user
    CTContactRequest -> pure $ chatCmdError Nothing "not supported"
    CTContactConnection -> pure $ chatCmdError Nothing "not supported"
-  -- TODO [knocking] read scope?
-  APIChatItemsRead chatRef@(ChatRef cType chatId _scope) itemIds -> withUser $ \_ -> case cType of
+  APIChatItemsRead chatRef@(ChatRef cType chatId scope) itemIds -> withUser $ \_ -> case cType of
    CTDirect -> do
      user <- withFastStore $ \db -> getUserByContactId db chatId
      timedItems <- withFastStore' $ \db -> do
@@ -1024,9 +1026,12 @@ processChatCommand' vr = \case
      forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt
      ok user
    CTGroup -> do
-      user <- withFastStore $ \db -> getUserByGroupId db chatId
+      (user, gInfo) <- withFastStore $ \db -> do
+        user <- getUserByGroupId db chatId
+        gInfo <- getGroupInfo db vr user chatId
+        pure (user, gInfo)
      timedItems <- withFastStore' $ \db -> do
-        timedItems <- updateGroupChatItemsReadList db user chatId itemIds
+        timedItems <- updateGroupChatItemsReadList db user gInfo scope itemIds
        setGroupChatItemsDeleteAt db user chatId timedItems =<< getCurrentTime
      forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt
      ok user
@@ -2317,11 +2322,10 @@ processChatCommand' vr = \case
    groupId <- withFastStore $ \db -> getGroupIdByName db user gName
    processChatCommand $ APIListMembers groupId
  ListMemberSupportChats gName -> withUser $ \user -> do
-    gInfo <- withFastStore $ \db -> getGroupInfoByName db vr user gName
-    -- TODO [knocking] delete all support chats (chat items) if role is lowered?
-    assertUserGroupRole gInfo GRModerator
-    supportMems <- withFastStore' $ \db -> getSupportMembers db vr user gInfo
-    pure $ CRMemberSupportChats user gInfo supportMems
+    groupId <- withFastStore $ \db -> getGroupIdByName db user gName
+    (Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
+    let memberSupportChats = filter (isJust . supportChat) members
+    pure $ CRTerminalEvent $ TEMemberSupportChats user gInfo memberSupportChats
  APIListGroups userId contactId_ search_ -> withUserId userId $ \user ->
    CRGroupsList user <$> withFastStore' (\db -> getUserGroupsWithSummary db vr user contactId_ search_)
  ListGroups cName_ search_ -> withUser $ \user@User {userId} -> do
@@ -1354,16 +1354,16 @@ mkGetMessageChatScope vr user gInfo@GroupInfo {membership} m msgScope_ =
            pure (gInfo', m, Just scopeInfo)
        | otherwise -> do
            referredMember <- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo mId
-            -- TODO [knocking] return patched _referredMember too?
+            -- TODO [knocking] return patched _referredMember' too?
            (_referredMember', scopeInfo) <- liftIO $ mkMemberSupportChatInfo referredMember
            pure (gInfo, m, Just scopeInfo)

 mkGroupSupportChatInfo :: GroupInfo -> IO (GroupInfo, GroupChatScopeInfo)
-mkGroupSupportChatInfo gInfo@GroupInfo {modsSupportChat} =
-  case modsSupportChat of
+mkGroupSupportChatInfo gInfo@GroupInfo {membership} =
+  case supportChat membership of
    Nothing -> do
      chatTs <- getCurrentTime
-      let gInfo' = gInfo {modsSupportChat = Just $ GroupSupportChat chatTs True}
+      let gInfo' = gInfo {membership = membership {supportChat = Just $ GroupSupportChat chatTs 1 0 0}}
          scopeInfo = GCSIMemberSupport {groupMember_ = Nothing}
      pure (gInfo', scopeInfo)
    Just _supportChat ->
@@ -1375,7 +1375,7 @@ mkMemberSupportChatInfo m@GroupMember {supportChat} =
  case supportChat of
    Nothing -> do
      chatTs <- getCurrentTime
-      let m' = m {supportChat = Just $ GroupSupportChat chatTs True}
+      let m' = m {supportChat = Just $ GroupSupportChat chatTs 1 0 0}
          scopeInfo = GCSIMemberSupport {groupMember_ = Just m'}
      pure (m', scopeInfo)
    Just _supportChat ->
@@ -2008,7 +2008,7 @@ saveSndChatItems ::
 saveSndChatItems user cd itemsData itemTimed live = do
  createdAt <- liftIO getCurrentTime
  when (contactChatDeleted cd || any (\NewSndChatItemData {content} -> ciRequiresAttention content) (rights itemsData)) $
-    withStore' (\db -> updateChatTs db user cd createdAt)
+    withStore' (\db -> updateChatTsStats db user cd createdAt Nothing)
  lift $ withStoreBatch (\db -> map (bindRight $ createItem db createdAt) itemsData)
  where
    createItem :: DB.Connection -> UTCTime -> NewSndChatItemData c -> IO (Either ChatError (ChatItem c 'MDSnd))
@@ -2034,7 +2034,6 @@ saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c
 saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, forwardedByMember} sharedMsgId_ brokerTs (content, (t, ft_)) ciFile itemTimed live mentions = do
  createdAt <- liftIO getCurrentTime
  withStore' $ \db -> do
-    when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt
    (mentions' :: Map MemberName CIMention, userMention) <- case cd of
      CDGroupRcv g@GroupInfo {membership} _scope _m -> do
        mentions' <- getRcvCIMentions db user g ft_ mentions
@@ -2044,12 +2043,20 @@ saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, forwardedByMember} shared
            userMention' = userReply || any (\CIMention {memberId} -> sameMemberId memberId membership) mentions'
         in pure (mentions', userMention')
      CDDirectRcv _ -> pure (M.empty, False)
+    when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTsStats db user cd createdAt (chatStatsCounts userMention)
    (ciId, quotedItem, itemForwarded) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live userMention brokerTs createdAt
    forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
    let ci = mkChatItem_ cd ciId content (t, ft_) ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live userMention brokerTs forwardedByMember createdAt
    case cd of
      CDGroupRcv g _scope _m | not (null mentions') -> createGroupCIMentions db g ci mentions'
      _ -> pure ci
+  where
+    chatStatsCounts :: Bool -> Maybe (Int, MemberAttention, Int)
+    chatStatsCounts userMention = case cd of
+      CDGroupRcv _g (Just scope) m -> do
+        let unread = fromEnum $ ciCreateStatus content == CISRcvNew
+         in Just (unread, memberAttentionChange unread m scope, fromEnum userMention)
+      _ -> Nothing

 -- TODO [mentions] optimize by avoiding unnecessary parsing
 mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d
@@ -2268,14 +2275,28 @@ createInternalItemsForChats user itemTs_ dirsCIContents = do
  where
    updateChat :: DB.Connection -> UTCTime -> ChatDirection c d -> [CIContent d] -> IO ()
    updateChat db createdAt cd contents
-      | any ciRequiresAttention contents || contactChatDeleted cd = updateChatTs db user cd createdAt
+      | any ciRequiresAttention contents || contactChatDeleted cd = updateChatTsStats db user cd createdAt chatStatsCounts
      | otherwise = pure ()
+      where
+        chatStatsCounts :: Maybe (Int, MemberAttention, Int)
+        chatStatsCounts = case cd of
+          CDGroupRcv _g (Just scope) m -> do
+            let unread = length $ filter ciRequiresAttention contents
+             in Just (unread, memberAttentionChange unread m scope, 0)
+          _ -> Nothing
    createACIs :: DB.Connection -> UTCTime -> UTCTime -> ChatDirection c d -> [CIContent d] -> [IO AChatItem]
    createACIs db itemTs createdAt cd = map $ \content -> do
      ciId <- createNewChatItemNoMsg db user cd content itemTs createdAt
      let ci = mkChatItem cd ciId content Nothing Nothing Nothing Nothing Nothing False False itemTs Nothing createdAt
      pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci

+memberAttentionChange :: Int -> GroupMember -> GroupChatScopeInfo -> MemberAttention
+memberAttentionChange unread m = \case
+  GCSIMemberSupport (Just m')
+    | groupMemberId' m' == groupMemberId' m -> MAInc unread
+    | otherwise -> MAReset
+  GCSIMemberSupport Nothing -> MAInc 0
+
 createLocalChatItems ::
  User ->
  ChatDirection 'CTLocal 'MDSnd ->
@@ -2283,7 +2304,7 @@ createLocalChatItems ::
  UTCTime ->
  CM [ChatItem 'CTLocal 'MDSnd]
 createLocalChatItems user cd itemsData createdAt = do
-  withStore' $ \db -> updateChatTs db user cd createdAt
+  withStore' $ \db -> updateChatTsStats db user cd createdAt Nothing
  (errs, items) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (createItem db) $ L.toList itemsData)
  unless (null errs) $ toView $ CRChatErrors (Just user) errs
  pure items
@@ -2076,7 +2076,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
    xInfoMember gInfo m p' brokerTs = void $ processMemberProfileUpdate gInfo m p' True (Just brokerTs)

    xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> CM ()
-    xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory, memberStatus} Connection {viaGroupLink} p' = do
+    xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do
      xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId
      if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived
        then do
@@ -2087,7 +2087,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
        else messageError "x.grp.link.mem error: invalid group link host profile update"

    xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupMemberRole -> MemberId -> CM ()
-    xGrpLinkAcpt gInfo@GroupInfo {groupId, membership} m role memberId
+    xGrpLinkAcpt gInfo@GroupInfo {membership} m role memberId
      | sameMemberId memberId membership = processUserAccepted
      | otherwise =
          withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case