core: group snd status (#2763)

* core: group snd status

* schema, implementation

* refactor direct, tests

* configure, tests

* item info

* refactor

* refactor

* remove do

* rename

* remove receipts on events

* refactor

* refactor

* refactor

* refactor

* tests

* rename tests

* aggregates

* fix name

* refactor

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

src/Simplex/Chat/Store/Groups.hs

@@ -39,6 +39,7 @@ module Simplex.Chat.Store.Groups
     getGroupMemberById,
     getGroupMembers,
     getGroupMembersForExpiration,
+    getGroupCurrentMembersCount,
     deleteGroupConnectionsAndFiles,
     deleteGroupItemsAndMembers,
     deleteGroup,
@@ -548,6 +549,20 @@ toContactMember :: User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
 toContactMember User {userContactId} (memberRow :. connRow) =
   (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection connRow}
 
+getGroupCurrentMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int
+getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do
+  statuses :: [GroupMemberStatus] <-
+    map fromOnly
+      <$> DB.query
+        db
+        [sql|
+          SELECT member_status
+          FROM group_members
+          WHERE group_id = ? AND user_id = ?
+        |]
+        (groupId, userId)
+  pure $ length $ filter memberCurrent' statuses
+
 getGroupInvitation :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
 getGroupInvitation db user groupId =
   getConnRec_ user >>= \case

src/Simplex/Chat/Store/Messages.hs

@@ -44,6 +44,7 @@ module Simplex.Chat.Store.Messages
     createChatItemVersion,
     deleteDirectChatItem,
     markDirectChatItemDeleted,
+    updateGroupChatItemStatus,
     updateGroupChatItem,
     deleteGroupChatItem,
     updateGroupChatItemModerated,
@@ -69,6 +70,7 @@ module Simplex.Chat.Store.Messages
     getGroupChatItem,
     getGroupChatItemBySharedMsgId,
     getGroupMemberCIBySharedMsgId,
+    getGroupChatItemByAgentMsgId,
     getGroupMemberChatItemLast,
     getDirectChatItemIdByText,
     getDirectChatItemIdByText',
@@ -87,6 +89,11 @@ module Simplex.Chat.Store.Messages
     createCIModeration,
     getCIModeration,
     deleteCIModeration,
+    createGroupSndStatus,
+    getGroupSndStatus,
+    updateGroupSndStatus,
+    getGroupSndStatuses,
+    getGroupSndStatusCounts,
   )
 where
 
@@ -1325,6 +1332,16 @@ getDirectChatItemIdByText' db User {userId} contactId msg =
       |]
       (userId, contactId, msg <> "%")
 
+updateGroupChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> GroupId -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTGroup d)
+updateGroupChatItemStatus db user@User {userId} groupId itemId itemStatus = do
+  ci <- liftEither . correctDir =<< getGroupChatItem db user groupId itemId
+  currentTs <- liftIO getCurrentTime
+  liftIO $ DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?" (itemStatus, currentTs, userId, groupId, itemId)
+  pure ci {meta = (meta ci) {itemStatus}}
+  where
+    correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
+    correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
+
 updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d)
 updateGroupChatItem db user groupId ci newContent live msgId_ = do
   currentTs <- liftIO getCurrentTime
@@ -1434,6 +1451,11 @@ getGroupMemberCIBySharedMsgId db user@User {userId} groupId memberId sharedMsgId
         (GCUserMember, userId, groupId, memberId, sharedMsgId)
   getGroupChatItem db user groupId itemId
 
+getGroupChatItemByAgentMsgId :: DB.Connection -> User -> GroupId -> Int64 -> AgentMsgId -> IO (Maybe (CChatItem 'CTGroup))
+getGroupChatItemByAgentMsgId db user groupId connId msgId = do
+  itemId_ <- getChatItemIdByAgentMsgId db connId msgId
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupChatItem db user groupId) itemId_
+
 getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
 getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
   currentTs <- getCurrentTime
@@ -1847,3 +1869,58 @@ deleteCIModeration db GroupInfo {groupId} itemMemberId (Just sharedMsgId) =
     db
     "DELETE FROM chat_item_moderations WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?"
     (groupId, itemMemberId, sharedMsgId)
+
+createGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> IO ()
+createGroupSndStatus db itemId memberId status =
+  DB.execute
+    db
+    "INSERT INTO group_snd_item_statuses (chat_item_id, group_member_id, group_snd_item_status) VALUES (?,?,?)"
+    (itemId, memberId, status)
+
+getGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> ExceptT StoreError IO (CIStatus 'MDSnd)
+getGroupSndStatus db itemId memberId =
+  ExceptT . firstRow fromOnly (SENoGroupSndStatus itemId memberId) $
+    DB.query
+      db
+      [sql|
+        SELECT group_snd_item_status
+        FROM group_snd_item_statuses
+        WHERE chat_item_id = ? AND group_member_id = ?
+        LIMIT 1
+      |]
+      (itemId, memberId)
+
+updateGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> IO ()
+updateGroupSndStatus db itemId memberId status = do
+  currentTs <- liftIO getCurrentTime
+  DB.execute
+    db
+    [sql|
+      UPDATE group_snd_item_statuses
+      SET group_snd_item_status = ?, updated_at = ?
+      WHERE chat_item_id = ? AND group_member_id  = ?
+    |]
+    (status, currentTs, itemId, memberId)
+
+getGroupSndStatuses :: DB.Connection -> ChatItemId -> IO [(GroupMemberId, CIStatus 'MDSnd)]
+getGroupSndStatuses db itemId =
+  DB.query
+    db
+    [sql|
+      SELECT group_member_id, group_snd_item_status
+      FROM group_snd_item_statuses
+      WHERE chat_item_id = ?
+    |]
+    (Only itemId)
+
+getGroupSndStatusCounts :: DB.Connection -> ChatItemId -> IO [(CIStatus 'MDSnd, Int)]
+getGroupSndStatusCounts db itemId =
+  DB.query
+    db
+    [sql|
+      SELECT group_snd_item_status, COUNT(1)
+      FROM group_snd_item_statuses
+      WHERE chat_item_id = ?
+      GROUP BY group_snd_item_status
+    |]
+    (Only itemId)

src/Simplex/Chat/Store/Migrations.hs

@@ -74,6 +74,7 @@ import Simplex.Chat.Migrations.M20230608_deleted_contacts
 import Simplex.Chat.Migrations.M20230618_favorite_chats
 import Simplex.Chat.Migrations.M20230621_chat_item_moderations
 import Simplex.Chat.Migrations.M20230705_delivery_receipts
+import Simplex.Chat.Migrations.M20230721_group_snd_item_statuses
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -147,7 +148,8 @@ schemaMigrations =
     ("20230608_deleted_contacts", m20230608_deleted_contacts, Just down_m20230608_deleted_contacts),
     ("20230618_favorite_chats", m20230618_favorite_chats, Just down_m20230618_favorite_chats),
     ("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations),
-    ("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts)
+    ("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts),
+    ("20230721_group_snd_item_statuses", m20230721_group_snd_item_statuses, Just down_m20230721_group_snd_item_statuses)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/Store/Profiles.hs

@@ -30,6 +30,7 @@ module Simplex.Chat.Store.Profiles
     updateUserPrivacy,
     updateAllContactReceipts,
     updateUserContactReceipts,
+    updateUserGroupReceipts,
     updateUserProfile,
     setUserProfileContactLink,
     getUserContactProfiles,
@@ -92,7 +93,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
     when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
     let showNtfs = True
         sendRcptsContacts = True
-        sendRcptsSmallGroups = False
+        sendRcptsSmallGroups = True
     DB.execute
       db
       "INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,0,?,?,?,?,?)"
@@ -222,13 +223,21 @@ updateUserPrivacy db User {userId, showNtfs, viewPwdHash} =
 
 updateAllContactReceipts :: DB.Connection -> Bool -> IO ()
 updateAllContactReceipts db onOff =
-  DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE view_pwd_hash IS NULL" (Only onOff)
+  DB.execute
+    db
+    "UPDATE users SET send_rcpts_contacts = ?, send_rcpts_small_groups = ? WHERE view_pwd_hash IS NULL"
+    (onOff, onOff)
 
 updateUserContactReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
 updateUserContactReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
   DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE user_id = ?" (enable, userId)
   when clearOverrides $ DB.execute_ db "UPDATE contacts SET send_rcpts = NULL"
 
+updateUserGroupReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
+updateUserGroupReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
+  DB.execute db "UPDATE users SET send_rcpts_small_groups = ? WHERE user_id = ?" (enable, userId)
+  when clearOverrides $ DB.execute_ db "UPDATE groups SET send_rcpts = NULL"
+
 updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User
 updateUserProfile db user p'
   | displayName == newName = do

src/Simplex/Chat/Store/Shared.hs

@@ -92,6 +92,7 @@ data StoreError
   | SEGroupLinkNotFound {groupInfo :: GroupInfo}
   | SEHostMemberIdNotFound {groupId :: Int64}
   | SEContactNotFoundByFileId {fileId :: FileTransferId}
+  | SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
   deriving (Show, Exception, Generic)
 
 instance ToJSON StoreError where