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>

src/Simplex/Chat/Store/Files.hs

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

src/Simplex/Chat/Store/Messages.hs

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

src/Simplex/Chat/Store/Migrations.hs

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