IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: read chat items with logical database errors as invalid (don't fail) (#3736)

Browse Source
This commit is contained in:
spaced4ndy 2024-02-19 15:17:14 +04:00 committed by GitHub
parent daf67c0456
commit 654a7885c3
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
5 changed files with 196 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Simplex/Chat.hs
View File

@ -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

18
src/Simplex/Chat/Messages.hs
View File

@ -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

2
src/Simplex/Chat/Messages/CIContent.hs
View File

@ -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

271
src/Simplex/Chat/Store/Messages.hs
View File

@ -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

3
src/Simplex/Chat/Store/Shared.hs
View File

@ -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}