From 654a7885c394c97fc09fadde4bc14d9a1f74e0ab Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 19 Feb 2024 15:17:14 +0400 Subject: [PATCH] core: read chat items with logical database errors as invalid (don't fail) (#3736) --- src/Simplex/Chat.hs | 7 +- src/Simplex/Chat/Messages.hs | 18 ++ src/Simplex/Chat/Messages/CIContent.hs | 2 +- src/Simplex/Chat/Store/Messages.hs | 271 ++++++++++++++++--------- src/Simplex/Chat/Store/Shared.hs | 3 +- 5 files changed, 196 insertions(+), 105 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 85cd5ee44..3b0fe7075 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -3648,18 +3648,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = processErr cryptoErr = do let e@(mde, n) = agentMsgDecryptError cryptoErr ci_ <- withStore $ \db -> - getDirectChatItemsLast db user contactId 1 "" + getDirectChatItemLast db user contactId >>= liftIO . mapM (\(ci, content') -> updateDirectChatItem' db user contactId ci content' False Nothing) - . (mdeUpdatedCI e <=< headMaybe) + . mdeUpdatedCI e case ci_ of Just ci -> toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) _ -> do toView $ CRContactRatchetSync user ct (RatchetSyncProgress rss cStats) createInternalChatItem user (CDDirectRcv ct) (CIRcvDecryptionError mde n) Nothing - headMaybe = \case - x : _ -> Just x - _ -> Nothing ratchetSyncEventItem ct' = do toView $ CRContactRatchetSync user ct' (RatchetSyncProgress rss cStats) createInternalChatItem user (CDDirectRcv ct') (CIRcvConnEvent $ RCERatchetSync rss) Nothing diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 50b098bb7..4312cfa85 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -360,6 +360,24 @@ mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted item _ -> False in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, forwardedByMember, createdAt, updatedAt} +dummyMeta :: ChatItemId -> UTCTime -> Text -> CIMeta c 'MDSnd +dummyMeta itemId ts itemText = + CIMeta + { itemId, + itemTs = ts, + itemText, + itemStatus = CISSndNew, + itemSharedMsgId = Nothing, + itemDeleted = Nothing, + itemEdited = False, + itemTimed = Nothing, + itemLive = Nothing, + editable = False, + forwardedByMember = Nothing, + createdAt = ts, + updatedAt = ts + } + data CITimed = CITimed { ttl :: Int, -- seconds deleteAt :: Maybe UTCTime -- this is initially Nothing for received items, the timer starts when they are read diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs index f0ce2d627..188a5293c 100644 --- a/src/Simplex/Chat/Messages/CIContent.hs +++ b/src/Simplex/Chat/Messages/CIContent.hs @@ -139,7 +139,7 @@ data CIContent (d :: MsgDirection) where CISndModerated :: CIContent 'MDSnd CIRcvModerated :: CIContent 'MDRcv CIRcvBlocked :: CIContent 'MDRcv - CIInvalidJSON :: Text -> CIContent d + CIInvalidJSON :: Text -> CIContent d -- this is also used for logical database errors, e.g. SEBadChatItem -- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API -- ! ^ Nested sum types also have to use different encodings for database and API -- ! ^ to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 96b6a1eaf..a755353da 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -39,7 +39,7 @@ module Simplex.Chat.Store.Messages getDirectChat, getGroupChat, getLocalChat, - getDirectChatItemsLast, + getDirectChatItemLast, getAllChatItems, getAChatItem, updateDirectChatItem, @@ -126,6 +126,7 @@ import Data.List (sortBy) import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Ord (Down (..), comparing) import Data.Text (Text) +import qualified Data.Text as T import Data.Time (addUTCTime) import Data.Time.Clock (UTCTime (..), getCurrentTime) import Database.SQLite.Simple (NamedParam (..), Only (..), Query, (:.) (..)) @@ -829,7 +830,7 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTLocal d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTLocal cItem d chatDir ciStatus content file = CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = Nothing, reactions = [], file} - badItem = Left $ SEBadChatItem itemId + badItem = Left $ SEBadChatItem itemId (Just itemTs) ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTLocal d ciMeta content status = let itemDeleted' = case itemDeleted of @@ -923,97 +924,118 @@ getDirectChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe Strin getDirectChat db user contactId pagination search_ = do let search = fromMaybe "" search_ ct <- getContact db user contactId - liftIO . getDirectChatReactions_ db ct =<< case pagination of + liftIO $ case pagination of CPLast count -> getDirectChatLast_ db user ct count search CPAfter afterId count -> getDirectChatAfter_ db user ct afterId count search CPBefore beforeId count -> getDirectChatBefore_ db user ct beforeId count search -getDirectChatLast_ :: DB.Connection -> User -> Contact -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) -getDirectChatLast_ db user ct@Contact {contactId} count search = do - let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} - chatItems <- getDirectChatItemsLast db user contactId count search - pure $ Chat (DirectChat ct) (reverse chatItems) stats - -- the last items in reverse order (the last item in the conversation is the first in the returned list) -getDirectChatItemsLast :: DB.Connection -> User -> ContactId -> Int -> String -> ExceptT StoreError IO [CChatItem 'CTDirect] -getDirectChatItemsLast db User {userId} contactId count search = ExceptT $ do - currentTs <- getCurrentTime - mapM (toDirectChatItem currentTs) - <$> DB.query - db - [sql| - SELECT - -- ChatItem - i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live, - -- CIFile - f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol, - -- DirectQuote - ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent - FROM chat_items i - LEFT JOIN files f ON f.chat_item_id = i.chat_item_id - LEFT JOIN chat_items ri ON ri.user_id = i.user_id AND ri.contact_id = i.contact_id AND ri.shared_msg_id = i.quoted_shared_msg_id - WHERE i.user_id = ? AND i.contact_id = ? AND i.item_text LIKE '%' || ? || '%' - ORDER BY i.created_at DESC, i.chat_item_id DESC - LIMIT ? - |] - (userId, contactId, search, count) - -getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) -getDirectChatAfter_ db User {userId} ct@Contact {contactId} afterChatItemId count search = do +getDirectChatLast_ :: DB.Connection -> User -> Contact -> Int -> String -> IO (Chat 'CTDirect) +getDirectChatLast_ db user@User {userId} ct@Contact {contactId} count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} - chatItems <- ExceptT getDirectChatItemsAfter_ - pure $ Chat (DirectChat ct) chatItems stats + chatItemIds <- getDirectChatItemIdsLast_ + currentTs <- getCurrentTime + chatItems <- mapM (safeGetDirectItem db user ct currentTs) chatItemIds + pure $ Chat (DirectChat ct) (reverse chatItems) stats where - getDirectChatItemsAfter_ :: IO (Either StoreError [CChatItem 'CTDirect]) - getDirectChatItemsAfter_ = do - currentTs <- getCurrentTime - mapM (toDirectChatItem currentTs) + getDirectChatItemIdsLast_ :: IO [ChatItemId] + getDirectChatItemIdsLast_ = + map fromOnly <$> DB.query db [sql| - SELECT - -- ChatItem - i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live, - -- CIFile - f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol, - -- DirectQuote - ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent - FROM chat_items i - LEFT JOIN files f ON f.chat_item_id = i.chat_item_id - LEFT JOIN chat_items ri ON ri.user_id = i.user_id AND ri.contact_id = i.contact_id AND ri.shared_msg_id = i.quoted_shared_msg_id - WHERE i.user_id = ? AND i.contact_id = ? AND i.item_text LIKE '%' || ? || '%' - AND i.chat_item_id > ? - ORDER BY i.created_at ASC, i.chat_item_id ASC + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%' + ORDER BY created_at DESC, chat_item_id DESC + LIMIT ? + |] + (userId, contactId, search, count) + +safeGetDirectItem :: DB.Connection -> User -> Contact -> UTCTime -> ChatItemId -> IO (CChatItem 'CTDirect) +safeGetDirectItem db user ct currentTs itemId = + runExceptT (getDirectCIWithReactions db user ct itemId) + >>= pure <$> safeToDirectItem currentTs itemId + +safeToDirectItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTDirect) -> CChatItem 'CTDirect +safeToDirectItem currentTs itemId = \case + Right ci -> ci + Left e@(SEBadChatItem _ (Just itemTs)) -> badDirectItem itemTs e + Left e -> badDirectItem currentTs e + where + badDirectItem :: UTCTime -> StoreError -> CChatItem 'CTDirect + badDirectItem ts e = + let errorText = T.pack $ show e + in CChatItem + SMDSnd + ChatItem + { chatDir = CIDirectSnd, + meta = dummyMeta itemId ts errorText, + content = CIInvalidJSON errorText, + formattedText = Nothing, + quotedItem = Nothing, + reactions = [], + file = Nothing + } + +getDirectChatItemLast :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO (CChatItem 'CTDirect) +getDirectChatItemLast db user@User {userId} contactId = do + chatItemId <- + ExceptT . firstRow fromOnly (SEChatItemNotFoundByContactId contactId) $ + DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND contact_id = ? + ORDER BY created_at DESC, chat_item_id DESC + LIMIT 1 + |] + (userId, contactId) + getDirectChatItem db user contactId chatItemId + +getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> IO (Chat 'CTDirect) +getDirectChatAfter_ db user@User {userId} ct@Contact {contactId} afterChatItemId count search = do + let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} + chatItemIds <- getDirectChatItemIdsAfter_ + currentTs <- getCurrentTime + chatItems <- mapM (safeGetDirectItem db user ct currentTs) chatItemIds + pure $ Chat (DirectChat ct) chatItems stats + where + getDirectChatItemIdsAfter_ :: IO [ChatItemId] + getDirectChatItemIdsAfter_ = + map fromOnly + <$> DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%' + AND chat_item_id > ? + ORDER BY created_at ASC, chat_item_id ASC LIMIT ? |] (userId, contactId, search, afterChatItemId, count) -getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) -getDirectChatBefore_ db User {userId} ct@Contact {contactId} beforeChatItemId count search = do +getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> IO (Chat 'CTDirect) +getDirectChatBefore_ db user@User {userId} ct@Contact {contactId} beforeChatItemId count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} - chatItems <- ExceptT getDirectChatItemsBefore_ + chatItemIds <- getDirectChatItemsIdsBefore_ + currentTs <- getCurrentTime + chatItems <- mapM (safeGetDirectItem db user ct currentTs) chatItemIds pure $ Chat (DirectChat ct) (reverse chatItems) stats where - getDirectChatItemsBefore_ :: IO (Either StoreError [CChatItem 'CTDirect]) - getDirectChatItemsBefore_ = do - currentTs <- getCurrentTime - mapM (toDirectChatItem currentTs) + getDirectChatItemsIdsBefore_ :: IO [ChatItemId] + getDirectChatItemsIdsBefore_ = + map fromOnly <$> DB.query db [sql| - SELECT - -- ChatItem - i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live, - -- CIFile - f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol, - -- DirectQuote - ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent - FROM chat_items i - LEFT JOIN files f ON f.chat_item_id = i.chat_item_id - LEFT JOIN chat_items ri ON ri.user_id = i.user_id AND ri.contact_id = i.contact_id AND ri.shared_msg_id = i.quoted_shared_msg_id - WHERE i.user_id = ? AND i.contact_id = ? AND i.item_text LIKE '%' || ? || '%' - AND i.chat_item_id < ? - ORDER BY i.created_at DESC, i.chat_item_id DESC + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%' + AND chat_item_id < ? + ORDER BY created_at DESC, chat_item_id DESC LIMIT ? |] (userId, contactId, search, beforeChatItemId, count) @@ -1023,15 +1045,16 @@ getGroupChat db vr user groupId pagination search_ = do let search = fromMaybe "" search_ g <- getGroupInfo db vr user groupId case pagination of - CPLast count -> getGroupChatLast_ db user g count search + CPLast count -> liftIO $ getGroupChatLast_ db user g count search CPAfter afterId count -> getGroupChatAfter_ db user g afterId count search CPBefore beforeId count -> getGroupChatBefore_ db user g beforeId count search -getGroupChatLast_ :: DB.Connection -> User -> GroupInfo -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup) +getGroupChatLast_ :: DB.Connection -> User -> GroupInfo -> Int -> String -> IO (Chat 'CTGroup) getGroupChatLast_ db user@User {userId} g@GroupInfo {groupId} count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} - chatItemIds <- liftIO getGroupChatItemIdsLast_ - chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds + chatItemIds <- getGroupChatItemIdsLast_ + currentTs <- getCurrentTime + chatItems <- mapM (safeGetGroupItem db user g currentTs) chatItemIds pure $ Chat (GroupChat g) (reverse chatItems) stats where getGroupChatItemIdsLast_ :: IO [ChatItemId] @@ -1048,6 +1071,32 @@ getGroupChatLast_ db user@User {userId} g@GroupInfo {groupId} count search = do |] (userId, groupId, search, count) +safeGetGroupItem :: DB.Connection -> User -> GroupInfo -> UTCTime -> ChatItemId -> IO (CChatItem 'CTGroup) +safeGetGroupItem db user g currentTs itemId = + runExceptT (getGroupCIWithReactions db user g itemId) + >>= pure <$> safeToGroupItem currentTs itemId + +safeToGroupItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTGroup) -> CChatItem 'CTGroup +safeToGroupItem currentTs itemId = \case + Right ci -> ci + Left e@(SEBadChatItem _ (Just itemTs)) -> badGroupItem itemTs e + Left e -> badGroupItem currentTs e + where + badGroupItem :: UTCTime -> StoreError -> CChatItem 'CTGroup + badGroupItem ts e = + let errorText = T.pack $ show e + in CChatItem + SMDSnd + ChatItem + { chatDir = CIGroupSnd, + meta = dummyMeta itemId ts errorText, + content = CIInvalidJSON errorText, + formattedText = Nothing, + quotedItem = Nothing, + reactions = [], + file = Nothing + } + getGroupMemberChatItemLast :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO (CChatItem 'CTGroup) getGroupMemberChatItemLast db user@User {userId} groupId groupMemberId = do chatItemId <- @@ -1069,7 +1118,8 @@ getGroupChatAfter_ db user@User {userId} g@GroupInfo {groupId} afterChatItemId c let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} afterChatItem <- getGroupChatItem db user groupId afterChatItemId chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ (chatItemTs afterChatItem) - chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds + currentTs <- liftIO getCurrentTime + chatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) chatItemIds pure $ Chat (GroupChat g) chatItems stats where getGroupChatItemIdsAfter_ :: UTCTime -> IO [ChatItemId] @@ -1092,7 +1142,8 @@ getGroupChatBefore_ db user@User {userId} g@GroupInfo {groupId} beforeChatItemId let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ (chatItemTs beforeChatItem) - chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds + currentTs <- liftIO getCurrentTime + chatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) chatItemIds pure $ Chat (GroupChat g) (reverse chatItems) stats where getGroupChatItemIdsBefore_ :: UTCTime -> IO [ChatItemId] @@ -1114,16 +1165,17 @@ getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String getLocalChat db user folderId pagination search_ = do let search = fromMaybe "" search_ nf <- getNoteFolder db user folderId - case pagination of + liftIO $ case pagination of CPLast count -> getLocalChatLast_ db user nf count search CPAfter afterId count -> getLocalChatAfter_ db user nf afterId count search CPBefore beforeId count -> getLocalChatBefore_ db user nf beforeId count search -getLocalChatLast_ :: DB.Connection -> User -> NoteFolder -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal) +getLocalChatLast_ :: DB.Connection -> User -> NoteFolder -> Int -> String -> IO (Chat 'CTLocal) getLocalChatLast_ db user@User {userId} nf@NoteFolder {noteFolderId} count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} - chatItemIds <- liftIO getLocalChatItemIdsLast_ - chatItems <- mapM (getLocalChatItem db user noteFolderId) chatItemIds + chatItemIds <- getLocalChatItemIdsLast_ + currentTs <- getCurrentTime + chatItems <- mapM (safeGetLocalItem db user nf currentTs) chatItemIds pure $ Chat (LocalChat nf) (reverse chatItems) stats where getLocalChatItemIdsLast_ :: IO [ChatItemId] @@ -1140,11 +1192,38 @@ getLocalChatLast_ db user@User {userId} nf@NoteFolder {noteFolderId} count searc |] (userId, noteFolderId, search, count) -getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal) +safeGetLocalItem :: DB.Connection -> User -> NoteFolder -> UTCTime -> ChatItemId -> IO (CChatItem 'CTLocal) +safeGetLocalItem db user NoteFolder {noteFolderId} currentTs itemId = + runExceptT (getLocalChatItem db user noteFolderId itemId) + >>= pure <$> safeToLocalItem currentTs itemId + +safeToLocalItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTLocal) -> CChatItem 'CTLocal +safeToLocalItem currentTs itemId = \case + Right ci -> ci + Left e@(SEBadChatItem _ (Just itemTs)) -> badLocalItem itemTs e + Left e -> badLocalItem currentTs e + where + badLocalItem :: UTCTime -> StoreError -> CChatItem 'CTLocal + badLocalItem ts e = + let errorText = T.pack $ show e + in CChatItem + SMDSnd + ChatItem + { chatDir = CILocalSnd, + meta = dummyMeta itemId ts errorText, + content = CIInvalidJSON errorText, + formattedText = Nothing, + quotedItem = Nothing, + reactions = [], + file = Nothing + } + +getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> IO (Chat 'CTLocal) getLocalChatAfter_ db user@User {userId} nf@NoteFolder {noteFolderId} afterChatItemId count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} - chatItemIds <- liftIO getLocalChatItemIdsAfter_ - chatItems <- mapM (getLocalChatItem db user noteFolderId) chatItemIds + chatItemIds <- getLocalChatItemIdsAfter_ + currentTs <- getCurrentTime + chatItems <- mapM (safeGetLocalItem db user nf currentTs) chatItemIds pure $ Chat (LocalChat nf) chatItems stats where getLocalChatItemIdsAfter_ :: IO [ChatItemId] @@ -1162,11 +1241,12 @@ getLocalChatAfter_ db user@User {userId} nf@NoteFolder {noteFolderId} afterChatI |] (userId, noteFolderId, search, afterChatItemId, count) -getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal) +getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> IO (Chat 'CTLocal) getLocalChatBefore_ db user@User {userId} nf@NoteFolder {noteFolderId} beforeChatItemId count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} - chatItemIds <- liftIO getLocalChatItemIdsBefore_ - chatItems <- mapM (getLocalChatItem db user noteFolderId) chatItemIds + chatItemIds <- getLocalChatItemIdsBefore_ + currentTs <- getCurrentTime + chatItems <- mapM (safeGetLocalItem db user nf currentTs) chatItemIds pure $ Chat (LocalChat nf) (reverse chatItems) stats where getLocalChatItemIdsBefore_ :: IO [ChatItemId] @@ -1189,7 +1269,7 @@ toChatItemRef = \case (itemId, Just contactId, Nothing, Nothing) -> Right (ChatRef CTDirect contactId, itemId) (itemId, Nothing, Just groupId, Nothing) -> Right (ChatRef CTGroup groupId, itemId) (itemId, Nothing, Nothing, Just folderId) -> Right (ChatRef CTLocal folderId, itemId) - (itemId, _, _, _) -> Left $ SEBadChatItem itemId + (itemId, _, _, _) -> Left $ SEBadChatItem itemId Nothing updateDirectChatItemsRead :: DB.Connection -> User -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO () updateDirectChatItemsRead db User {userId} contactId itemsRange_ = do @@ -1362,7 +1442,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTDirect cItem d chatDir ciStatus content file = CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, reactions = [], file} - badItem = Left $ SEBadChatItem itemId + badItem = Left $ SEBadChatItem itemId (Just itemTs) ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTDirect d ciMeta content status = let itemDeleted' = case itemDeleted of @@ -1413,7 +1493,7 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTGroup cItem d chatDir ciStatus content file = CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, reactions = [], file} - badItem = Left $ SEBadChatItem itemId + badItem = Left $ SEBadChatItem itemId (Just itemTs) ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTGroup d ciMeta content status = let itemDeleted' = case itemDeleted of @@ -2116,7 +2196,7 @@ getChatRefViaItemId db User {userId} itemId = do toChatRef = \case (Just contactId, Nothing) -> Right $ ChatRef CTDirect contactId (Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId - (_, _) -> Left $ SEBadChatItem itemId + (_, _) -> Left $ SEBadChatItem itemId Nothing getAChatItem :: DB.Connection -> VersionRange -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem getAChatItem db vr user chatRef itemId = case chatRef of @@ -2152,11 +2232,6 @@ getChatItemVersions db itemId = do let formattedText = parseMaybeMarkdownList $ msgContentText msgContent in ChatItemVersion {chatItemVersionId, msgContent, formattedText, itemVersionTs, createdAt} -getDirectChatReactions_ :: DB.Connection -> Contact -> Chat 'CTDirect -> IO (Chat 'CTDirect) -getDirectChatReactions_ db ct c@Chat {chatItems} = do - chatItems' <- mapM (directCIWithReactions db ct) chatItems - pure c {chatItems = chatItems'} - directCIWithReactions :: DB.Connection -> Contact -> CChatItem 'CTDirect -> IO (CChatItem 'CTDirect) directCIWithReactions db ct cci@(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) = case itemSharedMsgId of Just sharedMsgId -> do diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index e4d47b32c..c741cfbee 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -92,11 +92,12 @@ data StoreError | SEUniqueID | SELargeMsg | SEInternalError {message :: String} - | SEBadChatItem {itemId :: ChatItemId} + | SEBadChatItem {itemId :: ChatItemId, itemTs :: Maybe ChatItemTs} | SEChatItemNotFound {itemId :: ChatItemId} | SEChatItemNotFoundByText {text :: Text} | SEChatItemSharedMsgIdNotFound {sharedMsgId :: SharedMsgId} | SEChatItemNotFoundByFileId {fileId :: FileTransferId} + | SEChatItemNotFoundByContactId {contactId :: ContactId} | SEChatItemNotFoundByGroupId {groupId :: GroupId} | SEProfileNotFound {profileId :: Int64} | SEDuplicateGroupLink {groupInfo :: GroupInfo}