From 213b586f8f30b5e7ab24ab83b1affbdc42fd7178 Mon Sep 17 00:00:00 2001
From: Stanislav Dmitrenko <7953703+avently@users.noreply.github.com>
Date: Wed, 19 Oct 2022 21:38:44 +0300
Subject: [PATCH] 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>
---
 simplex-chat.cabal                            |  1 +
 src/Simplex/Chat.hs                           | 13 ++++
 src/Simplex/Chat/Controller.hs                |  1 +
 src/Simplex/Chat/Messages.hs                  |  3 +-
 .../Chat/Migrations/M20221019_unread_chat.hs  | 20 +++++
 src/Simplex/Chat/Migrations/chat_schema.sql   |  4 +-
 src/Simplex/Chat/Store.hs                     | 78 ++++++-------------
 tests/ChatTests.hs                            |  4 +
 8 files changed, 69 insertions(+), 55 deletions(-)
 create mode 100644 src/Simplex/Chat/Migrations/M20221019_unread_chat.hs

diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 52c0a0533..6801d4bfd 100644
--- 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
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 04f490b57..6d426bd8f 100644
--- 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),
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 92bc809ad..29458e244 100644
--- 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
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index 10315a163..159ce4c01 100644
--- 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)
 
diff --git a/src/Simplex/Chat/Migrations/M20221019_unread_chat.hs b/src/Simplex/Chat/Migrations/M20221019_unread_chat.hs
new file mode 100644
index 000000000..db24db947
--- /dev/null
+++ 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;
+|]
+
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index c5fcc446e..de9e08c62 100644
--- 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
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index 31913839b..beb84f8e1 100644
--- 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)
 
diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs
index 141641c7f..a2f4f77da 100644
--- 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"