mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-06-06 17:42:31 +00:00
core: add notes chat type (#3568)
* Add chat type "self"
* rename to Notes
* cover more things
* remove quote, tweak sql
* resolve comments
* constrain ACIQDirection to exclude CTLocal
* add CILocalRcv handling
* plug in migrations and tests
* cover more API, implement new folders
* working create/send/tail
* remove interaction with messages
* add note deletion (api-only)
* add folder deletion
* add getLocalChatItemIdByText
* add APICreateChatItem and files
* add protocol check for getFileTransfer protocol
* replace FTLocal with createLocalFile
* add chat previews
* add folder clear
* add reactions
* add read/unread
* add note updates
* resolve some comments
* remove local reactions
* remove folder names, deletion, add autocreate
* add file deletion check
* add preview pagination test
* add per-item file deletion check
* pull mkChatItem out of createLocal to prevent ci record updates
* use - as notes name
* bump migration ts
* update schema
* resolve comments
* add chat pagination test
* use chat queries from Direct instead
* evict note folders from createUserRecord
* switch to - for note folder chat type prefix and use empty name
* fix getLocalChatXxx
* add explicit createCCNoteFolder for tests
* use overloadedstrings for single-line queries
* add suggested chat list tests
* add notes chat to a user-creating test
* throw correct error for missing file
* remove unique check from schema
* add UndecidableInstances for ghc8.10
* switch to * for chat type sigil
* add file safety test
* add drop index
* remove indentation
* remove repeated folder
* remove redundant filter query, NoteFolderName
* don't attempt to cancel local files when deleting chat item
* rename function
* fix comment
* rename
* fix merge
* fix typo
* remove editable limit
* restore comment
* remove local file cancel
* Revert "remove editable limit"
This reverts commit 65df55caf8.
* refactor
---------
Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Alexander Bondarenko
committed by
GitHub
GitHub
parent
5b7a09f488
commit
bc8a6f4833
@@ -398,6 +398,7 @@ setUserChatsRead db User {userId} = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True)
|
||||
DB.execute db "UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True)
|
||||
DB.execute db "UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True)
|
||||
DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND item_status = ?" (CISRcvRead, updatedAt, userId, CISRcvNew)
|
||||
|
||||
updateContactStatus :: DB.Connection -> User -> Contact -> ContactStatus -> IO Contact
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
@@ -72,7 +73,10 @@ module Simplex.Chat.Store.Files
|
||||
getSndFileTransfer,
|
||||
getSndFileTransfers,
|
||||
getContactFileInfo,
|
||||
getNoteFolderFileInfo,
|
||||
createLocalFile,
|
||||
getLocalCryptoFile,
|
||||
getLocalFileMeta,
|
||||
updateDirectCIFileStatus,
|
||||
)
|
||||
where
|
||||
@@ -90,6 +94,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
|
||||
import Data.Type.Equality
|
||||
import Database.SQLite.Simple (Only (..), (:.) (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
import Database.SQLite.Simple.ToField (ToField)
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Protocol
|
||||
@@ -107,6 +112,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Protocol (SubscriptionMode (..))
|
||||
import Simplex.Messaging.Version (VersionRange)
|
||||
import System.FilePath (takeFileName)
|
||||
|
||||
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
|
||||
getLiveSndFileTransfers db User {userId} = do
|
||||
@@ -839,18 +845,19 @@ getFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileT
|
||||
getFileTransfer db user@User {userId} fileId =
|
||||
fileTransfer =<< liftIO (getFileTransferRow_ db userId fileId)
|
||||
where
|
||||
fileTransfer :: [(Maybe Int64, Maybe Int64)] -> ExceptT StoreError IO FileTransfer
|
||||
fileTransfer [(Nothing, Just _)] = FTRcv <$> getRcvFileTransfer db user fileId
|
||||
fileTransfer :: [(Maybe Int64, Maybe Int64, FileProtocol)] -> ExceptT StoreError IO FileTransfer
|
||||
fileTransfer [(_, _, FPLocal)] = throwError $ SELocalFileNoTransfer fileId
|
||||
fileTransfer [(Nothing, Just _, _)] = FTRcv <$> getRcvFileTransfer db user fileId
|
||||
fileTransfer _ = do
|
||||
(ftm, fts) <- getSndFileTransfer db user fileId
|
||||
pure $ FTSnd {fileTransferMeta = ftm, sndFileTransfers = fts}
|
||||
|
||||
getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64)]
|
||||
getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64, FileProtocol)]
|
||||
getFileTransferRow_ db userId fileId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT s.file_id, r.file_id
|
||||
SELECT s.file_id, r.file_id, f.protocol
|
||||
FROM files f
|
||||
LEFT JOIN snd_files s ON s.file_id = f.file_id
|
||||
LEFT JOIN rcv_files r ON r.file_id = f.file_id
|
||||
@@ -911,24 +918,70 @@ getFileTransferMeta_ db userId fileId =
|
||||
xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr, agentSndFileDeleted, cryptoArgs}) <$> aSndFileId_
|
||||
in FileTransferMeta {fileId, xftpSndFile, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
|
||||
|
||||
createLocalFile :: ToField (CIFileStatus d) => CIFileStatus d -> DB.Connection -> User -> NoteFolder -> ChatItemId -> UTCTime -> CryptoFile -> Integer -> Integer -> IO Int64
|
||||
createLocalFile fileStatus db User {userId} NoteFolder {noteFolderId} chatItemId itemTs CryptoFile {filePath, cryptoArgs} fileSize fileChunkSize = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO files
|
||||
( user_id, note_folder_id, chat_item_id,
|
||||
file_name, file_path, file_size,
|
||||
file_crypto_key, file_crypto_nonce,
|
||||
chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at
|
||||
)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (userId, noteFolderId, chatItemId)
|
||||
:. (takeFileName filePath, filePath, fileSize)
|
||||
:. maybe (Nothing, Nothing) (\(CFArgs key nonce) -> (Just key, Just nonce)) cryptoArgs
|
||||
:. (fileChunkSize, Nothing :: Maybe InlineFileMode, fileStatus, FPLocal, itemTs, itemTs)
|
||||
)
|
||||
insertedRowId db
|
||||
|
||||
getLocalFileMeta :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalFileMeta
|
||||
getLocalFileMeta db userId fileId =
|
||||
ExceptT . firstRow localFileMeta (SEFileNotFound fileId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT file_name, file_size, file_path, file_crypto_key, file_crypto_nonce
|
||||
FROM files
|
||||
WHERE user_id = ? AND file_id = ?
|
||||
|]
|
||||
(userId, fileId)
|
||||
where
|
||||
localFileMeta :: (FilePath, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce) -> LocalFileMeta
|
||||
localFileMeta (fileName, fileSize, filePath, fileKey, fileNonce) =
|
||||
let fileCryptoArgs = CFArgs <$> fileKey <*> fileNonce
|
||||
in LocalFileMeta {fileId, fileName, fileSize, filePath, fileCryptoArgs}
|
||||
|
||||
getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo]
|
||||
getContactFileInfo db User {userId} Contact {contactId} =
|
||||
map toFileInfo
|
||||
<$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.contact_id = ?") (userId, contactId)
|
||||
|
||||
getNoteFolderFileInfo :: DB.Connection -> User -> NoteFolder -> IO [CIFileInfo]
|
||||
getNoteFolderFileInfo db User {userId} NoteFolder {noteFolderId} =
|
||||
map toFileInfo
|
||||
<$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.note_folder_id = ?") (userId, noteFolderId)
|
||||
|
||||
getLocalCryptoFile :: DB.Connection -> UserId -> Int64 -> Bool -> ExceptT StoreError IO CryptoFile
|
||||
getLocalCryptoFile db userId fileId sent =
|
||||
liftIO (getFileTransferRow_ db userId fileId) >>= \case
|
||||
[(Nothing, Just _)] -> do
|
||||
[(Nothing, Just _, _)] -> do
|
||||
when sent $ throwError $ SEFileNotFound fileId
|
||||
RcvFileTransfer {fileStatus, cryptoArgs} <- getRcvFileTransfer_ db userId fileId
|
||||
case fileStatus of
|
||||
RFSComplete RcvFileInfo {filePath} -> pure $ CryptoFile filePath cryptoArgs
|
||||
_ -> throwError $ SEFileNotFound fileId
|
||||
_ -> do
|
||||
[(Just _, Nothing, _)] -> do
|
||||
unless sent $ throwError $ SEFileNotFound fileId
|
||||
FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId
|
||||
pure $ CryptoFile filePath $ xftpSndFile >>= \XFTPSndFile {cryptoArgs} -> cryptoArgs
|
||||
[(Nothing, Nothing, FPLocal)] -> do
|
||||
LocalFileMeta {filePath, fileCryptoArgs} <- getLocalFileMeta db userId fileId
|
||||
pure $ CryptoFile filePath fileCryptoArgs
|
||||
_ -> throwError $ SEFileNotFound fileId
|
||||
|
||||
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRange -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
|
||||
updateDirectCIFileStatus db vr user fileId fileStatus = do
|
||||
|
||||
@@ -34,9 +34,11 @@ module Simplex.Chat.Store.Messages
|
||||
createNewSndChatItem,
|
||||
createNewRcvChatItem,
|
||||
createNewChatItemNoMsg,
|
||||
createNewChatItem_,
|
||||
getChatPreviews,
|
||||
getDirectChat,
|
||||
getGroupChat,
|
||||
getLocalChat,
|
||||
getDirectChatItemsLast,
|
||||
getAllChatItems,
|
||||
getAChatItem,
|
||||
@@ -52,12 +54,14 @@ module Simplex.Chat.Store.Messages
|
||||
updateGroupChatItemModerated,
|
||||
markGroupChatItemDeleted,
|
||||
markGroupChatItemBlocked,
|
||||
deleteLocalChatItem,
|
||||
updateDirectChatItemsRead,
|
||||
getDirectUnreadTimedItems,
|
||||
setDirectChatItemDeleteAt,
|
||||
updateGroupChatItemsRead,
|
||||
getGroupUnreadTimedItems,
|
||||
setGroupChatItemDeleteAt,
|
||||
updateLocalChatItemsRead,
|
||||
getChatRefViaItemId,
|
||||
getChatItemVersions,
|
||||
getDirectCIReactions,
|
||||
@@ -77,10 +81,14 @@ module Simplex.Chat.Store.Messages
|
||||
getGroupMemberCIBySharedMsgId,
|
||||
getGroupChatItemByAgentMsgId,
|
||||
getGroupMemberChatItemLast,
|
||||
getLocalChatItem,
|
||||
updateLocalChatItem',
|
||||
getDirectChatItemIdByText,
|
||||
getDirectChatItemIdByText',
|
||||
getGroupChatItemIdByText,
|
||||
getGroupChatItemIdByText',
|
||||
getLocalChatItemIdByText,
|
||||
getLocalChatItemIdByText',
|
||||
getChatItemByFileId,
|
||||
getChatItemByGroupId,
|
||||
updateDirectChatItemStatus,
|
||||
@@ -126,6 +134,7 @@ import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Store.Direct
|
||||
import Simplex.Chat.Store.Groups
|
||||
import Simplex.Chat.Store.NoteFolders
|
||||
import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, MsgMeta (..), UserId)
|
||||
@@ -322,6 +331,11 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti
|
||||
db
|
||||
"UPDATE groups SET chat_ts = ? WHERE user_id = ? AND group_id = ?"
|
||||
(chatTs, userId, groupId)
|
||||
LocalChat NoteFolder {noteFolderId} ->
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE note_folders SET chat_ts = ? WHERE user_id = ? AND note_folder_id = ?"
|
||||
(chatTs, userId, noteFolderId)
|
||||
_ -> pure ()
|
||||
|
||||
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
|
||||
@@ -340,7 +354,7 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
|
||||
CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
|
||||
CIQGroupRcv Nothing -> (Just False, Nothing)
|
||||
|
||||
createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
|
||||
createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
|
||||
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live itemTs createdAt = do
|
||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs forwardedByMember createdAt
|
||||
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
|
||||
@@ -370,13 +384,13 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
[sql|
|
||||
INSERT INTO chat_items (
|
||||
-- user and IDs
|
||||
user_id, created_by_msg_id, contact_id, group_id, group_member_id,
|
||||
user_id, created_by_msg_id, contact_id, group_id, group_member_id, note_folder_id,
|
||||
-- meta
|
||||
item_sent, item_ts, item_content, item_content_tag, item_text, item_status, shared_msg_id,
|
||||
forwarded_by_group_member_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
|
||||
-- quote
|
||||
quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((userId, msgId_) :. idsRow :. itemRow :. quoteRow)
|
||||
ciId <- insertedRowId db
|
||||
@@ -385,12 +399,14 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
where
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByMember) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
|
||||
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
idsRow = case chatDirection of
|
||||
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
|
||||
CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing)
|
||||
CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId)
|
||||
CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing)
|
||||
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
|
||||
CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
|
||||
CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId, Nothing)
|
||||
CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing, Nothing)
|
||||
CDLocalRcv NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId)
|
||||
CDLocalSnd NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId)
|
||||
|
||||
ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime)
|
||||
ciTimedRow (Just CITimed {ttl, deleteAt}) = (Just ttl, deleteAt)
|
||||
@@ -399,7 +415,7 @@ ciTimedRow _ = (Nothing, Nothing)
|
||||
insertChatItemMessage_ :: DB.Connection -> ChatItemId -> MessageId -> UTCTime -> IO ()
|
||||
insertChatItemMessage_ db ciId msgId ts = DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" (ciId, msgId, ts, ts)
|
||||
|
||||
getChatItemQuote_ :: DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
|
||||
getChatItemQuote_ :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
|
||||
getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId}, content} =
|
||||
case chatDirection of
|
||||
CDDirectRcv Contact {contactId} -> getDirectChatItemQuote_ contactId (not sent)
|
||||
@@ -466,15 +482,17 @@ getChatPreviews :: DB.Connection -> VersionRange -> User -> Bool -> PaginationBy
|
||||
getChatPreviews db vr user withPCC pagination query = do
|
||||
directChats <- findDirectChatPreviews_ db user pagination query
|
||||
groupChats <- findGroupChatPreviews_ db user pagination query
|
||||
localChats <- findLocalChatPreviews_ db user pagination query
|
||||
cReqChats <- getContactRequestChatPreviews_ db user pagination query
|
||||
connChats <- if withPCC then getContactConnectionChatPreviews_ db user pagination query else pure []
|
||||
let refs = sortTake $ concat [directChats, groupChats, cReqChats, connChats]
|
||||
let refs = sortTake $ concat [directChats, groupChats, localChats, cReqChats, connChats]
|
||||
mapM (runExceptT <$> getChatPreview) refs
|
||||
where
|
||||
ts :: AChatPreviewData -> UTCTime
|
||||
ts (ACPD _ cpd) = case cpd of
|
||||
(DirectChatPD t _ _ _) -> t
|
||||
(GroupChatPD t _ _ _) -> t
|
||||
(LocalChatPD t _ _ _) -> t
|
||||
(ContactRequestPD t _) -> t
|
||||
(ContactConnectionPD t _) -> t
|
||||
sortTake = case pagination of
|
||||
@@ -485,12 +503,14 @@ getChatPreviews db vr user withPCC pagination query = do
|
||||
getChatPreview (ACPD cType cpd) = case cType of
|
||||
SCTDirect -> getDirectChatPreview_ db user cpd
|
||||
SCTGroup -> getGroupChatPreview_ db vr user cpd
|
||||
SCTLocal -> getLocalChatPreview_ db user cpd
|
||||
SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat
|
||||
SCTContactConnection -> let (ContactConnectionPD _ chat) = cpd in pure chat
|
||||
|
||||
data ChatPreviewData (c :: ChatType) where
|
||||
DirectChatPD :: UTCTime -> ContactId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTDirect
|
||||
GroupChatPD :: UTCTime -> GroupId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTGroup
|
||||
LocalChatPD :: UTCTime -> NoteFolderId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTLocal
|
||||
ContactRequestPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactRequest
|
||||
ContactConnectionPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactConnection
|
||||
|
||||
@@ -697,6 +717,123 @@ getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do
|
||||
Nothing -> pure []
|
||||
pure $ AChat SCTGroup (Chat (GroupChat groupInfo) lastItem stats)
|
||||
|
||||
findLocalChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
|
||||
findLocalChatPreviews_ db User {userId} pagination clq =
|
||||
map toPreview <$> getPreviews
|
||||
where
|
||||
toPreview :: (NoteFolderId, UTCTime, Maybe ChatItemId) :. ChatStatsRow -> AChatPreviewData
|
||||
toPreview ((noteFolderId, ts, lastItemId_) :. statsRow) =
|
||||
ACPD SCTLocal $ LocalChatPD ts noteFolderId lastItemId_ (toChatStats statsRow)
|
||||
baseQuery =
|
||||
[sql|
|
||||
SELECT nf.note_folder_id, nf.chat_ts as ts, LastItems.chat_item_id, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), nf.unread_chat
|
||||
FROM note_folders nf
|
||||
LEFT JOIN (
|
||||
SELECT note_folder_id, chat_item_id, MAX(created_at)
|
||||
FROM chat_items
|
||||
GROUP BY note_folder_id
|
||||
) LastItems ON LastItems.note_folder_id = nf.note_folder_id
|
||||
LEFT JOIN (
|
||||
SELECT note_folder_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE item_status = :rcv_new
|
||||
GROUP BY note_folder_id
|
||||
) ChatStats ON ChatStats.note_folder_id = nf.note_folder_id
|
||||
|]
|
||||
(pagQuery, pagParams) = paginationByTimeFilter pagination
|
||||
getPreviews = case clq of
|
||||
CLQFilters {favorite = False, unread = False} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( baseQuery
|
||||
<> [sql|
|
||||
WHERE nf.user_id = :user_id
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
|
||||
CLQFilters {favorite = True, unread = False} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( baseQuery
|
||||
<> [sql|
|
||||
WHERE nf.user_id = :user_id
|
||||
AND nf.favorite = 1
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
|
||||
CLQFilters {favorite = False, unread = True} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( baseQuery
|
||||
<> [sql|
|
||||
WHERE nf.user_id = :user_id
|
||||
AND (nf.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
|
||||
CLQFilters {favorite = True, unread = True} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( baseQuery
|
||||
<> [sql|
|
||||
WHERE nf.user_id = :user_id
|
||||
AND (nf.favorite = 1
|
||||
OR nf.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
|
||||
CLQSearch {} -> pure []
|
||||
|
||||
getLocalChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTLocal -> ExceptT StoreError IO AChat
|
||||
getLocalChatPreview_ db user (LocalChatPD _ noteFolderId lastItemId_ stats) = do
|
||||
nf <- getNoteFolder db user noteFolderId
|
||||
lastItem <- case lastItemId_ of
|
||||
Just lastItemId -> (: []) <$> getLocalChatItem db user noteFolderId lastItemId
|
||||
Nothing -> pure []
|
||||
pure $ AChat SCTLocal (Chat (LocalChat nf) lastItem stats)
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toLocalChatItem :: UTCTime -> ChatItemRow -> Either StoreError (CChatItem 'CTLocal)
|
||||
toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
chatItem itemContent = case (itemContent, itemStatus, fileStatus_) of
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Just (AFS SMDSnd fileStatus)) ->
|
||||
Right $ cItem SMDSnd CILocalSnd ciStatus ciContent (maybeCIFile fileStatus)
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Nothing) ->
|
||||
Right $ cItem SMDSnd CILocalSnd ciStatus ciContent Nothing
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just (AFS SMDRcv fileStatus)) ->
|
||||
Right $ cItem SMDRcv CILocalRcv ciStatus ciContent (maybeCIFile fileStatus)
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Nothing) ->
|
||||
Right $ cItem SMDRcv CILocalRcv ciStatus ciContent Nothing
|
||||
_ -> badItem
|
||||
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
|
||||
maybeCIFile fileStatus =
|
||||
case (fileId_, fileName_, fileSize_, fileProtocol_) of
|
||||
(Just fileId, Just fileName, Just fileSize, Just fileProtocol) ->
|
||||
let cfArgs = CFArgs <$> fileKey <*> fileNonce
|
||||
fileSource = (`CryptoFile` cfArgs) <$> filePath
|
||||
in Just CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol}
|
||||
_ -> Nothing
|
||||
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
|
||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTLocal d
|
||||
ciMeta content status =
|
||||
let itemDeleted' = case itemDeleted of
|
||||
DBCINotDeleted -> Nothing
|
||||
_ -> Just (CIDeleted @'CTLocal deletedTs)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
getContactRequestChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
|
||||
getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
|
||||
CLQFilters {favorite = False, unread = False} -> query ""
|
||||
@@ -967,11 +1104,86 @@ getGroupChatBefore_ db user@User {userId} g@GroupInfo {groupId} beforeChatItemId
|
||||
|]
|
||||
(userId, groupId, search, beforeChatItemTs, beforeChatItemTs, beforeChatItemId, count)
|
||||
|
||||
toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64) -> Either StoreError (ChatRef, ChatItemId)
|
||||
getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTLocal)
|
||||
getLocalChat db user folderId pagination search_ = do
|
||||
let search = fromMaybe "" search_
|
||||
nf <- getNoteFolder db user folderId
|
||||
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 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
|
||||
pure $ Chat (LocalChat nf) (reverse chatItems) stats
|
||||
where
|
||||
getLocalChatItemIdsLast_ :: IO [ChatItemId]
|
||||
getLocalChatItemIdsLast_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, noteFolderId, search, count)
|
||||
|
||||
getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError 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
|
||||
pure $ Chat (LocalChat nf) chatItems stats
|
||||
where
|
||||
getLocalChatItemIdsAfter_ :: IO [ChatItemId]
|
||||
getLocalChatItemIdsAfter_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND chat_item_id > ?
|
||||
ORDER BY created_at ASC, chat_item_id ASC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, noteFolderId, search, afterChatItemId, count)
|
||||
|
||||
getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError 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
|
||||
pure $ Chat (LocalChat nf) (reverse chatItems) stats
|
||||
where
|
||||
getLocalChatItemIdsBefore_ :: IO [ChatItemId]
|
||||
getLocalChatItemIdsBefore_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND chat_item_id < ?
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, noteFolderId, search, beforeChatItemId, count)
|
||||
|
||||
toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64, Maybe Int64) -> Either StoreError (ChatRef, ChatItemId)
|
||||
toChatItemRef = \case
|
||||
(itemId, Just contactId, Nothing) -> Right (ChatRef CTDirect contactId, itemId)
|
||||
(itemId, Nothing, Just groupId) -> Right (ChatRef CTGroup groupId, itemId)
|
||||
(itemId, _, _) -> Left $ SEBadChatItem itemId
|
||||
(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
|
||||
|
||||
updateDirectChatItemsRead :: DB.Connection -> User -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO ()
|
||||
updateDirectChatItemsRead db User {userId} contactId itemsRange_ = do
|
||||
@@ -1079,6 +1291,27 @@ setGroupChatItemDeleteAt db User {userId} groupId chatItemId deleteAt =
|
||||
"UPDATE chat_items SET timed_delete_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?"
|
||||
(deleteAt, userId, groupId, chatItemId)
|
||||
|
||||
updateLocalChatItemsRead :: DB.Connection -> User -> NoteFolderId -> Maybe (ChatItemId, ChatItemId) -> IO ()
|
||||
updateLocalChatItemsRead db User {userId} noteFolderId itemsRange_ = 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)
|
||||
|
||||
type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe ACIFileStatus, Maybe FileProtocol)
|
||||
|
||||
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool)
|
||||
@@ -1204,7 +1437,7 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, contact_id, group_id
|
||||
SELECT chat_item_id, contact_id, group_id, note_folder_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
ORDER BY item_ts DESC, chat_item_id DESC
|
||||
@@ -1215,7 +1448,7 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, contact_id, group_id
|
||||
SELECT chat_item_id, contact_id, group_id, note_folder_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (item_ts > ? OR (item_ts = ? AND chat_item_id > ?))
|
||||
@@ -1228,7 +1461,7 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, contact_id, group_id
|
||||
SELECT chat_item_id, contact_id, group_id, note_folder_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (item_ts < ? OR (item_ts = ? AND chat_item_id < ?))
|
||||
@@ -1714,6 +1947,89 @@ getGroupChatItemIdByText' db User {userId} groupId msg =
|
||||
|]
|
||||
(userId, groupId, msg <> "%")
|
||||
|
||||
getLocalChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTLocal)
|
||||
getLocalChatItem db User {userId} folderId itemId = ExceptT $ do
|
||||
currentTs <- getCurrentTime
|
||||
firstRow' (toLocalChatItem currentTs) (SEChatItemNotFound itemId) getItem
|
||||
where
|
||||
getItem =
|
||||
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
|
||||
FROM chat_items i
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
WHERE i.user_id = ? AND i.note_folder_id = ? AND i.chat_item_id = ?
|
||||
|]
|
||||
(userId, folderId, itemId)
|
||||
|
||||
getLocalChatItemIdByText :: DB.Connection -> User -> NoteFolderId -> SMsgDirection d -> Text -> ExceptT StoreError IO ChatItemId
|
||||
getLocalChatItemIdByText db User {userId} noteFolderId msgDir quotedMsg =
|
||||
ExceptT . firstRow fromOnly (SEChatItemNotFoundByText quotedMsg) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_sent = ? AND item_text LIKE ?
|
||||
ORDER BY chat_item_id DESC
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, noteFolderId, msgDir, quotedMsg <> "%")
|
||||
|
||||
getLocalChatItemIdByText' :: DB.Connection -> User -> NoteFolderId -> Text -> ExceptT StoreError IO ChatItemId
|
||||
getLocalChatItemIdByText' db User {userId} noteFolderId msg =
|
||||
ExceptT . firstRow fromOnly (SEChatItemNotFoundByText msg) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE ?
|
||||
ORDER BY chat_item_id DESC
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, noteFolderId, msg <> "%")
|
||||
|
||||
updateLocalChatItem' :: forall d. MsgDirectionI d => DB.Connection -> User -> NoteFolderId -> ChatItem 'CTLocal d -> CIContent d -> IO (ChatItem 'CTLocal d)
|
||||
updateLocalChatItem' db User {userId} noteFolderId ci newContent = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let ci' = updatedChatItem ci newContent False currentTs
|
||||
liftIO $ updateLocalChatItem_ db userId noteFolderId ci'
|
||||
pure ci'
|
||||
|
||||
-- this function assumes that local item with correct chat direction already exists,
|
||||
-- it should be checked before calling it
|
||||
updateLocalChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> UserId -> NoteFolderId -> ChatItem 'CTLocal d -> IO ()
|
||||
updateLocalChatItem_ db userId noteFolderId ChatItem {meta, content} = do
|
||||
let CIMeta {itemId, itemText, itemStatus, itemDeleted, itemEdited, updatedAt} = meta
|
||||
itemDeleted' = isJust itemDeleted
|
||||
itemDeletedTs' = itemDeletedTs =<< itemDeleted
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, updated_at = ?
|
||||
WHERE user_id = ? AND note_folder_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
((content, itemText, itemStatus, itemDeleted', itemDeletedTs', itemEdited, updatedAt) :. (userId, noteFolderId, itemId))
|
||||
|
||||
deleteLocalChatItem :: DB.Connection -> User -> NoteFolder -> ChatItem 'CTLocal d -> IO ()
|
||||
deleteLocalChatItem db User {userId} NoteFolder {noteFolderId} ci = do
|
||||
let itemId = chatItemId' ci
|
||||
deleteChatItemVersions_ db itemId
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
DELETE FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(userId, noteFolderId, itemId)
|
||||
|
||||
getChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO AChatItem
|
||||
getChatItemByFileId db vr user@User {userId} fileId = do
|
||||
(chatRef, itemId) <-
|
||||
@@ -1721,7 +2037,7 @@ getChatItemByFileId db vr user@User {userId} fileId = do
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT i.chat_item_id, i.contact_id, i.group_id
|
||||
SELECT i.chat_item_id, i.contact_id, i.group_id, i.note_folder_id
|
||||
FROM chat_items i
|
||||
JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
WHERE f.user_id = ? AND f.file_id = ?
|
||||
@@ -1737,7 +2053,7 @@ getChatItemByGroupId db vr user@User {userId} groupId = do
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT i.chat_item_id, i.contact_id, i.group_id
|
||||
SELECT i.chat_item_id, i.contact_id, i.group_id, i.note_folder_id
|
||||
FROM chat_items i
|
||||
JOIN groups g ON g.chat_item_id = i.chat_item_id
|
||||
WHERE g.user_id = ? AND g.group_id = ?
|
||||
@@ -1766,6 +2082,10 @@ getAChatItem db vr user chatRef itemId = case chatRef of
|
||||
gInfo <- getGroupInfo db vr user groupId
|
||||
(CChatItem msgDir ci) <- getGroupChatItem db user groupId itemId
|
||||
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) ci
|
||||
ChatRef CTLocal folderId -> do
|
||||
nf <- getNoteFolder db user folderId
|
||||
CChatItem msgDir ci <- getLocalChatItem db user folderId itemId
|
||||
pure $ AChatItem SCTLocal msgDir (LocalChat nf) ci
|
||||
_ -> throwError $ SEChatItemNotFound itemId
|
||||
|
||||
getChatItemVersions :: DB.Connection -> ChatItemId -> IO [ChatItemVersion]
|
||||
|
||||
@@ -94,6 +94,7 @@ import Simplex.Chat.Migrations.M20231126_remote_ctrl_address
|
||||
import Simplex.Chat.Migrations.M20231207_chat_list_pagination
|
||||
import Simplex.Chat.Migrations.M20231214_item_content_tag
|
||||
import Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
|
||||
import Simplex.Chat.Migrations.M20240102_note_folders
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -187,7 +188,8 @@ schemaMigrations =
|
||||
("20231126_remote_ctrl_address", m20231126_remote_ctrl_address, Just down_m20231126_remote_ctrl_address),
|
||||
("20231207_chat_list_pagination", m20231207_chat_list_pagination, Just down_m20231207_chat_list_pagination),
|
||||
("20231214_item_content_tag", m20231214_item_content_tag, Just down_m20231214_item_content_tag),
|
||||
("20231215_recreate_msg_deliveries", m20231215_recreate_msg_deliveries, Just down_m20231215_recreate_msg_deliveries)
|
||||
("20231215_recreate_msg_deliveries", m20231215_recreate_msg_deliveries, Just down_m20231215_recreate_msg_deliveries),
|
||||
("20240102_note_folders", m20240102_note_folders, Just down_m20240102_note_folders)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -0,0 +1,69 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Simplex.Chat.Store.NoteFolders where
|
||||
|
||||
import Control.Monad.Except (ExceptT (..), throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Time (getCurrentTime)
|
||||
import Database.SQLite.Simple (Only (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
import Simplex.Chat.Store.Shared (StoreError (..))
|
||||
import Simplex.Chat.Types (NoteFolder (..), NoteFolderId, User (..))
|
||||
import Simplex.Messaging.Agent.Protocol (UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
|
||||
createNoteFolder :: DB.Connection -> User -> ExceptT StoreError IO ()
|
||||
createNoteFolder db User {userId} = do
|
||||
liftIO (DB.query db "SELECT note_folder_id FROM note_folders WHERE user_id = ? LIMIT 1" $ Only userId) >>= \case
|
||||
[] -> liftIO $ DB.execute db "INSERT INTO note_folders (user_id) VALUES (?)" (Only userId)
|
||||
Only noteFolderId : _ -> throwError $ SENoteFolderAlreadyExists noteFolderId
|
||||
|
||||
getUserNoteFolderId :: DB.Connection -> User -> ExceptT StoreError IO NoteFolderId
|
||||
getUserNoteFolderId db User {userId} =
|
||||
ExceptT . firstRow fromOnly SEUserNoteFolderNotFound $
|
||||
DB.query db "SELECT note_folder_id FROM note_folders WHERE user_id = ?" (Only userId)
|
||||
|
||||
getNoteFolder :: DB.Connection -> User -> NoteFolderId -> ExceptT StoreError IO NoteFolder
|
||||
getNoteFolder db User {userId} noteFolderId =
|
||||
ExceptT . firstRow toNoteFolder (SENoteFolderNotFound noteFolderId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
created_at, updated_at, chat_ts, favorite, unread_chat
|
||||
FROM note_folders
|
||||
WHERE user_id = ?
|
||||
AND note_folder_id = ?
|
||||
|]
|
||||
(userId, noteFolderId)
|
||||
where
|
||||
toNoteFolder (createdAt, updatedAt, chatTs, favorite, unread) =
|
||||
NoteFolder {noteFolderId, userId, createdAt, updatedAt, chatTs, favorite, unread}
|
||||
|
||||
updateNoteFolderUnreadChat :: DB.Connection -> User -> NoteFolder -> Bool -> IO ()
|
||||
updateNoteFolderUnreadChat db User {userId} NoteFolder {noteFolderId} unreadChat = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND note_folder_id = ?" (unreadChat, updatedAt, userId, noteFolderId)
|
||||
|
||||
deleteNoteFolderFiles :: DB.Connection -> UserId -> NoteFolder -> IO ()
|
||||
deleteNoteFolderFiles db userId NoteFolder {noteFolderId} = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
DELETE FROM files
|
||||
WHERE user_id = ?
|
||||
AND chat_item_id IN (
|
||||
SELECT chat_item_id FROM chat_items WHERE user_id = ? AND note_folder_id = ?
|
||||
)
|
||||
|]
|
||||
(userId, userId, noteFolderId)
|
||||
|
||||
deleteNoteFolderCIs :: DB.Connection -> User -> NoteFolder -> IO ()
|
||||
deleteNoteFolderCIs db User {userId} NoteFolder {noteFolderId} =
|
||||
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND note_folder_id = ?" (userId, noteFolderId)
|
||||
@@ -27,6 +27,7 @@ module Simplex.Chat.Store.Profiles
|
||||
getUserByARcvFileId,
|
||||
getUserByContactId,
|
||||
getUserByGroupId,
|
||||
getUserByNoteFolderId,
|
||||
getUserByFileId,
|
||||
getUserFileInfo,
|
||||
deleteUserRecord,
|
||||
@@ -120,6 +121,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
|
||||
(profileId, displayName, userId, True, currentTs, currentTs, currentTs)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
|
||||
|
||||
pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing)
|
||||
|
||||
getUsersInfo :: DB.Connection -> IO [UserInfo]
|
||||
@@ -200,6 +202,11 @@ getUserByGroupId db groupId =
|
||||
ExceptT . firstRow toUser (SEUserNotFoundByGroupId groupId) $
|
||||
DB.query db (userQuery <> " JOIN groups g ON g.user_id = u.user_id WHERE g.group_id = ?") (Only groupId)
|
||||
|
||||
getUserByNoteFolderId :: DB.Connection -> NoteFolderId -> ExceptT StoreError IO User
|
||||
getUserByNoteFolderId db contactId =
|
||||
ExceptT . firstRow toUser (SEUserNotFoundByContactId contactId) $
|
||||
DB.query db (userQuery <> " JOIN note_folders nf ON nf.user_id = u.user_id WHERE nf.note_folder_id = ?") (Only contactId)
|
||||
|
||||
getUserByFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO User
|
||||
getUserByFileId db fileId =
|
||||
ExceptT . firstRow toUser (SEUserNotFoundByFileId fileId) $
|
||||
|
||||
@@ -69,6 +69,9 @@ data StoreError
|
||||
| SEDuplicateGroupMember
|
||||
| SEGroupAlreadyJoined
|
||||
| SEGroupInvitationNotFound
|
||||
| SENoteFolderAlreadyExists {noteFolderId :: NoteFolderId}
|
||||
| SENoteFolderNotFound {noteFolderId :: NoteFolderId}
|
||||
| SEUserNoteFolderNotFound
|
||||
| SESndFileNotFound {fileId :: FileTransferId}
|
||||
| SESndFileInvalid {fileId :: FileTransferId}
|
||||
| SERcvFileNotFound {fileId :: FileTransferId}
|
||||
@@ -76,6 +79,7 @@ data StoreError
|
||||
| SEFileNotFound {fileId :: FileTransferId}
|
||||
| SERcvFileInvalid {fileId :: FileTransferId}
|
||||
| SERcvFileInvalidDescrPart
|
||||
| SELocalFileNoTransfer {fileId :: FileTransferId}
|
||||
| SESharedMsgIdNotFoundByFileId {fileId :: FileTransferId}
|
||||
| SEFileIdNotFoundBySharedMsgId {sharedMsgId :: SharedMsgId}
|
||||
| SESndFileNotFoundXFTP {agentSndFileId :: AgentSndFileId}
|
||||
|
||||
Reference in New Issue
Block a user