mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-06-04 21:12:05 +00:00
core: add direct xftp upload/download commands (#3781)
* chat: add direct xftp upload/download commands * adapt to FileDescriptionURI record * bump simplexmq * add description uploading * filter URIs by size * cleanup * add file meta to events * remove focus * auto-redirect when no URI fits * send "upload complete" event with the original file id * remove description upload command * add index * refactor * update simplexmq * Apply suggestions from code review Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> * fix /fc command for non-chat uploads * fix * rename (tests fail) * num recipients * update messages * split "file complete" events for chats and standalone * restore xftpSndFileRedirect * remove unused store error * add send/cancel test * untangle standalone views * fix confused id * fix /fc and /fs * resolve comments * misc fixes * bump simplexmq * fix build * handle redirect errors independently * fix missing file status in tests --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
committed by
GitHub
parent
e361bcf140
commit
daf67c0456
@@ -59,6 +59,7 @@ import Simplex.Chat.Remote.Types
|
||||
import Simplex.Chat.Store (AutoAccept, StoreError (..), UserContactLink, UserMsgReceiptSettings)
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.FileTransfer.Description (FileDescriptionURI)
|
||||
import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
|
||||
import Simplex.Messaging.Agent.Client (AgentLocks, AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
|
||||
@@ -453,6 +454,8 @@ data ChatCommand
|
||||
| ListRemoteCtrls
|
||||
| StopRemoteCtrl -- Stop listening for announcements or terminate an active session
|
||||
| DeleteRemoteCtrl RemoteCtrlId -- Remove all local data associated with a remote controller session
|
||||
| APIUploadStandaloneFile UserId CryptoFile
|
||||
| APIDownloadStandaloneFile UserId FileDescriptionURI CryptoFile
|
||||
| QuitChat
|
||||
| ShowVersion
|
||||
| DebugLocks
|
||||
@@ -593,21 +596,26 @@ data ChatResponse
|
||||
| CRRcvFileAccepted {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileDescrNotReady {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileStart {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileProgressXFTP {user :: User, chatItem :: AChatItem, receivedSize :: Int64, totalSize :: Int64}
|
||||
| CRRcvStandaloneFileCreated {user :: User, rcvFileTransfer :: RcvFileTransfer} -- returned by _download
|
||||
| CRRcvFileStart {user :: User, chatItem :: AChatItem} -- sent by chats
|
||||
| CRRcvFileProgressXFTP {user :: User, chatItem_ :: Maybe AChatItem, receivedSize :: Int64, totalSize :: Int64, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileComplete {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileCancelled {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvStandaloneFileComplete {user :: User, targetPath :: FilePath, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileCancelled {user :: User, chatItem_ :: Maybe AChatItem, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileSndCancelled {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileError {user :: User, chatItem :: AChatItem, agentError :: AgentErrorType}
|
||||
| CRRcvFileError {user :: User, chatItem_ :: Maybe AChatItem, agentError :: AgentErrorType, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRSndFileStart {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndFileComplete {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndFileRcvCancelled {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndFileCancelled {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
|
||||
| CRSndFileStartXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
|
||||
| CRSndFileProgressXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sentSize :: Int64, totalSize :: Int64}
|
||||
| CRSndFileRcvCancelled {user :: User, chatItem_ :: Maybe AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndFileCancelled {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
|
||||
| CRSndStandaloneFileCreated {user :: User, fileTransferMeta :: FileTransferMeta} -- returned by _upload
|
||||
| CRSndFileStartXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta} -- not used
|
||||
| CRSndFileProgressXFTP {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, sentSize :: Int64, totalSize :: Int64}
|
||||
| CRSndFileRedirectStartXFTP {user :: User, fileTransferMeta :: FileTransferMeta, redirectMeta :: FileTransferMeta}
|
||||
| CRSndFileCompleteXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
|
||||
| CRSndFileCancelledXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
|
||||
| CRSndFileError {user :: User, chatItem :: AChatItem}
|
||||
| CRSndStandaloneFileComplete {user :: User, fileTransferMeta :: FileTransferMeta, rcvURIs :: [Text]}
|
||||
| CRSndFileCancelledXFTP {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta}
|
||||
| CRSndFileError {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta}
|
||||
| CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile, updateSummary :: UserProfileUpdateSummary}
|
||||
| CRUserProfileImage {user :: User, profile :: Profile}
|
||||
| CRContactAliasUpdated {user :: User, toContact :: Contact}
|
||||
|
||||
@@ -0,0 +1,22 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20240214_redirect_file_id where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20240214_redirect_file_id :: Query
|
||||
m20240214_redirect_file_id =
|
||||
[sql|
|
||||
ALTER TABLE files ADD COLUMN redirect_file_id INTEGER REFERENCES files ON DELETE CASCADE;
|
||||
|
||||
CREATE INDEX idx_files_redirect_file_id on files(redirect_file_id);
|
||||
|]
|
||||
|
||||
down_m20240214_redirect_file_id :: Query
|
||||
down_m20240214_redirect_file_id =
|
||||
[sql|
|
||||
DROP INDEX idx_files_redirect_file_id;
|
||||
|
||||
ALTER TABLE files DROP COLUMN redirect_file_id;
|
||||
|]
|
||||
@@ -193,7 +193,8 @@ CREATE TABLE files(
|
||||
protocol TEXT NOT NULL DEFAULT 'smp',
|
||||
file_crypto_key BLOB,
|
||||
file_crypto_nonce BLOB,
|
||||
note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE
|
||||
note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE,
|
||||
redirect_file_id INTEGER REFERENCES files ON DELETE CASCADE
|
||||
);
|
||||
CREATE TABLE snd_files(
|
||||
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
|
||||
@@ -854,3 +855,4 @@ CREATE INDEX idx_chat_items_notes_item_status on chat_items(
|
||||
note_folder_id,
|
||||
item_status
|
||||
);
|
||||
CREATE INDEX idx_files_redirect_file_id on files(redirect_file_id);
|
||||
|
||||
@@ -39,6 +39,7 @@ module Simplex.Chat.Store.Files
|
||||
getGroupFileIdBySharedMsgId,
|
||||
getDirectFileIdBySharedMsgId,
|
||||
getChatRefByFileId,
|
||||
lookupChatRefByFileId,
|
||||
updateSndFileStatus,
|
||||
createSndFileChunk,
|
||||
updateSndFileChunkMsg,
|
||||
@@ -46,6 +47,7 @@ module Simplex.Chat.Store.Files
|
||||
deleteSndFileChunks,
|
||||
createRcvFileTransfer,
|
||||
createRcvGroupFileTransfer,
|
||||
createRcvStandaloneFileTransfer,
|
||||
appendRcvFD,
|
||||
getRcvFileDescrByRcvFileId,
|
||||
getRcvFileDescrBySndFileId,
|
||||
@@ -70,6 +72,7 @@ module Simplex.Chat.Store.Files
|
||||
getFileTransfer,
|
||||
getFileTransferProgress,
|
||||
getFileTransferMeta,
|
||||
lookupFileTransferRedirectMeta,
|
||||
getSndFileTransfer,
|
||||
getSndFileTransfers,
|
||||
getContactFileInfo,
|
||||
@@ -86,12 +89,14 @@ import Control.Monad
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Either (rights)
|
||||
import Data.Functor ((<&>))
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (fromMaybe, isJust, listToMaybe)
|
||||
import Data.Text (Text)
|
||||
import Data.Time (addUTCTime)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
|
||||
import Data.Type.Equality
|
||||
import Data.Word (Word32)
|
||||
import Database.SQLite.Simple (Only (..), (:.) (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
import Database.SQLite.Simple.ToField (ToField)
|
||||
@@ -184,7 +189,7 @@ createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitatio
|
||||
db
|
||||
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(fileId, fileStatus, fileInline, connId, currentTs, currentTs)
|
||||
pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
|
||||
pure FileTransferMeta {fileId, xftpSndFile = Nothing, xftpRedirectFor = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
|
||||
|
||||
createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO ()
|
||||
createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) subMode = do
|
||||
@@ -204,7 +209,7 @@ createSndGroupFileTransfer db userId GroupInfo {groupId} filePath FileInvitation
|
||||
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((userId, groupId, fileName, filePath, fileSize, chunkSize) :. (fileInline, CIFSSndStored, FPSMP, currentTs, currentTs))
|
||||
fileId <- insertedRowId db
|
||||
pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
|
||||
pure FileTransferMeta {fileId, xftpSndFile = Nothing, xftpRedirectFor = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
|
||||
|
||||
createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> SubscriptionMode -> IO ()
|
||||
createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} subMode = do
|
||||
@@ -277,16 +282,16 @@ getSndFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMs
|
||||
(\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, recipientDisplayName = n, connId, agentConnId})
|
||||
<$> (contactName_ <|> memberName_)
|
||||
|
||||
createSndFileTransferXFTP :: DB.Connection -> User -> ContactOrGroup -> CryptoFile -> FileInvitation -> AgentSndFileId -> Integer -> IO FileTransferMeta
|
||||
createSndFileTransferXFTP db User {userId} contactOrGroup (CryptoFile filePath cryptoArgs) FileInvitation {fileName, fileSize} agentSndFileId chunkSize = do
|
||||
createSndFileTransferXFTP :: DB.Connection -> User -> Maybe ContactOrGroup -> CryptoFile -> FileInvitation -> AgentSndFileId -> Maybe FileTransferId -> Integer -> IO FileTransferMeta
|
||||
createSndFileTransferXFTP db User {userId} contactOrGroup_ (CryptoFile filePath cryptoArgs) FileInvitation {fileName, fileSize} agentSndFileId xftpRedirectFor chunkSize = do
|
||||
currentTs <- getCurrentTime
|
||||
let xftpSndFile = Just XFTPSndFile {agentSndFileId, privateSndFileDescr = Nothing, agentSndFileDeleted = False, cryptoArgs}
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (contact_id, group_id, user_id, file_name, file_path, file_crypto_key, file_crypto_nonce, file_size, chunk_size, agent_snd_file_id, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
(contactAndGroupIds contactOrGroup :. (userId, fileName, filePath, CF.fileKey <$> cryptoArgs, CF.fileNonce <$> cryptoArgs, fileSize, chunkSize, agentSndFileId, CIFSSndStored, FPXFTP, currentTs, currentTs))
|
||||
"INSERT INTO files (contact_id, group_id, user_id, file_name, file_path, file_crypto_key, file_crypto_nonce, file_size, chunk_size, redirect_file_id, agent_snd_file_id, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
(maybe (Nothing, Nothing) contactAndGroupIds contactOrGroup_ :. (userId, fileName, filePath, CF.fileKey <$> cryptoArgs, CF.fileNonce <$> cryptoArgs, fileSize, chunkSize) :. (xftpRedirectFor, agentSndFileId, CIFSSndStored, FPXFTP, currentTs, currentTs))
|
||||
fileId <- insertedRowId db
|
||||
pure FileTransferMeta {fileId, xftpSndFile, fileName, filePath, fileSize, fileInline = Nothing, chunkSize, cancelled = False}
|
||||
pure FileTransferMeta {fileId, xftpSndFile, xftpRedirectFor, fileName, filePath, fileSize, fileInline = Nothing, chunkSize, cancelled = False}
|
||||
|
||||
createSndFTDescrXFTP :: DB.Connection -> User -> Maybe GroupMember -> Connection -> FileTransferMeta -> FileDescr -> IO ()
|
||||
createSndFTDescrXFTP db User {userId} m Connection {connId} FileTransferMeta {fileId} FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
|
||||
@@ -421,11 +426,14 @@ getDirectFileIdBySharedMsgId db User {userId} Contact {contactId} sharedMsgId =
|
||||
(userId, contactId, sharedMsgId)
|
||||
|
||||
getChatRefByFileId :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO ChatRef
|
||||
getChatRefByFileId db User {userId} fileId =
|
||||
liftIO getChatRef >>= \case
|
||||
[(Just contactId, Nothing)] -> pure $ ChatRef CTDirect contactId
|
||||
[(Nothing, Just groupId)] -> pure $ ChatRef CTGroup groupId
|
||||
_ -> throwError $ SEInternalError "could not retrieve chat ref by file id"
|
||||
getChatRefByFileId db user fileId = liftIO (lookupChatRefByFileId db user fileId) >>= maybe (throwError $ SEInternalError "could not retrieve chat ref by file id") pure
|
||||
|
||||
lookupChatRefByFileId :: DB.Connection -> User -> Int64 -> IO (Maybe ChatRef)
|
||||
lookupChatRefByFileId db User {userId} fileId =
|
||||
getChatRef <&> \case
|
||||
[(Just contactId, Nothing)] -> Just $ ChatRef CTDirect contactId
|
||||
[(Nothing, Just groupId)] -> Just $ ChatRef CTGroup groupId
|
||||
_ -> Nothing
|
||||
where
|
||||
getChatRef =
|
||||
DB.query
|
||||
@@ -536,6 +544,23 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
|
||||
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, rfdId, currentTs, currentTs)
|
||||
pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId, cryptoArgs = Nothing}
|
||||
|
||||
createRcvStandaloneFileTransfer :: DB.Connection -> UserId -> CryptoFile -> Int64 -> Word32 -> ExceptT StoreError IO Int64
|
||||
createRcvStandaloneFileTransfer db userId (CryptoFile filePath cfArgs_) fileSize chunkSize = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
fileId <- liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, file_name, file_path, file_size, chunk_size, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, takeFileName filePath, filePath, fileSize, chunkSize, CIFSRcvInvitation, FPXFTP, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
liftIO . forM_ cfArgs_ $ \cfArgs -> setFileCryptoArgs_ db fileId cfArgs currentTs
|
||||
liftIO $
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO rcv_files (file_id, file_status, created_at, updated_at) VALUES (?,?,?,?)"
|
||||
(fileId, FSNew, currentTs, currentTs)
|
||||
pure fileId
|
||||
|
||||
createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr
|
||||
createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
|
||||
when (fileDescrPartNo /= 0) $ throwError SERcvFileInvalidDescrPart
|
||||
@@ -662,9 +687,9 @@ getRcvFileTransfer_ db userId fileId = do
|
||||
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, Bool) :. (Maybe Int64, Maybe AgentConnId) ->
|
||||
ExceptT StoreError IO RcvFileTransfer
|
||||
rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, agentRcvFileDeleted) :. (connId_, agentConnId_)) =
|
||||
case contactName_ <|> memberName_ of
|
||||
case contactName_ <|> memberName_ <|> standaloneName_ of
|
||||
Nothing -> throwError $ SERcvFileInvalid fileId
|
||||
Just name -> do
|
||||
Just name ->
|
||||
case fileStatus' of
|
||||
FSNew -> pure $ ft name RFSNew
|
||||
FSAccepted -> ft name . RFSAccepted <$> rfi
|
||||
@@ -672,6 +697,9 @@ getRcvFileTransfer_ db userId fileId = do
|
||||
FSComplete -> ft name . RFSComplete <$> rfi
|
||||
FSCancelled -> ft name . RFSCancelled <$> rfi_
|
||||
where
|
||||
standaloneName_ = case (connId_, agentRcvFileId, filePath_) of
|
||||
(Nothing, Just _, Just _) -> Just "" -- filePath marks files that are accepted from contact or, in this case, set by createRcvDirectFileTransfer
|
||||
_ -> Nothing
|
||||
ft senderDisplayName fileStatus =
|
||||
let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
|
||||
cryptoArgs = CFArgs <$> fileKey <*> fileNonce
|
||||
@@ -906,17 +934,22 @@ getFileTransferMeta_ db userId fileId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT file_name, file_size, chunk_size, file_path, file_crypto_key, file_crypto_nonce, file_inline, agent_snd_file_id, agent_snd_file_deleted, private_snd_file_descr, cancelled
|
||||
SELECT file_name, file_size, chunk_size, file_path, file_crypto_key, file_crypto_nonce, file_inline, agent_snd_file_id, agent_snd_file_deleted, private_snd_file_descr, cancelled, redirect_file_id
|
||||
FROM files
|
||||
WHERE user_id = ? AND file_id = ?
|
||||
|]
|
||||
(userId, fileId)
|
||||
where
|
||||
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe AgentSndFileId, Bool, Maybe Text, Maybe Bool) -> FileTransferMeta
|
||||
fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileKey, fileNonce, fileInline, aSndFileId_, agentSndFileDeleted, privateSndFileDescr, cancelled_) =
|
||||
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe AgentSndFileId, Bool, Maybe Text, Maybe Bool, Maybe FileTransferId) -> FileTransferMeta
|
||||
fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileKey, fileNonce, fileInline, aSndFileId_, agentSndFileDeleted, privateSndFileDescr, cancelled_, xftpRedirectFor) =
|
||||
let cryptoArgs = CFArgs <$> fileKey <*> fileNonce
|
||||
xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr, agentSndFileDeleted, cryptoArgs}) <$> aSndFileId_
|
||||
in FileTransferMeta {fileId, xftpSndFile, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
|
||||
in FileTransferMeta {fileId, xftpSndFile, xftpRedirectFor, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
|
||||
|
||||
lookupFileTransferRedirectMeta :: DB.Connection -> User -> Int64 -> IO [FileTransferMeta]
|
||||
lookupFileTransferRedirectMeta db User {userId} fileId = do
|
||||
redirects <- DB.query db "SELECT file_id FROM files WHERE user_id = ? AND redirect_file_id = ?" (userId, fileId)
|
||||
rights <$> mapM (runExceptT . getFileTransferMeta_ db userId . fromOnly) redirects
|
||||
|
||||
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
|
||||
|
||||
@@ -92,6 +92,7 @@ module Simplex.Chat.Store.Messages
|
||||
getLocalChatItemIdByText,
|
||||
getLocalChatItemIdByText',
|
||||
getChatItemByFileId,
|
||||
lookupChatItemByFileId,
|
||||
getChatItemByGroupId,
|
||||
updateDirectChatItemStatus,
|
||||
getTimedItems,
|
||||
@@ -2085,6 +2086,12 @@ getChatItemByFileId db vr user@User {userId} fileId = do
|
||||
(userId, fileId)
|
||||
getAChatItem db vr user chatRef itemId
|
||||
|
||||
lookupChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
|
||||
lookupChatItemByFileId db vr user fileId = do
|
||||
fmap Just (getChatItemByFileId db vr user fileId) `catchError` \case
|
||||
SEChatItemNotFoundByFileId {} -> pure Nothing
|
||||
e -> throwError e
|
||||
|
||||
getChatItemByGroupId :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO AChatItem
|
||||
getChatItemByGroupId db vr user@User {userId} groupId = do
|
||||
(chatRef, itemId) <-
|
||||
|
||||
@@ -98,6 +98,7 @@ import Simplex.Chat.Migrations.M20240102_note_folders
|
||||
import Simplex.Chat.Migrations.M20240104_members_profile_update
|
||||
import Simplex.Chat.Migrations.M20240115_block_member_for_all
|
||||
import Simplex.Chat.Migrations.M20240122_indexes
|
||||
import Simplex.Chat.Migrations.M20240214_redirect_file_id
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -195,7 +196,8 @@ schemaMigrations =
|
||||
("20240102_note_folders", m20240102_note_folders, Just down_m20240102_note_folders),
|
||||
("20240104_members_profile_update", m20240104_members_profile_update, Just down_m20240104_members_profile_update),
|
||||
("20240115_block_member_for_all", m20240115_block_member_for_all, Just down_m20240115_block_member_for_all),
|
||||
("20240122_indexes", m20240122_indexes, Just down_m20240122_indexes)
|
||||
("20240122_indexes", m20240122_indexes, Just down_m20240122_indexes),
|
||||
("20240214_redirect_file_id", m20240214_redirect_file_id, Just down_m20240214_redirect_file_id)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -1210,6 +1210,7 @@ data FileTransfer
|
||||
data FileTransferMeta = FileTransferMeta
|
||||
{ fileId :: FileTransferId,
|
||||
xftpSndFile :: Maybe XFTPSndFile,
|
||||
xftpRedirectFor :: Maybe FileTransferId,
|
||||
fileName :: String,
|
||||
filePath :: String,
|
||||
fileSize :: Integer,
|
||||
|
||||
@@ -198,17 +198,24 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
CRGroupMemberUpdated {} -> []
|
||||
CRContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
|
||||
CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
|
||||
CRRcvStandaloneFileCreated u ft -> ttyUser u $ receivingFileStandalone "started" ft
|
||||
CRRcvFileStart u ci -> ttyUser u $ receivingFile_' hu testView "started" ci
|
||||
CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' hu testView "completed" ci
|
||||
CRRcvStandaloneFileComplete u _ ft -> ttyUser u $ receivingFileStandalone "completed" ft
|
||||
CRRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
|
||||
CRRcvFileError u ci e -> ttyUser u $ receivingFile_' hu testView "error" ci <> [sShow e]
|
||||
CRRcvFileError u (Just ci) e _ -> ttyUser u $ receivingFile_' hu testView "error" ci <> [sShow e]
|
||||
CRRcvFileError u Nothing e ft -> ttyUser u $ receivingFileStandalone "error" ft <> [sShow e]
|
||||
CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
|
||||
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
|
||||
CRSndStandaloneFileCreated u ft -> ttyUser u $ uploadingFileStandalone "started" ft
|
||||
CRSndFileStartXFTP {} -> []
|
||||
CRSndFileProgressXFTP {} -> []
|
||||
CRSndFileRedirectStartXFTP u ft ftRedirect -> ttyUser u $ standaloneUploadRedirect ft ftRedirect
|
||||
CRSndStandaloneFileComplete u ft uris -> ttyUser u $ standaloneUploadComplete ft uris
|
||||
CRSndFileCompleteXFTP u ci _ -> ttyUser u $ uploadingFile "completed" ci
|
||||
CRSndFileCancelledXFTP {} -> []
|
||||
CRSndFileError u ci -> ttyUser u $ uploadingFile "error" ci
|
||||
CRSndFileError u Nothing ft -> ttyUser u $ uploadingFileStandalone "error" ft
|
||||
CRSndFileError u (Just ci) _ -> ttyUser u $ uploadingFile "error" ci
|
||||
CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
|
||||
ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
|
||||
CRContactConnecting u _ -> ttyUser u []
|
||||
@@ -1558,11 +1565,26 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
|
||||
[status <> " sending " <> sndFile ft <> " to " <> ttyContact c]
|
||||
|
||||
uploadingFile :: StyledString -> AChatItem -> [StyledString]
|
||||
uploadingFile status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectSnd}) =
|
||||
[status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyContact c]
|
||||
uploadingFile status (AChatItem _ _ (GroupChat g) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupSnd}) =
|
||||
[status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g]
|
||||
uploadingFile status _ = [status <> " uploading file"] -- shouldn't happen
|
||||
uploadingFile status = \case
|
||||
AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectSnd} ->
|
||||
[status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyContact c]
|
||||
AChatItem _ _ (GroupChat g) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupSnd} ->
|
||||
[status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g]
|
||||
_ -> [status <> " uploading file"]
|
||||
|
||||
uploadingFileStandalone :: StyledString -> FileTransferMeta -> [StyledString]
|
||||
uploadingFileStandalone status FileTransferMeta {fileId, fileName} = [status <> " standalone uploading " <> fileTransferStr fileId fileName]
|
||||
|
||||
standaloneUploadRedirect :: FileTransferMeta -> FileTransferMeta -> [StyledString]
|
||||
standaloneUploadRedirect FileTransferMeta {fileId, fileName} FileTransferMeta {fileId = redirectId} =
|
||||
[fileTransferStr fileId fileName <> " uploaded, preparing redirect file " <> sShow redirectId]
|
||||
|
||||
standaloneUploadComplete :: FileTransferMeta -> [Text] -> [StyledString]
|
||||
standaloneUploadComplete FileTransferMeta {fileId, fileName} = \case
|
||||
[] -> [fileTransferStr fileId fileName <> " upload complete."]
|
||||
uris ->
|
||||
fileTransferStr fileId fileName <> " upload complete. download with:"
|
||||
: map plain uris
|
||||
|
||||
sndFile :: SndFileTransfer -> StyledString
|
||||
sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName
|
||||
@@ -1608,7 +1630,11 @@ receivingFile_' hu testView status (AChatItem _ _ chat ChatItem {file = Just CIF
|
||||
highlight ("/get remote file " <> show rhId <> " " <> LB.unpack (J.encode RemoteFile {userId, fileId, sent = False, fileSource = f}))
|
||||
]
|
||||
_ -> []
|
||||
receivingFile_' _ _ status _ = [plain status <> " receiving file"] -- shouldn't happen
|
||||
receivingFile_' _ _ status _ = [plain status <> " receiving file"]
|
||||
|
||||
receivingFileStandalone :: String -> RcvFileTransfer -> [StyledString]
|
||||
receivingFileStandalone status RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} =
|
||||
[plain status <> " standalone receiving " <> fileTransferStr fileId fileName]
|
||||
|
||||
viewLocalFile :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewLocalFile to CIFile {fileId, fileSource} ts tz = case fileSource of
|
||||
@@ -1627,7 +1653,7 @@ fileFrom _ _ = ""
|
||||
|
||||
receivingFile_ :: StyledString -> RcvFileTransfer -> [StyledString]
|
||||
receivingFile_ status ft@RcvFileTransfer {senderDisplayName = c} =
|
||||
[status <> " receiving " <> rcvFile ft <> " from " <> ttyContact c]
|
||||
[status <> " receiving " <> rcvFile ft <> if c == "" then "" else " from " <> ttyContact c]
|
||||
|
||||
rcvFile :: RcvFileTransfer -> StyledString
|
||||
rcvFile RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} = fileTransferStr fileId fileName
|
||||
|
||||
Reference in New Issue
Block a user