core: Forcing chat unread (#1228)

* core: Forcing chat unread * Implementation * Renaming * Removed unused code * test Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
2022-10-19 21:38:44 +03:00
parent e0582d656e
commit 213b586f8f
8 changed files with 69 additions and 55 deletions
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -56,6 +56,7 @@ library
      Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
      Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
      Simplex.Chat.Migrations.M20221012_inline_files
+      Simplex.Chat.Migrations.M20221019_unread_chat
      Simplex.Chat.Mobile
      Simplex.Chat.Options
      Simplex.Chat.ProfileGenerator
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -471,6 +471,18 @@ processChatCommand = \case
    CTGroup -> withStore' (\db -> updateGroupChatItemsRead db chatId fromToIds) $> CRCmdOk
    CTContactRequest -> pure $ chatCmdError "not supported"
    CTContactConnection -> pure $ chatCmdError "not supported"
+  APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user@User {userId} -> case cType of
+    CTDirect -> do
+      _ <- withStore $ \db -> do
+        Contact {contactId} <- getContact db userId chatId
+        liftIO $ updateContactUnreadChat db user contactId unreadChat
+      pure CRCmdOk
+    CTGroup -> do
+      _ <- withStore $ \db -> do
+        Group GroupInfo {groupId} _ <- getGroup db user chatId
+        liftIO $ updateGroupUnreadChat db user groupId unreadChat
+      pure CRCmdOk
+    _ -> pure $ chatCmdError "not supported"
  APIDeleteChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of
    CTDirect -> do
      ct@Contact {localDisplayName} <- withStore $ \db -> getContact db userId chatId
@@ -3057,6 +3069,7 @@ chatCommandP =
      "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> msgContentP),
      "/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode),
      "/_read chat " *> (APIChatRead <$> chatRefP <*> optional (A.space *> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))),
+      "/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP),
      "/_delete " *> (APIDeleteChat <$> chatRefP),
      "/_clear chat " *> (APIClearChat <$> chatRefP),
      "/_accept " *> (APIAcceptContact <$> A.decimal),
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -149,6 +149,7 @@ data ChatCommand
  | APIUpdateChatItem ChatRef ChatItemId MsgContent
  | APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
  | APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId))
+  | APIChatUnread ChatRef Bool
  | APIDeleteChat ChatRef
  | APIClearChat ChatRef
  | APIAcceptContact Int64
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -213,7 +213,8 @@ instance ToJSON AChat where

 data ChatStats = ChatStats
  { unreadCount :: Int,
-    minUnreadItemId :: ChatItemId
+    minUnreadItemId :: ChatItemId,
+    unreadChat :: Bool
  }
  deriving (Show, Generic)

--- a/src/Simplex/Chat/Migrations/M20221019_unread_chat.hs
+++ b/src/Simplex/Chat/Migrations/M20221019_unread_chat.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20221019_unread_chat where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20221019_unread_chat :: Query
+m20221019_unread_chat =
+  [sql|
+PRAGMA ignore_check_constraints=ON;
+
+ALTER TABLE contacts ADD COLUMN unread_chat INTEGER DEFAULT 0 CHECK (unread_chat NOT NULL);
+UPDATE contacts SET unread_chat = 0;
+ALTER TABLE groups ADD COLUMN unread_chat INTEGER DEFAULT 0 CHECK (unread_chat NOT NULL);
+UPDATE groups SET unread_chat = 0;
+
+PRAGMA ignore_check_constraints=OFF;
+|]
+
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -56,6 +56,7 @@ is_user INTEGER NOT NULL DEFAULT 0, -- 1 if this contact is a user
  updated_at TEXT CHECK(updated_at NOT NULL),
  xcontact_id BLOB,
  enable_ntfs INTEGER,
+  unread_chat INTEGER DEFAULT 0 CHECK(unread_chat NOT NULL),
  FOREIGN KEY(user_id, local_display_name)
  REFERENCES display_names(user_id, local_display_name)
  ON DELETE CASCADE
@@ -123,7 +124,8 @@ CREATE TABLE groups(
  updated_at TEXT CHECK(updated_at NOT NULL),
  chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE SET NULL,
  enable_ntfs INTEGER,
-  host_conn_custom_user_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL, -- received
+  host_conn_custom_user_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
+  unread_chat INTEGER DEFAULT 0 CHECK(unread_chat NOT NULL), -- received
  FOREIGN KEY(user_id, local_display_name)
  REFERENCES display_names(user_id, local_display_name)
  ON DELETE CASCADE
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -41,6 +41,8 @@ module Simplex.Chat.Store
    updateContactProfile,
    updateContactAlias,
    updateContactConnectionAlias,
+    updateContactUnreadChat,
+    updateGroupUnreadChat,
    getUserContacts,
    createUserContactLink,
    getUserAddressConnections,
@@ -281,6 +283,7 @@ import Simplex.Chat.Migrations.M20221003_delete_broken_integrity_error_chat_item
 import Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
 import Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
 import Simplex.Chat.Migrations.M20221012_inline_files
+import Simplex.Chat.Migrations.M20221019_unread_chat
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@@ -322,7 +325,8 @@ schemaMigrations =
    ("20221003_delete_broken_integrity_error_chat_items", m20221003_delete_broken_integrity_error_chat_items),
    ("20221004_idx_msg_deliveries_message_id", m20221004_idx_msg_deliveries_message_id),
    ("20221011_user_contact_links_group_id", m20221011_user_contact_links_group_id),
-    ("20221012_inline_files", m20221012_inline_files)
+    ("20221012_inline_files", m20221012_inline_files),
+    ("20221019_unread_chat", m20221019_unread_chat)
  ]

 -- | The list of migrations in ascending order by date
@@ -631,6 +635,14 @@ updateContactConnectionAlias db userId conn localAlias = do
    (localAlias, updatedAt, userId, pccConnId conn)
  pure (conn :: PendingContactConnection) {localAlias}

+updateContactUnreadChat :: DB.Connection -> User -> Int64 -> Bool -> IO ()
+updateContactUnreadChat db User {userId} contactId unreadChat =
+  DB.execute db "UPDATE contacts SET unread_chat = ? WHERE user_id = ? AND contact_id = ?" (unreadChat, userId, contactId)
+
+updateGroupUnreadChat :: DB.Connection -> User -> Int64 -> Bool -> IO ()
+updateGroupUnreadChat db User {userId} groupId unreadChat =
+  DB.execute db "UPDATE groups SET unread_chat = ? WHERE user_id = ? AND group_id = ?" (unreadChat, userId, groupId)
+
 updateContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
 updateContactProfile_ db userId profileId profile = do
  currentTs <- getCurrentTime
@@ -3040,7 +3052,7 @@ getDirectChatPreviews_ db User {userId} = do
          c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
          c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at,
          -- ChatStats
-          COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0),
+          COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat,
          -- ChatItem
          i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at,
          -- CIFile
@@ -3106,7 +3118,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
          mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
          pu.display_name, pu.full_name, pu.image, pu.local_alias,
          -- ChatStats
-          COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0),
+          COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat,
          -- ChatItem
          i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at,
          -- CIFile
@@ -3177,7 +3189,7 @@ getContactRequestChatPreviews_ db User {userId} =
    toContactRequestChatPreview :: ContactRequestRow -> AChat
    toContactRequestChatPreview cReqRow =
      let cReq = toContactRequest cReqRow
-          stats = ChatStats {unreadCount = 0, minUnreadItemId = 0}
+          stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
       in AChat SCTContactRequest $ Chat (ContactRequest cReq) [] stats

 getContactConnectionChatPreviews_ :: DB.Connection -> User -> Bool -> IO [AChat]
@@ -3196,7 +3208,7 @@ getContactConnectionChatPreviews_ db User {userId} _ =
    toContactConnectionChatPreview :: (Int64, ConnId, ConnStatus, Maybe ByteString, Maybe Int64, Maybe Int64, Maybe ConnReqInvitation, LocalAlias, UTCTime, UTCTime) -> AChat
    toContactConnectionChatPreview connRow =
      let conn = toPendingContactConnection connRow
-          stats = ChatStats {unreadCount = 0, minUnreadItemId = 0}
+          stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
       in AChat SCTContactConnection $ Chat (ContactConnection conn) [] stats

 getPendingContactConnection :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO PendingContactConnection
@@ -3254,8 +3266,7 @@ getDirectChat db user contactId pagination search_ = do
 getDirectChatLast_ :: DB.Connection -> User -> Int64 -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
 getDirectChatLast_ db User {userId} contactId count search = do
  contact <- getContact db userId contactId
-  -- stats <- liftIO $ getDirectChatStats_ db userId contactId
-  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0}
+  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
  chatItems <- ExceptT getDirectChatItemsLast_
  pure $ Chat (DirectChat contact) (reverse chatItems) stats
  where
@@ -3286,8 +3297,7 @@ getDirectChatLast_ db User {userId} contactId count search = do
 getDirectChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
 getDirectChatAfter_ db User {userId} contactId afterChatItemId count search = do
  contact <- getContact db userId contactId
-  -- stats <- liftIO $ getDirectChatStats_ db userId contactId
-  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0}
+  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
  chatItems <- ExceptT getDirectChatItemsAfter_
  pure $ Chat (DirectChat contact) chatItems stats
  where
@@ -3319,8 +3329,7 @@ getDirectChatAfter_ db User {userId} contactId afterChatItemId count search = do
 getDirectChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
 getDirectChatBefore_ db User {userId} contactId beforeChatItemId count search = do
  contact <- getContact db userId contactId
-  -- stats <- liftIO $ getDirectChatStats_ db userId contactId
-  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0}
+  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
  chatItems <- ExceptT getDirectChatItemsBefore_
  pure $ Chat (DirectChat contact) (reverse chatItems) stats
  where
@@ -3349,23 +3358,6 @@ getDirectChatBefore_ db User {userId} contactId beforeChatItemId count search =
          |]
          (userId, contactId, search, beforeChatItemId, count)

-_getDirectChatStats_ :: DB.Connection -> UserId -> Int64 -> IO ChatStats
-_getDirectChatStats_ db userId contactId =
-  toChatStats'
-    <$> DB.query
-      db
-      [sql|
-        SELECT COUNT(1), MIN(chat_item_id)
-        FROM chat_items
-        WHERE user_id = ? AND contact_id = ? AND item_status = ? AND item_deleted != 1
-        GROUP BY contact_id
-      |]
-      (userId, contactId, CISRcvNew)
-  where
-    toChatStats' :: [ChatStatsRow] -> ChatStats
-    toChatStats' [statsRow] = toChatStats statsRow
-    toChatStats' _ = ChatStats {unreadCount = 0, minUnreadItemId = 0}
-
 getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64
 getContactIdByName db User {userId} cName =
  ExceptT . firstRow fromOnly (SEContactNotFoundByName cName) $
@@ -3412,8 +3404,7 @@ getGroupChat db user groupId pagination search_ = do
 getGroupChatLast_ :: DB.Connection -> User -> Int64 -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
 getGroupChatLast_ db user@User {userId} groupId count search = do
  groupInfo <- getGroupInfo db user groupId
-  -- stats <- liftIO $ getGroupChatStats_ db userId groupId
-  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0}
+  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
  chatItemIds <- liftIO getGroupChatItemIdsLast_
  chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds
  pure $ Chat (GroupChat groupInfo) (reverse chatItems) stats
@@ -3435,8 +3426,7 @@ getGroupChatLast_ db user@User {userId} groupId count search = do
 getGroupChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
 getGroupChatAfter_ db user@User {userId} groupId afterChatItemId count search = do
  groupInfo <- getGroupInfo db user groupId
-  -- stats <- liftIO $ getGroupChatStats_ db userId groupId
-  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0}
+  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
  afterChatItem <- getGroupChatItem db user groupId afterChatItemId
  chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ (chatItemTs afterChatItem)
  chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds
@@ -3460,8 +3450,7 @@ getGroupChatAfter_ db user@User {userId} groupId afterChatItemId count search =
 getGroupChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
 getGroupChatBefore_ db user@User {userId} groupId beforeChatItemId count search = do
  groupInfo <- getGroupInfo db user groupId
-  -- stats <- liftIO $ getGroupChatStats_ db userId groupId
-  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0}
+  let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
  beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId
  chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ (chatItemTs beforeChatItem)
  chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds
@@ -3482,23 +3471,6 @@ getGroupChatBefore_ db user@User {userId} groupId beforeChatItemId count search
          |]
          (userId, groupId, search, beforeChatItemTs, beforeChatItemTs, beforeChatItemId, count)

-_getGroupChatStats_ :: DB.Connection -> UserId -> Int64 -> IO ChatStats
-_getGroupChatStats_ db userId groupId =
-  toChatStats'
-    <$> DB.query
-      db
-      [sql|
-        SELECT COUNT(1), MIN(chat_item_id)
-        FROM chat_items
-        WHERE user_id = ? AND group_id = ? AND item_status = ? AND item_deleted != 1
-        GROUP BY group_id
-      |]
-      (userId, groupId, CISRcvNew)
-  where
-    toChatStats' :: [ChatStatsRow] -> ChatStats
-    toChatStats' [statsRow] = toChatStats statsRow
-    toChatStats' _ = ChatStats {unreadCount = 0, minUnreadItemId = 0}
-
 getGroupInfo :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO GroupInfo
 getGroupInfo db User {userId, userContactId} groupId =
  ExceptT . firstRow (toGroupInfo userContactId) (SEGroupNotFound groupId) $
@@ -4013,10 +3985,10 @@ updateGroupChatItemsRead db groupId itemsRange_ = do
        |]
        (CISRcvRead, currentTs, groupId, CISRcvNew)

-type ChatStatsRow = (Int, ChatItemId)
+type ChatStatsRow = (Int, ChatItemId, Bool)

 toChatStats :: ChatStatsRow -> ChatStats
-toChatStats (unreadCount, minUnreadItemId) = ChatStats {unreadCount, minUnreadItemId}
+toChatStats (unreadCount, minUnreadItemId, unreadChat) = ChatStats {unreadCount, minUnreadItemId, unreadChat}

 type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe ACIFileStatus)

--- a/tests/ChatTests.hs
+++ b/tests/ChatTests.hs
@@ -205,6 +205,10 @@ testAddContact = versionTestMatrix2 runTestAddContact
      chatsEmpty alice bob
      alice #> "@bob hello there 🙂"
      bob <# "alice> hello there 🙂"
+      alice ##> "/_unread chat @2 on"
+      alice <## "ok"
+      alice ##> "/_unread chat @2 off"
+      alice <## "ok"
      chatsOneMessage alice bob
      bob #> "@alice hello there"
      alice <# "bob> hello there"