mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: improve performance of marking chat items as read (#5290)
* core: improve performance of marking chat items as read * fix tests
This commit is contained in:
Evgeny
GitHub
@@ -309,7 +309,7 @@ data ChatCommand
|
||||
| APIForwardChatItems {toChatRef :: ChatRef, fromChatRef :: ChatRef, chatItemIds :: NonEmpty ChatItemId, ttl :: Maybe Int}
|
||||
| APIUserRead UserId
|
||||
| UserRead
|
||||
| APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId))
|
||||
| APIChatRead ChatRef
|
||||
| APIChatItemsRead ChatRef (NonEmpty ChatItemId)
|
||||
| APIChatUnread ChatRef Bool
|
||||
| APIDeleteChat ChatRef ChatDeleteMode -- currently delete mode settings are only applied to direct chats
|
||||
|
||||
+104
-119
@@ -62,6 +62,7 @@ module Simplex.Chat.Store.Messages
|
||||
updateDirectChatItemsRead,
|
||||
getDirectUnreadTimedItems,
|
||||
updateDirectChatItemsReadList,
|
||||
setDirectChatItemRead,
|
||||
setDirectChatItemsDeleteAt,
|
||||
updateGroupChatItemsRead,
|
||||
getGroupUnreadTimedItems,
|
||||
@@ -1670,61 +1671,61 @@ toChatItemRef = \case
|
||||
(itemId, Nothing, Nothing, Just folderId) -> Right (ChatRef CTLocal folderId, itemId)
|
||||
(itemId, _, _, _) -> Left $ SEBadChatItem itemId Nothing
|
||||
|
||||
updateDirectChatItemsRead :: DB.Connection -> User -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO ()
|
||||
updateDirectChatItemsRead db User {userId} contactId itemsRange_ = do
|
||||
updateDirectChatItemsRead :: DB.Connection -> User -> ContactId -> IO ()
|
||||
updateDirectChatItemsRead db User {userId} contactId = do
|
||||
currentTs <- getCurrentTime
|
||||
case itemsRange_ of
|
||||
Just (fromItemId, toItemId) ->
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, contactId, fromItemId, toItemId, CISRcvNew)
|
||||
_ ->
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_id = ? AND item_status = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, contactId, CISRcvNew)
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_id = ? AND item_status = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, contactId, CISRcvNew)
|
||||
|
||||
getDirectUnreadTimedItems :: DB.Connection -> User -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO [(ChatItemId, Int)]
|
||||
getDirectUnreadTimedItems db User {userId} contactId itemsRange_ = case itemsRange_ of
|
||||
Just (fromItemId, toItemId) ->
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, timed_ttl
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ?
|
||||
AND chat_item_id >= ? AND chat_item_id <= ?
|
||||
AND item_status = ?
|
||||
AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|
||||
AND (item_live IS NULL OR item_live = ?)
|
||||
|]
|
||||
(userId, contactId, fromItemId, toItemId, CISRcvNew, False)
|
||||
_ ->
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, timed_ttl
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|
||||
|]
|
||||
(userId, contactId, CISRcvNew)
|
||||
getDirectUnreadTimedItems :: DB.Connection -> User -> ContactId -> IO [(ChatItemId, Int)]
|
||||
getDirectUnreadTimedItems db User {userId} contactId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, timed_ttl
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|
||||
|]
|
||||
(userId, contactId, CISRcvNew)
|
||||
|
||||
updateDirectChatItemsReadList :: DB.Connection -> User -> ContactId -> NonEmpty ChatItemId -> IO [(ChatItemId, Int)]
|
||||
updateDirectChatItemsReadList db user contactId itemIds = do
|
||||
catMaybes . L.toList <$> mapM getUpdateDirectItem itemIds
|
||||
updateDirectChatItemsReadList db user@User {userId} contactId itemIds = do
|
||||
currentTs <- getCurrentTime
|
||||
catMaybes . L.toList <$> mapM (getUpdateDirectItem currentTs) itemIds
|
||||
where
|
||||
getUpdateDirectItem chatItemId = do
|
||||
let itemsRange = Just (chatItemId, chatItemId)
|
||||
timedItem <- maybeFirstRow id $ getDirectUnreadTimedItems db user contactId itemsRange
|
||||
updateDirectChatItemsRead db user contactId itemsRange
|
||||
pure timedItem
|
||||
getUpdateDirectItem currentTs itemId = do
|
||||
ttl_ <- maybeFirstRow fromOnly getUnreadTimedItem
|
||||
setDirectChatItemRead_ db user contactId itemId currentTs
|
||||
pure $ (itemId,) <$> ttl_
|
||||
where
|
||||
getUnreadTimedItem =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT timed_ttl
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ? AND item_status = ? AND chat_item_id = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|
||||
|]
|
||||
(userId, contactId, CISRcvNew, itemId)
|
||||
|
||||
setDirectChatItemRead :: DB.Connection -> User -> ContactId -> ChatItemId -> IO ()
|
||||
setDirectChatItemRead db user contactId itemId =
|
||||
setDirectChatItemRead_ db user contactId itemId =<< getCurrentTime
|
||||
|
||||
setDirectChatItemRead_ :: DB.Connection -> User -> ContactId -> ChatItemId -> UTCTime -> IO ()
|
||||
setDirectChatItemRead_ db User {userId} contactId itemId currentTs =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_id = ? AND item_status = ? AND chat_item_id = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, contactId, CISRcvNew, itemId)
|
||||
|
||||
setDirectChatItemsDeleteAt :: DB.Connection -> User -> ContactId -> [(ChatItemId, Int)] -> UTCTime -> IO [(ChatItemId, UTCTime)]
|
||||
setDirectChatItemsDeleteAt db User {userId} contactId itemIds currentTs = forM itemIds $ \(chatItemId, ttl) -> do
|
||||
@@ -1735,61 +1736,55 @@ setDirectChatItemsDeleteAt db User {userId} contactId itemIds currentTs = forM i
|
||||
(deleteAt, userId, contactId, chatItemId)
|
||||
pure (chatItemId, deleteAt)
|
||||
|
||||
updateGroupChatItemsRead :: DB.Connection -> User -> GroupId -> Maybe (ChatItemId, ChatItemId) -> IO ()
|
||||
updateGroupChatItemsRead db User {userId} groupId itemsRange_ = do
|
||||
updateGroupChatItemsRead :: DB.Connection -> User -> GroupId -> IO ()
|
||||
updateGroupChatItemsRead db User {userId} groupId = do
|
||||
currentTs <- getCurrentTime
|
||||
case itemsRange_ of
|
||||
Just (fromItemId, toItemId) ->
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, groupId, fromItemId, toItemId, CISRcvNew)
|
||||
_ ->
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND item_status = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, groupId, CISRcvNew)
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND item_status = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, groupId, CISRcvNew)
|
||||
|
||||
getGroupUnreadTimedItems :: DB.Connection -> User -> GroupId -> Maybe (ChatItemId, ChatItemId) -> IO [(ChatItemId, Int)]
|
||||
getGroupUnreadTimedItems db User {userId} groupId itemsRange_ = case itemsRange_ of
|
||||
Just (fromItemId, toItemId) ->
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, timed_ttl
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ?
|
||||
AND chat_item_id >= ? AND chat_item_id <= ?
|
||||
AND item_status = ?
|
||||
AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|
||||
AND (item_live IS NULL OR item_live = ?)
|
||||
|]
|
||||
(userId, groupId, fromItemId, toItemId, CISRcvNew, False)
|
||||
_ ->
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, timed_ttl
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|
||||
|]
|
||||
(userId, groupId, CISRcvNew)
|
||||
getGroupUnreadTimedItems :: DB.Connection -> User -> GroupId -> IO [(ChatItemId, Int)]
|
||||
getGroupUnreadTimedItems db User {userId} groupId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, timed_ttl
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|
||||
|]
|
||||
(userId, groupId, CISRcvNew)
|
||||
|
||||
updateGroupChatItemsReadList :: DB.Connection -> User -> GroupId -> NonEmpty ChatItemId -> IO [(ChatItemId, Int)]
|
||||
updateGroupChatItemsReadList db user groupId itemIds = do
|
||||
catMaybes . L.toList <$> mapM getUpdateGroupItem itemIds
|
||||
updateGroupChatItemsReadList db User {userId} groupId itemIds = do
|
||||
currentTs <- getCurrentTime
|
||||
catMaybes . L.toList <$> mapM (getUpdateGroupItem currentTs) itemIds
|
||||
where
|
||||
getUpdateGroupItem chatItemId = do
|
||||
let itemsRange = Just (chatItemId, chatItemId)
|
||||
timedItem <- maybeFirstRow id $ getGroupUnreadTimedItems db user groupId itemsRange
|
||||
updateGroupChatItemsRead db user groupId itemsRange
|
||||
pure timedItem
|
||||
getUpdateGroupItem currentTs itemId = do
|
||||
ttl_ <- maybeFirstRow fromOnly getUnreadTimedItem
|
||||
setItemRead
|
||||
pure $ (itemId,) <$> ttl_
|
||||
where
|
||||
getUnreadTimedItem =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT timed_ttl
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_status = ? AND chat_item_id = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|
||||
|]
|
||||
(userId, groupId, CISRcvNew, itemId)
|
||||
setItemRead =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND item_status = ? AND chat_item_id = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, groupId, CISRcvNew, itemId)
|
||||
|
||||
setGroupChatItemsDeleteAt :: DB.Connection -> User -> GroupId -> [(ChatItemId, Int)] -> UTCTime -> IO [(ChatItemId, UTCTime)]
|
||||
setGroupChatItemsDeleteAt db User {userId} groupId itemIds currentTs = forM itemIds $ \(chatItemId, ttl) -> do
|
||||
@@ -1800,26 +1795,16 @@ setGroupChatItemsDeleteAt db User {userId} groupId itemIds currentTs = forM item
|
||||
(deleteAt, userId, groupId, chatItemId)
|
||||
pure (chatItemId, deleteAt)
|
||||
|
||||
updateLocalChatItemsRead :: DB.Connection -> User -> NoteFolderId -> Maybe (ChatItemId, ChatItemId) -> IO ()
|
||||
updateLocalChatItemsRead db User {userId} noteFolderId itemsRange_ = do
|
||||
updateLocalChatItemsRead :: DB.Connection -> User -> NoteFolderId -> IO ()
|
||||
updateLocalChatItemsRead db User {userId} noteFolderId = do
|
||||
currentTs <- getCurrentTime
|
||||
case itemsRange_ of
|
||||
Just (fromItemId, toItemId) ->
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND note_folder_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, noteFolderId, fromItemId, toItemId, CISRcvNew)
|
||||
_ ->
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, noteFolderId, CISRcvNew)
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
|
||||
|]
|
||||
(CISRcvRead, currentTs, userId, noteFolderId, CISRcvNew)
|
||||
|
||||
type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe ACIFileStatus, Maybe FileProtocol)
|
||||
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
@@ -164,7 +165,7 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} Cha
|
||||
(True, CISRcvNew) -> do
|
||||
let itemId = chatItemId' ci
|
||||
chatRef = chatInfoToRef chat
|
||||
void $ runReaderT (runExceptT $ processChatCommand (APIChatRead chatRef (Just (itemId, itemId)))) cc
|
||||
void $ runReaderT (runExceptT $ processChatCommand (APIChatItemsRead chatRef [itemId])) cc
|
||||
_ -> pure ()
|
||||
logResponse path s = withFile path AppendMode $ \h -> mapM_ (hPutStrLn h . unStyle) s
|
||||
getRemoteUser rhId =
|
||||
|
||||
Reference in New Issue
Block a user