From d7f9e17bcb95a13c66e42a5a61aa67acc85272ce Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 13 Mar 2023 10:30:32 +0000
Subject: [PATCH] core: use XFTP to send and receive files (#1993)
* core: use XFTP to send and receive files
* xftp files progress
* xftp reception stubs, migration
* update simplexmq
* xftp sequence diagram
* additional chat events
* send file via XFTP
* send XFTP file description inline when file is uploaded
---
cabal.project | 4 +-
docs/protocol/diagrams/xftp.mmd | 42 +++
scripts/nix/sha256map.nix | 4 +-
src/Simplex/Chat.hs | 301 +++++++++++++-----
src/Simplex/Chat/Archive.hs | 2 +-
src/Simplex/Chat/Controller.hs | 30 ++
src/Simplex/Chat/Messages.hs | 67 +++-
.../Migrations/M20230304_file_description.hs | 24 +-
src/Simplex/Chat/Migrations/chat_schema.sql | 20 +-
src/Simplex/Chat/Store.hs | 146 ++++++---
src/Simplex/Chat/Types.hs | 78 ++++-
src/Simplex/Chat/View.hs | 11 +-
stack.yaml | 4 +-
13 files changed, 580 insertions(+), 153 deletions(-)
create mode 100644 docs/protocol/diagrams/xftp.mmd
diff --git a/cabal.project b/cabal.project
index c5c00106eb..b9ddbd34d4 100644
--- a/cabal.project
+++ b/cabal.project
@@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
- tag: 8fde8e1344699cdcdc67709595c9285cd06bbef3
+ tag: bd4fecf4a84071079cffccfc0f35a916eac0e086
source-repository-package
type: git
@@ -17,7 +17,7 @@ source-repository-package
source-repository-package
type: git
location: https://github.com/kazu-yamamoto/http2.git
- tag: b3b62ba36900babfde1a073c705cbccc2685f385
+ tag: 78e18f52295a7f89e828539a03fbcb24931461a3
source-repository-package
type: git
diff --git a/docs/protocol/diagrams/xftp.mmd b/docs/protocol/diagrams/xftp.mmd
new file mode 100644
index 0000000000..af45952075
--- /dev/null
+++ b/docs/protocol/diagrams/xftp.mmd
@@ -0,0 +1,42 @@
+sequenceDiagram
+ participant A as Alice
+ participant AC as Alice Chat
+ participant AA as Alice Agent
+ participant XFTP as Alice's XFTP relay(s)
+ participant SMP as Bob's SMP relay
+ participant BA as Bob Agent
+ participant BC as Bob Chat
+ participant B as Bob
+
+ A ->> AC: APISendMessage
+ AC ->> AA: sendMessage(x.msg.new) /
CIFSSndStored
+ AA ->> SMP: SEND
+ SMP ->> BA: MSG
+ BA ->> BC: MSG
+ BC ->> B: CRNewChatItem
(file not ready)
+ B ->> BC: ReceiveFile
+ BC ->> B: error: no file description
+ AC ->> AA: sendFile
+ AC ->> A: CRSndFileStart
+ AA ->> XFTP: chunk (FNEW, FPUT)
+ AA ->> AC: SFPROG /
CIFSSndTransfer
+ AC ->> A: CRSndFileProgress (new)
+ AA ->> XFTP: chunks
+ AA ->> AC: SFDONE sd rds
+ AC ->> AA: sendMessage(x.msg.file.descr) /
FSComplete / CIFSSndComplete
+ AC ->> A: CRSndFileComplete (?)
+ AA ->> SMP: SEND
+ SMP ->> BA: MSG
+ BA ->> BC: MSG
+ BC ->> B: CRChatItemUpdated
(file is ready)
+ BC ->> B: CRFileReady (TBC)
+ B ->> BC: ReceiveFile
+ BC ->> BA: getFile
+ BC ->> B: CRRcvFileStart
+ XFTP ->> BA: chunk (FGET / FRFile)
+ BA ->> BC: RFPROG
+ BC ->> B: CRRcvFileProgress (new)
+ XFTP ->> BA: chunks
+ BA ->> BC: RFDONE
+ BC ->> B: CRNewChatItem
(file received)
+ BC ->> B: CRRcvFileComplete
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index c945101586..bb3d718135 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,7 +1,7 @@
{
- "https://github.com/simplex-chat/simplexmq.git"."8fde8e1344699cdcdc67709595c9285cd06bbef3" = "1nvxmmfq3k1a8l14lksxdsqzxq19kmvg2kpiryqdks3k946x6pzn";
+ "https://github.com/simplex-chat/simplexmq.git"."bd4fecf4a84071079cffccfc0f35a916eac0e086" = "11sp91znlnfflilw0gdd64f4z6y9ni88iv7xjrdkyj6yhjqfa4wr";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
- "https://github.com/kazu-yamamoto/http2.git"."b3b62ba36900babfde1a073c705cbccc2685f385" = "076gl9mcm9gxcif5662g5ar0pd817657mc46y99ighria3z36cmz";
+ "https://github.com/kazu-yamamoto/http2.git"."78e18f52295a7f89e828539a03fbcb24931461a3" = "05q165anvv0qrcxqbvq1dlvw0l8gmsa9kl6sazk1mfhz2g0yimdk";
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
"https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0";
"https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index e2f31b94a1..f504230692 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -69,7 +69,7 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (base64P)
-import Simplex.Messaging.Protocol (ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI)
+import Simplex.Messaging.Protocol (EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI)
import qualified Simplex.Messaging.Protocol as SMP
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport.Client (defaultSocksProxy)
@@ -105,7 +105,9 @@ defaultChatConfig =
},
tbqSize = 1024,
fileChunkSize = 15780, -- do not change
+ xftpDescrPartSize = 14000,
inlineFiles = defaultInlineFilesConfig,
+ xftpFileConfig = Nothing,
logLevel = CLLImportant,
subscriptionEvents = False,
hostEvents = False,
@@ -165,7 +167,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
cleanupManagerAsync <- newTVarIO Nothing
timedItemThreads <- atomically TM.empty
showLiveItems <- newTVarIO False
- pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, logFilePath = logFile}
+ userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
+ pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, logFilePath = logFile}
where
configServers :: DefaultAgentServers
configServers =
@@ -380,9 +383,9 @@ processChatCommand = \case
if isVoice mc && not (featureAllowed SCFVoice forUser ct)
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (chatFeatureNameText CFVoice))
else do
- (fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct
+ (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct
timed_ <- sndContactCITimed live ct
- (msgContainer, quotedItem_) <- prepareMsg fileInvitation_ timed_
+ (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_
(msg@SndMessage {sharedMsgId}, _) <- sendDirectContactMessage ct (XMsgNew msgContainer)
case ft_ of
Just ft@FileTransferMeta {fileInline = Just IFMSent} ->
@@ -396,23 +399,30 @@ processChatCommand = \case
where
setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
setupSndFileTransfer ct = forM file_ $ \file -> do
- (fileSize, chSize, fileInline) <- checkSndFile mc file 1
- (agentConnId_, fileConnReq) <-
- if isJust fileInline
- then pure (Nothing, Nothing)
- else bimap Just Just <$> withAgent (\a -> createConnection a (aUserId user) True SCMInvitation Nothing)
- let fileName = takeFileName file
- fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
- withStore' $ \db -> do
- ft@FileTransferMeta {fileId} <- createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize
- fileStatus <- case fileInline of
- Just IFMSent -> createSndDirectInlineFT db ct ft $> CIFSSndTransfer
- _ -> pure CIFSSndStored
- let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
- pure (fileInvitation, ciFile, ft)
+ (fileSize, fileMode) <- checkSndFile mc file 1
+ case fileMode of
+ SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
+ SendFileXFTP xftpCfg -> xftpSndFileTransfer user file fileSize xftpCfg 1 $ CGContact ct
+ where
+ smpSndFileTransfer :: FilePath -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
+ smpSndFileTransfer file fileSize fileInline = do
+ (agentConnId_, fileConnReq) <-
+ if isJust fileInline
+ then pure (Nothing, Nothing)
+ else bimap Just Just <$> withAgent (\a -> createConnection a (aUserId user) True SCMInvitation Nothing)
+ let fileName = takeFileName file
+ fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
+ chSize <- asks $ fileChunkSize . config
+ withStore' $ \db -> do
+ ft@FileTransferMeta {fileId} <- createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize
+ fileStatus <- case fileInline of
+ Just IFMSent -> createSndDirectInlineFT db ct ft $> CIFSSndTransfer 0 1
+ _ -> pure CIFSSndStored
+ let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
+ pure (fileInvitation, ciFile, ft)
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
- prepareMsg fileInvitation_ timed_ = case quotedItemId_ of
- Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_ (ttl' <$> timed_) (justTrue live)), Nothing)
+ prepareMsg fInv_ timed_ = case quotedItemId_ of
+ Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
Just quotedItemId -> do
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getDirectChatItem db user chatId quotedItemId
@@ -420,7 +430,7 @@ processChatCommand = \case
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
qmc = quoteContent origQmc file
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
- pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
+ pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
where
quoteData :: ChatItem c d -> m (MsgContent, CIQDirection 'CTDirect, Bool)
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote
@@ -433,9 +443,9 @@ processChatCommand = \case
if isVoice mc && not (groupFeatureAllowed SGFVoice gInfo)
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFVoice))
else do
- (fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo (length $ filter memberCurrent ms)
+ (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live gInfo
- (msgContainer, quotedItem_) <- prepareMsg fileInvitation_ timed_ membership
+ (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
msg@SndMessage {sharedMsgId} <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
@@ -446,14 +456,21 @@ processChatCommand = \case
where
setupSndFileTransfer :: GroupInfo -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
setupSndFileTransfer gInfo n = forM file_ $ \file -> do
- (fileSize, chSize, fileInline) <- checkSndFile mc file $ fromIntegral n
- let fileName = takeFileName file
- fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline, fileDescr = Nothing}
- fileStatus = if fileInline == Just IFMSent then CIFSSndTransfer else CIFSSndStored
- withStore' $ \db -> do
- ft@FileTransferMeta {fileId} <- createSndGroupFileTransfer db userId gInfo file fileInvitation chSize
- let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
- pure (fileInvitation, ciFile, ft)
+ (fileSize, fileMode) <- checkSndFile mc file $ fromIntegral n
+ case fileMode of
+ SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
+ SendFileXFTP xftpCfg -> xftpSndFileTransfer user file fileSize xftpCfg n $ CGGroup gInfo
+ where
+ smpSndFileTransfer :: FilePath -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
+ smpSndFileTransfer file fileSize fileInline = do
+ let fileName = takeFileName file
+ fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline, fileDescr = Nothing}
+ fileStatus = if fileInline == Just IFMSent then CIFSSndTransfer 0 1 else CIFSSndStored
+ chSize <- asks $ fileChunkSize . config
+ withStore' $ \db -> do
+ ft@FileTransferMeta {fileId} <- createSndGroupFileTransfer db userId gInfo file fileInvitation chSize
+ let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
+ pure (fileInvitation, ciFile, ft)
sendGroupFileInline :: [GroupMember] -> SharedMsgId -> FileTransferMeta -> m ()
sendGroupFileInline ms sharedMsgId ft@FileTransferMeta {fileInline} =
when (fileInline == Just IFMSent) . forM_ ms $ \m ->
@@ -465,8 +482,8 @@ processChatCommand = \case
sendMemberFileInline m conn ft sharedMsgId
processMember _ = pure ()
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
- prepareMsg fileInvitation_ timed_ membership = case quotedItemId_ of
- Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_ (ttl' <$> timed_) (justTrue live)), Nothing)
+ prepareMsg fInv_ timed_ membership = case quotedItemId_ of
+ Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
Just quotedItemId -> do
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getGroupChatItem db user chatId quotedItemId
@@ -474,7 +491,7 @@ processChatCommand = \case
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
qmc = quoteContent origQmc file
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
- pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
+ pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
where
quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote
@@ -507,6 +524,14 @@ processChatCommand = \case
qText = msgContentText qmc
qFileName = maybe qText (T.pack . (fileName :: CIFile d -> String)) ciFile_
qTextOrFile = if T.null qText then qFileName else qText
+ xftpSndFileTransfer :: User -> FilePath -> Integer -> XFTPFileConfig -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
+ xftpSndFileTransfer user file fileSize XFTPFileConfig {tempDirectory} n contactOrGroup = do
+ let fileName = takeFileName file
+ fInv = xftpFileInvitation fileName fileSize
+ aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) file n tempDirectory
+ ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv $ AgentSndFileId aFileId
+ let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
+ pure (fInv, ciFile, ft)
unzipMaybe3 :: Maybe (a, b, c) -> (Maybe a, Maybe b, Maybe c)
unzipMaybe3 (Just (a, b, c)) = (Just a, Just b, Just c)
unzipMaybe3 _ = (Nothing, Nothing, Nothing)
@@ -1350,7 +1375,7 @@ processChatCommand = \case
updateGroupProfileByName gName $ \p ->
p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
QuitChat -> liftIO exitSuccess
- ShowVersion -> pure $ CRVersionInfo $ coreVersionInfo $(buildTimestampQ) "" -- $(simplexmqCommitQ)
+ ShowVersion -> pure $ CRVersionInfo $ coreVersionInfo $(buildTimestampQ) $(simplexmqCommitQ)
DebugLocks -> do
chatLockName <- atomically . tryReadTMVar =<< asks chatLock
agentLocks <- withAgent debugAgentLocks
@@ -1441,14 +1466,21 @@ processChatCommand = \case
contactMember Contact {contactId} =
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft
- checkSndFile :: MsgContent -> FilePath -> Integer -> m (Integer, Integer, Maybe InlineFileMode)
+ checkSndFile :: MsgContent -> FilePath -> Integer -> m (Integer, SendFileMode)
checkSndFile mc f n = do
fsFilePath <- toFSFilePath f
unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f
ChatConfig {fileChunkSize, inlineFiles} <- asks config
+ xftpCfg <- readTVarIO =<< asks userXFTPFileConfig
fileSize <- getFileSize fsFilePath
let chunks = - ((- fileSize) `div` fileChunkSize)
- pure (fileSize, fileChunkSize, inlineFileMode mc inlineFiles chunks n)
+ fileInline = inlineFileMode mc inlineFiles chunks n
+ fileMode = case xftpCfg of
+ Just cfg
+ | fileInline == Just IFMSent || fileSize < minFileSize cfg -> SendFileSMP fileInline
+ | otherwise -> SendFileXFTP cfg
+ _ -> SendFileSMP fileInline
+ pure (fileSize, fileMode)
inlineFileMode mc InlineFilesConfig {offerChunks, sendChunks, totalSendChunks} chunks n
| chunks > offerChunks = Nothing
| chunks <= sendChunks && chunks * n <= totalSendChunks && isVoice mc = Just IFMSent
@@ -1711,18 +1743,22 @@ toFSFilePath f =
maybe f (<> "/" <> f) <$> (readTVarIO =<< asks filesFolder)
acceptFileReceive :: forall m. ChatMonad m => User -> RcvFileTransfer -> Maybe Bool -> Maybe FilePath -> m AChatItem
-acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId} rcvInline_ filePath_ = do
+acceptFileReceive user@User {userId} RcvFileTransfer {fileId, rcvFileDescription, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId} rcvInline_ filePath_ = do
unless (fileStatus == RFSNew) $ case fileStatus of
RFSCancelled _ -> throwChatError $ CEFileCancelled fName
_ -> throwChatError $ CEFileAlreadyReceiving fName
- case fileConnReq of
+ case (rcvFileDescription, fileConnReq) of
-- direct file protocol
- Just connReq -> do
+ (Nothing, Just connReq) -> do
connIds <- joinAgentConnectionAsync user True connReq . directMessage $ XFileAcpt fName
filePath <- getRcvFilePath fileId filePath_ fName
withStore $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath
-- group & direct file protocol
- Nothing -> do
+ (Just _fd, _) -> do
+ -- check if file description is fully received, error otherwise
+ -- pass file description to the agent and save AgentRcvFileId
+ throwChatError $ CEFileInternal "XFTP file receiption not implemented"
+ _ -> do
chatRef <- withStore $ \db -> getChatRefByFileId db user fileId
case (chatRef, grpMemberId) of
(ChatRef CTDirect contactId, Nothing) -> do
@@ -1837,18 +1873,24 @@ deleteGroupLink_ user gInfo conn = do
deleteAgentConnectionAsync user $ aConnId conn
withStore' $ \db -> deleteGroupLink db user gInfo
-agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
+agentSubscriber :: forall m. (MonadUnliftIO m, MonadReader ChatController m) => m ()
agentSubscriber = do
q <- asks $ subQ . smpAgent
l <- asks chatLock
- forever $ do
- (corrId, connId, APC _ msg) <- atomically $ readTBQueue q
- let name = "agentSubscriber connId=" <> str connId <> " corrId=" <> str corrId <> " msg=" <> str (aCommandTag msg)
- withLock l name . void . runExceptT $
- processAgentMessage corrId connId msg `catchError` (toView . CRChatError Nothing)
+ forever $ atomically (readTBQueue q) >>= void . process l
where
- str :: StrEncoding a => a -> String
- str = B.unpack . strEncode
+ process :: Lock -> (ACorrId, EntityId, APartyCmd 'Agent) -> m (Either ChatError ())
+ process l (corrId, entId, APC e msg) = run $ case e of
+ SAENone -> processAgentMessageNoConn msg
+ SAEConn -> processAgentMessage corrId entId msg
+ SAERcvFile -> processAgentMsgRcvFile corrId entId msg
+ SAESndFile -> processAgentMsgSndFile corrId entId msg
+ where
+ run action = do
+ let name = "agentSubscriber entity=" <> show e <> " entId=" <> str entId <> " msg=" <> str (aCommandTag msg)
+ withLock l name $ runExceptT $ action `catchError` (toView . CRChatError Nothing)
+ str :: StrEncoding a => a -> String
+ str = B.unpack . strEncode
type AgentBatchSubscribe m = AgentClient -> [ConnId] -> ExceptT AgentErrorType m (Map ConnId (Either AgentErrorType ()))
@@ -2066,9 +2108,7 @@ expireChatItems user@User {userId} ttl sync = do
membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db user gInfo
forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m
-processAgentMessage :: forall e m. (AEntityI e, ChatMonad m) => ACorrId -> ConnId -> ACommand 'Agent e -> m ()
-processAgentMessage _ "" msg =
- processAgentMessageNoConn msg `catchError` (toView . CRChatError Nothing)
+processAgentMessage :: forall m. ChatMonad m => ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
processAgentMessage _ connId (DEL_RCVQ srv qId err_) =
toView $ CRAgentRcvQueueDeleted (AgentConnId connId) srv (AgentQueueId qId) err_
processAgentMessage _ connId DEL_CONN =
@@ -2078,7 +2118,7 @@ processAgentMessage corrId connId msg =
Just user -> processAgentMessageConn user corrId connId msg `catchError` (toView . CRChatError (Just user))
_ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
-processAgentMessageNoConn :: forall e m. ChatMonad m => ACommand 'Agent e -> m ()
+processAgentMessageNoConn :: forall m. ChatMonad m => ACommand 'Agent 'AENone -> m ()
processAgentMessageNoConn = \case
CONNECT p h -> hostEvent $ CRHostConnected p h
DISCONNECT p h -> hostEvent $ CRHostDisconnected p h
@@ -2086,7 +2126,6 @@ processAgentMessageNoConn = \case
UP srv conns -> serverEvent srv conns CRContactsSubscribed "connected"
SUSPENDED -> toView CRChatSuspended
DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId
- _ -> pure ()
where
hostEvent :: ChatResponse -> m ()
hostEvent = whenM (asks $ hostEvents . config) . toView
@@ -2095,7 +2134,92 @@ processAgentMessageNoConn = \case
toView $ event srv cs
showToast ("server " <> str) (safeDecodeUtf8 $ strEncode host)
-processAgentMessageConn :: forall e m. (AEntityI e, ChatMonad m) => User -> ACorrId -> ConnId -> ACommand 'Agent e -> m ()
+processAgentMsgSndFile :: forall m. ChatMonad m => ACorrId -> SndFileId -> ACommand 'Agent 'AESndFile -> m ()
+processAgentMsgSndFile _corrId aFileId msg =
+ withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case
+ Just user -> process user `catchError` (toView . CRChatError (Just user))
+ _ -> throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId
+ where
+ process :: User -> m ()
+ process user = do
+ ft@FileTransferMeta {fileId} <- withStore $ \db -> getAgentSndFileXFTP db user $ AgentSndFileId aFileId
+ case msg of
+ SFPROG _sent _total -> do
+ -- update chat item status
+ -- send status to view
+ pure ()
+ SFDONE _sndDescr rfds -> do
+ AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}} <-
+ withStore $ \db -> getChatItemByFileId db user fileId
+ case (msgId_, itemDeleted) of
+ (Just sharedMsgId, Nothing) -> case (rfds, d, cInfo) of
+ (rfd : _, SMDSnd, DirectChat ct) -> do
+ let rfdText = safeDecodeUtf8 $ strEncode rfd
+ withStore' $ \db -> createSndDirectFTDescrXFTP db user ct ft rfdText
+ -- TODO update chat item status to show 100% progress
+ sendDirectFileDescription ct rfdText ft sharedMsgId
+ (_, SMDSnd, GroupChat _g) -> do
+ -- store file descriptions and files to snd_files
+ -- send messages with descriptions to the recipients
+ -- update chat item file status (CIFileStatus)
+ -- update sent file status
+ -- ??? possibly another event as we need one event per group, not per member
+ -- toView $ CRSndFileComplete user ci ft
+ pure ()
+ _ -> pure () -- TODO error
+ _ -> pure () -- TODO error
+ pure ()
+ where
+ sendDirectFileDescription :: Contact -> Text -> FileTransferMeta -> SharedMsgId -> m ()
+ sendDirectFileDescription ct rfd ft sharedMsgId = do
+ msgDeliveryId <- sendFileDescription_ rfd sharedMsgId $ sendDirectContactMessage ct
+ withStore' $ \db -> updateSndDirectFTDelivery db ct ft msgDeliveryId
+
+ _sendMemberFileDescription :: GroupMember -> Connection -> Text -> FileTransferMeta -> SharedMsgId -> m ()
+ _sendMemberFileDescription m@GroupMember {groupId} conn rfd ft sharedMsgId = do
+ msgDeliveryId <- sendFileDescription_ rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
+ withStore' $ \db -> updateSndGroupFTDelivery db m conn ft msgDeliveryId
+
+ sendFileDescription_ :: Text -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m Int64
+ sendFileDescription_ rfdText msgId sendMsg = do
+ partSize <- asks $ xftpDescrPartSize . config
+ sendParts 1 partSize rfdText
+ where
+ sendParts partNo partSize rfd = do
+ let (part, rest) = T.splitAt partSize rfd
+ complete = T.null rest
+ fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
+ (_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileDescr}
+ if complete
+ then pure msgDeliveryId
+ else sendParts (partNo + 1) partSize rest
+
+processAgentMsgRcvFile :: forall m. ChatMonad m => ACorrId -> RcvFileId -> ACommand 'Agent 'AERcvFile -> m ()
+processAgentMsgRcvFile _corrId aFileId msg =
+ withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case
+ Just user -> process user `catchError` (toView . CRChatError (Just user))
+ _ -> throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId
+ where
+ process :: User -> m ()
+ process user = do
+ _rcvFile <- withStore (\db -> getAgentRcvFileXFTP db user $ AgentRcvFileId aFileId)
+ -- >>= updateConnStatus
+ -- load file transfer meta (add chat item status to type and also contact/group)
+ case msg of
+ RFPROG _sent _total -> do
+ -- update chat item status
+ -- send status to view
+ pure ()
+ RFDONE _filePath -> do
+ -- update chat item status
+ -- send status to view
+ pure ()
+ RFERR _e -> do
+ -- update chat item status
+ -- send status to view
+ pure ()
+
+processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
processAgentMessageConn user _ agentConnId END =
withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= \case
RcvDirectMsgConnection _ (Just ct@Contact {localDisplayName = c}) -> do
@@ -2186,6 +2310,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
updateChatLock "directMessage" event
case event of
XMsgNew mc -> newContentMessage ct mc msg msgMeta
+ XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct sharedMsgId fileDescr msgMeta
+ XMsgFileCancel sharedMsgId -> cancelMessageFile ct sharedMsgId msgMeta
XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct sharedMsgId mContent msg msgMeta ttl live
XMsgDel sharedMsgId _ -> messageDelete ct sharedMsgId msg msgMeta
-- TODO discontinue XFile
@@ -2398,6 +2524,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
updateChatLock "groupMessage" event
case event of
XMsgNew mc -> canSend $ newGroupContentMessage gInfo m mc msg msgMeta
+ XMsgFileDescr sharedMsgId fileDescr -> canSend $ groupMessageFileDescription gInfo m sharedMsgId fileDescr msgMeta
+ XMsgFileCancel sharedMsgId -> cancelGroupMessageFile gInfo m sharedMsgId msgMeta
XMsgUpdate sharedMsgId mContent ttl live -> canSend $ groupMessageUpdate gInfo m sharedMsgId mContent msg msgMeta ttl live
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m sharedMsgId memberId msg
-- TODO discontinue XFile
@@ -2459,7 +2587,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
CON -> do
ci <- withStore $ \db -> do
liftIO $ updateSndFileStatus db ft FSConnected
- updateDirectCIFileStatus db user fileId CIFSSndTransfer
+ updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1
toView $ CRSndFileStart user ci ft
sendFileChunk user ft
SENT msgId -> do
@@ -2535,7 +2663,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
startReceivingFile ft@RcvFileTransfer {fileId} = do
ci <- withStore $ \db -> do
liftIO $ updateRcvFileStatus db ft FSConnected
- liftIO $ updateCIFileStatus db user fileId CIFSRcvTransfer
+ liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
getChatItemByFileId db user fileId
toView $ CRRcvFileStart user ci
@@ -2637,7 +2765,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
where
s = " " <> name <> "=" <> B.unpack (strEncode $ toCMEventTag event)
- withCompletedCommand :: Connection -> ACommand 'Agent e -> (CommandData -> m ()) -> m ()
+ withCompletedCommand :: forall e. AEntityI e => Connection -> ACommand 'Agent e -> (CommandData -> m ()) -> m ()
withCompletedCommand Connection {connId} agentMsg action = do
let agentMsgTag = APCT (sAEntity @e) $ aCommandTag agentMsg
cmdData_ <- withStore' $ \db -> getCommandDataByCorrId db user corrId
@@ -2729,7 +2857,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
newContentMessage ct@Contact {localDisplayName = c, contactUsed, chatSettings} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
- let ExtMsgContent content fileInvitation_ _ _ = mcExtMsgContent mc
+ let ExtMsgContent content fInv_ _ _ = mcExtMsgContent mc
if isVoice content && not (featureAllowed SCFVoice forContact ct)
then do
void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False
@@ -2738,7 +2866,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc
timed_ = rcvContactCITimed ct itemTTL
live = fromMaybe False live_
- ciFile_ <- processFileInvitation fileInvitation_ content $ \db -> createRcvFileTransfer db userId ct
+ ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ live
when (enableNtfs chatSettings) $ do
showMsgToast (c <> "> ") content formattedText
@@ -2749,11 +2877,36 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
pure ci
+ messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> MsgMeta -> m ()
+ messageFileDescription ct _sharedMsgId _fileDescr msgMeta = do
+ checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
+ -- find the original chat item and file
+ -- re-create file item if it does not exist
+ -- check file description part number
+ -- append file description part to the record
+ -- if file description is complete send it to the agent to receive
+ pure ()
+
+ groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> MsgMeta -> m ()
+ groupMessageFileDescription _gInfo _m _sharedMsgId _fileDescr _msgMeta = do
+ pure ()
+
+ cancelMessageFile :: Contact -> SharedMsgId -> MsgMeta -> m ()
+ cancelMessageFile ct _sharedMsgId msgMeta = do
+ checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
+ -- find the original chat item and file
+ -- mark file as cancelled, remove description if excists
+ pure ()
+
+ cancelGroupMessageFile :: GroupInfo -> GroupMember -> SharedMsgId -> MsgMeta -> m ()
+ cancelGroupMessageFile _gInfo _m _sharedMsgId _msgMeta = do
+ pure ()
+
processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do
- chSize <- asks $ fileChunkSize . config
- inline <- receiveInlineMode fInv (Just mc) chSize
- ft@RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFT db fInv inline chSize
+ ChatConfig {fileChunkSize} <- asks config
+ inline <- receiveInlineMode fInv (Just mc) fileChunkSize
+ ft@RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFT db fInv inline fileChunkSize
(filePath, fileStatus) <- case inline of
Just IFMSent -> do
fPath <- getRcvFilePath fileId Nothing fileName
@@ -2886,9 +3039,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
- chSize <- asks $ fileChunkSize . config
- inline <- receiveInlineMode fInv Nothing chSize
- RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFileTransfer db userId ct fInv inline chSize
+ ChatConfig {fileChunkSize} <- asks config
+ inline <- receiveInlineMode fInv Nothing fileChunkSize
+ RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFileTransfer db userId ct fInv inline fileChunkSize
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
@@ -2898,9 +3051,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- TODO remove once XFile is discontinued
processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do
- chSize <- asks $ fileChunkSize . config
- inline <- receiveInlineMode fInv Nothing chSize
- RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvGroupFileTransfer db userId m fInv inline chSize
+ ChatConfig {fileChunkSize} <- asks config
+ inline <- receiveInlineMode fInv Nothing fileChunkSize
+ RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvGroupFileTransfer db userId m fInv inline fileChunkSize
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
groupMsgToView gInfo m ci msgMeta
@@ -2909,8 +3062,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
setActive $ ActiveG g
receiveInlineMode :: FileInvitation -> Maybe MsgContent -> Integer -> m (Maybe InlineFileMode)
- receiveInlineMode FileInvitation {fileSize, fileInline} mc_ chSize = case fileInline of
- Just mode -> do
+ receiveInlineMode FileInvitation {fileSize, fileInline, fileDescr} mc_ chSize = case (fileInline, fileDescr) of
+ (Just mode, Nothing) -> do
InlineFilesConfig {receiveChunks, receiveInstant} <- asks $ inlineFiles . config
pure $ if fileSize <= receiveChunks * chSize then inline' receiveInstant else Nothing
where
@@ -2941,7 +3094,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- receiving inline
_ -> do
event <- withStore $ \db -> do
- ci <- updateDirectCIFileStatus db user fileId CIFSSndTransfer
+ ci <- updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1
sft <- liftIO $ createSndDirectInlineFT db ct ft
pure $ CRSndFileStart user ci sft
toView event
@@ -2953,7 +3106,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
checkSndInlineFTComplete :: Connection -> AgentMsgId -> m ()
checkSndInlineFTComplete conn agentMsgId = do
- ft_ <- withStore' $ \db -> getSndInlineFTViaMsgDelivery db user conn agentMsgId
+ ft_ <- withStore' $ \db -> getSndFTViaMsgDelivery db user conn agentMsgId
forM_ ft_ $ \ft@SndFileTransfer {fileId} -> do
ci <- withStore $ \db -> do
liftIO $ updateSndFileStatus db ft FSComplete
@@ -3020,7 +3173,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
(_, Just conn) -> do
-- receiving inline
event <- withStore $ \db -> do
- ci <- updateDirectCIFileStatus db user fileId CIFSSndTransfer
+ ci <- updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1
sft <- liftIO $ createSndGroupInlineFT db m conn ft
pure $ CRSndFileStart user ci sft
toView event
diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs
index f07fba4ca9..110c1dbda3 100644
--- a/src/Simplex/Chat/Archive.hs
+++ b/src/Simplex/Chat/Archive.hs
@@ -65,7 +65,7 @@ importArchive cfg@ArchiveConfig {archivePath} =
backup f = whenM (doesFileExist f) $ copyFile f $ f <> ".bak"
withTempDir :: ChatMonad m => ArchiveConfig -> (String -> (FilePath -> m ()) -> m ())
-withTempDir cfg = case parentTempDirectory cfg of
+withTempDir cfg = case parentTempDirectory (cfg :: ArchiveConfig) of
Just tmpDir -> withTempDirectory tmpDir
_ -> withSystemTempDirectory
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index e9b499de00..cbf66ef4c0 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -105,7 +105,9 @@ data ChatConfig = ChatConfig
defaultServers :: DefaultAgentServers,
tbqSize :: Natural,
fileChunkSize :: Integer,
+ xftpDescrPartSize :: Int,
inlineFiles :: InlineFilesConfig,
+ xftpFileConfig :: Maybe XFTPFileConfig, -- Nothing - XFTP is disabled
subscriptionEvents :: Bool,
hostEvents :: Bool,
logLevel :: ChatLogLevel,
@@ -168,6 +170,7 @@ data ChatController = ChatController
cleanupManagerAsync :: TVar (Maybe (Async ())),
timedItemThreads :: TMap (ChatRef, ChatItemId) (TVar (Maybe (Weak ThreadId))),
showLiveItems :: TVar Bool,
+ userXFTPFileConfig :: TVar (Maybe XFTPFileConfig),
logFilePath :: Maybe FilePath
}
@@ -421,9 +424,12 @@ data ChatResponse
| CRContactRequestAlreadyAccepted {user :: User, contact :: Contact}
| CRLeftMemberUser {user :: User, groupInfo :: GroupInfo}
| CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo}
+ | CRRcvFileDescrReady {user :: User, chatItem :: AChatItem}
| 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, receivedChunks :: Int, totalChunks :: Int}
| CRRcvFileComplete {user :: User, chatItem :: AChatItem}
| CRRcvFileCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
@@ -432,6 +438,10 @@ data ChatResponse
| CRSndFileCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndFileRcvCancelled {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndGroupFileCancelled {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
+ | CRSndFileStartXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
+ | CRSndFileProgressXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sentChunks :: Int, totalChunks :: Int}
+ | CRSndFileCompleteXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
+ | CRSndFileCancelledXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
| CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile}
| CRContactAliasUpdated {user :: User, toContact :: Contact}
| CRConnectionAliasUpdated {user :: User, toConnection :: PendingContactConnection}
@@ -608,6 +618,19 @@ instance ToJSON ComposedMessage where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+data XFTPFileConfig = XFTPFileConfig
+ { minFileSize :: Integer,
+ tempDirectory :: Maybe FilePath
+ }
+ deriving (Show, Generic, FromJSON)
+
+defaultXFTPFileConfig :: XFTPFileConfig
+defaultXFTPFileConfig = XFTPFileConfig {minFileSize = 0, tempDirectory = Nothing}
+
+instance ToJSON XFTPFileConfig where
+ toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+ toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
data NtfMsgInfo = NtfMsgInfo {msgTs :: UTCTime, msgFlags :: MsgFlags}
deriving (Show, Generic)
@@ -668,6 +691,11 @@ data CoreVersionInfo = CoreVersionInfo
instance ToJSON CoreVersionInfo where toEncoding = J.genericToEncoding J.defaultOptions
+data SendFileMode
+ = SendFileSMP (Maybe InlineFileMode)
+ | SendFileXFTP XFTPFileConfig
+ deriving (Show, Generic)
+
data ChatError
= ChatError {errorType :: ChatErrorType}
| ChatErrorAgent {agentError :: AgentErrorType, connectionEntity_ :: Maybe ConnectionEntity}
@@ -682,6 +710,8 @@ instance ToJSON ChatError where
data ChatErrorType
= CENoActiveUser
| CENoConnectionUser {agentConnId :: AgentConnId}
+ | CENoSndFileUser {agentSndFileId :: AgentSndFileId}
+ | CENoRcvFileUser {agentRcvFileId :: AgentRcvFileId}
| CEActiveUserExists -- TODO delete
| CEUserExists {contactName :: ContactName}
| CEDifferentActiveUser {commandUserId :: UserId, activeUserId :: UserId}
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index d94cff5002..e6a45349e1 100644
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -13,6 +13,7 @@
module Simplex.Chat.Messages where
+import Control.Applicative ((<|>))
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as J
import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -418,12 +419,12 @@ instance MsgDirectionI d => ToJSON (CIFile d) where
data CIFileStatus (d :: MsgDirection) where
CIFSSndStored :: CIFileStatus 'MDSnd
- CIFSSndTransfer :: CIFileStatus 'MDSnd
+ CIFSSndTransfer :: {sndProgress :: Int, sndTotal :: Int} -> CIFileStatus 'MDSnd
CIFSSndCancelled :: CIFileStatus 'MDSnd
CIFSSndComplete :: CIFileStatus 'MDSnd
CIFSRcvInvitation :: CIFileStatus 'MDRcv
CIFSRcvAccepted :: CIFileStatus 'MDRcv
- CIFSRcvTransfer :: CIFileStatus 'MDRcv
+ CIFSRcvTransfer :: {rcvProgress :: Int, rcvTotal :: Int} -> CIFileStatus 'MDRcv
CIFSRcvComplete :: CIFileStatus 'MDRcv
CIFSRcvCancelled :: CIFileStatus 'MDRcv
@@ -434,18 +435,18 @@ deriving instance Show (CIFileStatus d)
ciFileEnded :: CIFileStatus d -> Bool
ciFileEnded = \case
CIFSSndStored -> False
- CIFSSndTransfer -> False
+ CIFSSndTransfer {} -> False
CIFSSndCancelled -> True
CIFSSndComplete -> True
CIFSRcvInvitation -> False
CIFSRcvAccepted -> False
- CIFSRcvTransfer -> False
+ CIFSRcvTransfer {} -> False
CIFSRcvCancelled -> True
CIFSRcvComplete -> True
-instance MsgDirectionI d => ToJSON (CIFileStatus d) where
- toJSON = strToJSON
- toEncoding = strToJEncoding
+instance ToJSON (CIFileStatus d) where
+ toJSON = J.toJSON . jsonCIFileStatus
+ toEncoding = J.toEncoding . jsonCIFileStatus
instance MsgDirectionI d => ToField (CIFileStatus d) where toField = toField . decodeLatin1 . strEncode
@@ -458,12 +459,12 @@ deriving instance Show ACIFileStatus
instance MsgDirectionI d => StrEncoding (CIFileStatus d) where
strEncode = \case
CIFSSndStored -> "snd_stored"
- CIFSSndTransfer -> "snd_transfer"
+ CIFSSndTransfer sent total -> strEncode (Str "snd_transfer", sent, total)
CIFSSndCancelled -> "snd_cancelled"
CIFSSndComplete -> "snd_complete"
CIFSRcvInvitation -> "rcv_invitation"
CIFSRcvAccepted -> "rcv_accepted"
- CIFSRcvTransfer -> "rcv_transfer"
+ CIFSRcvTransfer rcvd total -> strEncode (Str "rcv_transfer", rcvd, total)
CIFSRcvComplete -> "rcv_complete"
CIFSRcvCancelled -> "rcv_cancelled"
strP = (\(AFS _ st) -> checkDirection st) <$?> strP
@@ -473,15 +474,59 @@ instance StrEncoding ACIFileStatus where
strP =
A.takeTill (== ' ') >>= \case
"snd_stored" -> pure $ AFS SMDSnd CIFSSndStored
- "snd_transfer" -> pure $ AFS SMDSnd CIFSSndTransfer
+ "snd_transfer" -> AFS SMDSnd <$> progress CIFSSndTransfer
"snd_cancelled" -> pure $ AFS SMDSnd CIFSSndCancelled
"snd_complete" -> pure $ AFS SMDSnd CIFSSndComplete
"rcv_invitation" -> pure $ AFS SMDRcv CIFSRcvInvitation
"rcv_accepted" -> pure $ AFS SMDRcv CIFSRcvAccepted
- "rcv_transfer" -> pure $ AFS SMDRcv CIFSRcvTransfer
+ "rcv_transfer" -> AFS SMDRcv <$> progress CIFSRcvTransfer
"rcv_complete" -> pure $ AFS SMDRcv CIFSRcvComplete
"rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled
_ -> fail "bad file status"
+ where
+ progress :: (Int -> Int -> a) -> A.Parser a
+ progress f = f <$> num <*> num <|> pure (f 0 1)
+ num = A.space *> A.decimal
+
+data JSONCIFileStatus
+ = JCIFSSndStored
+ | JCIFSSndTransfer {sndProgress :: Int, sndTotal :: Int}
+ | JCIFSSndCancelled
+ | JCIFSSndComplete
+ | JCIFSRcvInvitation
+ | JCIFSRcvAccepted
+ | JCIFSRcvTransfer {rcvProgress :: Int, rcvTotal :: Int}
+ | JCIFSRcvComplete
+ | JCIFSRcvCancelled
+ deriving (Generic)
+
+instance ToJSON JSONCIFileStatus where
+ toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIFS"
+ toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIFS"
+
+jsonCIFileStatus :: CIFileStatus d -> JSONCIFileStatus
+jsonCIFileStatus = \case
+ CIFSSndStored -> JCIFSSndStored
+ CIFSSndTransfer sent total -> JCIFSSndTransfer sent total
+ CIFSSndCancelled -> JCIFSSndCancelled
+ CIFSSndComplete -> JCIFSSndComplete
+ CIFSRcvInvitation -> JCIFSRcvInvitation
+ CIFSRcvAccepted -> JCIFSRcvAccepted
+ CIFSRcvTransfer rcvd total -> JCIFSRcvTransfer rcvd total
+ CIFSRcvComplete -> JCIFSRcvComplete
+ CIFSRcvCancelled -> JCIFSRcvCancelled
+
+aciFileStatusJSON :: JSONCIFileStatus -> ACIFileStatus
+aciFileStatusJSON = \case
+ JCIFSSndStored -> AFS SMDSnd CIFSSndStored
+ JCIFSSndTransfer sent total -> AFS SMDSnd $ CIFSSndTransfer sent total
+ JCIFSSndCancelled -> AFS SMDSnd CIFSSndCancelled
+ JCIFSSndComplete -> AFS SMDSnd CIFSSndComplete
+ JCIFSRcvInvitation -> AFS SMDRcv CIFSRcvInvitation
+ JCIFSRcvAccepted -> AFS SMDRcv CIFSRcvAccepted
+ JCIFSRcvTransfer rcvd total -> AFS SMDRcv $ CIFSRcvTransfer rcvd total
+ JCIFSRcvComplete -> AFS SMDRcv CIFSRcvComplete
+ JCIFSRcvCancelled -> AFS SMDRcv CIFSRcvCancelled
-- to conveniently read file data from db
data CIFileInfo = CIFileInfo
diff --git a/src/Simplex/Chat/Migrations/M20230304_file_description.hs b/src/Simplex/Chat/Migrations/M20230304_file_description.hs
index 1846de09d3..40e7d0f0a1 100644
--- a/src/Simplex/Chat/Migrations/M20230304_file_description.hs
+++ b/src/Simplex/Chat/Migrations/M20230304_file_description.hs
@@ -11,19 +11,25 @@ import Database.SQLite.Simple.QQ (sql)
m20230304_file_description :: Query
m20230304_file_description =
[sql|
-CREATE TABLE recipient_file_descriptions (
+CREATE TABLE xftp_file_descriptions (
file_descr_id INTEGER PRIMARY KEY AUTOINCREMENT,
- file_descr_size INTEGER NOT NULL,
- file_descr_status TEXT NOT NULL,
- file_descr_text TEXT NOT NULL
+ user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+ file_descr_text TEXT NOT NULL,
+ file_descr_part_no INTEGER NOT NULL DEFAULT(0),
+ file_descr_complete INTEGER NOT NULL DEFAULT(0),
+ created_at TEXT NOT NULL DEFAULT(datetime('now')),
+ updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
-ALTER TABLE rcv_files ADD COLUMN file_descr_id INTEGER NULL
- REFERENCES recipient_file_descriptions(file_descr_id) ON DELETE RESTRICT;
+ALTER TABLE files ADD COLUMN agent_snd_file_id BLOB NULL;
+
+ALTER TABLE files ADD COLUMN private_snd_file_descr TEXT NULL;
ALTER TABLE snd_files ADD COLUMN file_descr_id INTEGER NULL
- REFERENCES recipient_file_descriptions(file_descr_id) ON DELETE RESTRICT;
+ REFERENCES xftp_file_descriptions ON DELETE SET NULL;
- -- this is a private file description allowing to delete the file from the server
-ALTER TABLE files ADD COLUMN snd_file_descr_text TEXT NULL;
+ALTER TABLE rcv_files ADD COLUMN file_descr_id INTEGER NULL
+ REFERENCES xftp_file_descriptions ON DELETE SET NULL;
+
+ALTER TABLE rcv_files ADD COLUMN agent_rcv_file_id BLOB NULL;
|]
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index 5562bce7df..5c27585083 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -193,7 +193,9 @@ CREATE TABLE files(
updated_at TEXT CHECK(updated_at NOT NULL),
cancelled INTEGER,
ci_file_status TEXT,
- file_inline TEXT
+ file_inline TEXT,
+ agent_snd_file_id BLOB NULL,
+ private_snd_file_descr TEXT NULL
);
CREATE TABLE snd_files(
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
@@ -204,6 +206,8 @@ CREATE TABLE snd_files(
updated_at TEXT CHECK(updated_at NOT NULL),
file_inline TEXT,
last_inline_msg_delivery_id INTEGER,
+ file_descr_id INTEGER NULL
+ REFERENCES xftp_file_descriptions ON DELETE SET NULL,
PRIMARY KEY(file_id, connection_id)
) WITHOUT ROWID;
CREATE TABLE rcv_files(
@@ -215,7 +219,10 @@ CREATE TABLE rcv_files(
created_at TEXT CHECK(created_at NOT NULL),
updated_at TEXT CHECK(updated_at NOT NULL),
rcv_file_inline TEXT,
- file_inline TEXT
+ file_inline TEXT,
+ file_descr_id INTEGER NULL
+ REFERENCES xftp_file_descriptions ON DELETE SET NULL,
+ agent_rcv_file_id BLOB NULL
);
CREATE TABLE snd_file_chunks(
file_id INTEGER NOT NULL,
@@ -551,3 +558,12 @@ CREATE INDEX idx_smp_servers_user_id ON smp_servers(user_id);
CREATE INDEX idx_chat_items_item_deleted_by_group_member_id ON chat_items(
item_deleted_by_group_member_id
);
+CREATE TABLE xftp_file_descriptions(
+ file_descr_id INTEGER PRIMARY KEY AUTOINCREMENT,
+ user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+ file_descr_text TEXT NOT NULL,
+ file_descr_part_no INTEGER NOT NULL DEFAULT(0),
+ file_descr_complete INTEGER NOT NULL DEFAULT(0),
+ created_at TEXT NOT NULL DEFAULT(datetime('now')),
+ updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index 604d33db41..d80afae622 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -33,6 +33,8 @@ module Simplex.Chat.Store
getUser,
getUserIdByName,
getUserByAConnId,
+ getUserByASndFileId,
+ getUserByARcvFileId,
getUserByContactId,
getUserByGroupId,
getUserByFileId,
@@ -152,7 +154,11 @@ module Simplex.Chat.Store
createSndGroupInlineFT,
updateSndDirectFTDelivery,
updateSndGroupFTDelivery,
- getSndInlineFTViaMsgDelivery,
+ getSndFTViaMsgDelivery,
+ createSndFileTransferXFTP,
+ createSndDirectFTDescrXFTP,
+ getAgentSndFileXFTP,
+ getAgentRcvFileXFTP,
updateFileCancelled,
updateCIFileStatus,
getSharedMsgIdByFileId,
@@ -345,11 +351,11 @@ import Simplex.Chat.Migrations.M20230118_recreate_smp_servers
import Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
import Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
import Simplex.Chat.Migrations.M20230303_group_link_role
--- import Simplex.Chat.Migrations.M20230304_file_description
+import Simplex.Chat.Migrations.M20230304_file_description
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Util (week)
-import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
+import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..), UserId)
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, firstRow, firstRow', maybeFirstRow, withTransaction)
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
import qualified Simplex.Messaging.Crypto as C
@@ -412,8 +418,8 @@ schemaMigrations =
("20230118_recreate_smp_servers", m20230118_recreate_smp_servers),
("20230129_drop_chat_items_group_idx", m20230129_drop_chat_items_group_idx),
("20230206_item_deleted_by_group_member_id", m20230206_item_deleted_by_group_member_id),
- ("20230303_group_link_role", m20230303_group_link_role)
- -- ("20230304_file_description", m20230304_file_description)
+ ("20230303_group_link_role", m20230303_group_link_role),
+ ("20230304_file_description", m20230304_file_description)
]
-- | The list of migrations in ascending order by date
@@ -541,6 +547,16 @@ getUserByAConnId db agentConnId =
maybeFirstRow toUser $
DB.query db (userQuery <> " JOIN connections c ON c.user_id = u.user_id WHERE c.agent_conn_id = ?") (Only agentConnId)
+getUserByASndFileId :: DB.Connection -> AgentSndFileId -> IO (Maybe User)
+getUserByASndFileId db aSndFileId =
+ maybeFirstRow toUser $
+ DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id WHERE f.agent_snd_file_id = ?") (Only aSndFileId)
+
+getUserByARcvFileId :: DB.Connection -> AgentRcvFileId -> IO (Maybe User)
+getUserByARcvFileId db aRcvFileId =
+ maybeFirstRow toUser $
+ DB.query db (userQuery <> " JOIN rcv_files r USING (file_id) JOIN files f ON f.user_id = u.user_id WHERE r.agent_rcv_file_id = ?") (Only aRcvFileId)
+
getUserByContactId :: DB.Connection -> ContactId -> ExceptT StoreError IO User
getUserByContactId db contactId =
ExceptT . firstRow toUser (SEUserNotFoundByContactId contactId) $
@@ -1394,7 +1410,10 @@ getLiveSndFileTransfers db User {userId} = do
SELECT DISTINCT f.file_id
FROM files f
JOIN snd_files s USING (file_id)
- WHERE f.user_id = ? AND s.file_status IN (?, ?, ?) AND s.file_inline IS NULL
+ WHERE f.user_id = ?
+ AND s.file_status IN (?, ?, ?)
+ AND s.file_descr_id IS NULL
+ AND s.file_inline IS NULL
AND s.created_at > ?
|]
(userId, FSNew, FSAccepted, FSConnected, cutoffTs)
@@ -1721,7 +1740,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
DB.query
db
[sql|
- SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_inline, cs.local_display_name, m.local_display_name
+ SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, cs.local_display_name, m.local_display_name
FROM snd_files s
JOIN files f USING (file_id)
LEFT JOIN contacts cs USING (contact_id)
@@ -1729,10 +1748,10 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
WHERE f.user_id = ? AND f.file_id = ? AND s.connection_id = ?
|]
(userId, fileId, connId)
- sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
- sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, contactName_, memberName_) =
+ sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
+ sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, contactName_, memberName_) =
case contactName_ <|> memberName_ of
- Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, recipientDisplayName, connId, agentConnId}
+ Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId}
Nothing -> Left $ SESndFileInvalid fileId
getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
getUserContact_ userContactLinkId = ExceptT $ do
@@ -2619,7 +2638,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, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
+ pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> IO ()
createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) = do
@@ -2639,7 +2658,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, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
(userId, groupId, fileName, filePath, fileSize, chunkSize, fileInline, CIFSSndStored, currentTs, currentTs)
fileId <- insertedRowId db
- pure FileTransferMeta {fileId, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
+ pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> IO ()
createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} = do
@@ -2660,7 +2679,7 @@ createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Connectio
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 SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileInline = fileInline'}
+ pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileDescrId = Nothing, fileInline = fileInline'}
createSndGroupInlineFT :: DB.Connection -> GroupMember -> Connection -> FileTransferMeta -> IO SndFileTransfer
createSndGroupInlineFT db GroupMember {groupMemberId, localDisplayName = n} Connection {connId, agentConnId} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = do
@@ -2671,7 +2690,7 @@ createSndGroupInlineFT db GroupMember {groupMemberId, localDisplayName = n} Conn
db
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(fileId, fileStatus, fileInline', connId, groupMemberId, currentTs, currentTs)
- pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileInline = fileInline'}
+ pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileDescrId = Nothing, fileInline = fileInline'}
updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> IO ()
updateSndDirectFTDelivery db Contact {activeConn = Connection {connId}} FileTransferMeta {fileId} msgDeliveryId =
@@ -2687,27 +2706,60 @@ updateSndGroupFTDelivery db GroupMember {groupMemberId} Connection {connId} File
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE group_member_id = ? AND connection_id = ? AND file_id = ? AND file_inline IS NOT NULL"
(msgDeliveryId, groupMemberId, connId, fileId)
-getSndInlineFTViaMsgDelivery :: DB.Connection -> User -> Connection -> AgentMsgId -> IO (Maybe SndFileTransfer)
-getSndInlineFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMsgId = do
+getSndFTViaMsgDelivery :: DB.Connection -> User -> Connection -> AgentMsgId -> IO (Maybe SndFileTransfer)
+getSndFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMsgId = do
(sndFileTransfer_ <=< listToMaybe)
<$> DB.query
db
[sql|
- SELECT s.file_id, s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_inline, c.local_display_name, m.local_display_name
+ SELECT s.file_id, s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, c.local_display_name, m.local_display_name
FROM msg_deliveries d
JOIN snd_files s ON s.connection_id = d.connection_id AND s.last_inline_msg_delivery_id = d.msg_delivery_id
JOIN files f ON f.file_id = s.file_id
LEFT JOIN contacts c USING (contact_id)
LEFT JOIN group_members m USING (group_member_id)
- WHERE d.connection_id = ? AND d.agent_msg_id = ? AND f.user_id = ? AND s.file_inline IS NOT NULL
+ WHERE d.connection_id = ? AND d.agent_msg_id = ? AND f.user_id = ?
+ AND (s.file_descr_id IS NOT NULL OR s.file_inline IS NOT NULL)
|]
(connId, agentMsgId, userId)
where
- sndFileTransfer_ :: (Int64, FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Maybe SndFileTransfer
- sndFileTransfer_ (fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, contactName_, memberName_) =
- (\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, recipientDisplayName = n, connId, agentConnId})
+ sndFileTransfer_ :: (Int64, FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Maybe SndFileTransfer
+ sndFileTransfer_ (fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, contactName_, memberName_) =
+ (\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName = n, connId, agentConnId})
<$> (contactName_ <|> memberName_)
+createSndFileTransferXFTP :: DB.Connection -> User -> ContactOrGroup -> FilePath -> FileInvitation -> AgentSndFileId -> IO FileTransferMeta
+createSndFileTransferXFTP db User {userId} contactOrGroup filePath FileInvitation {fileName, fileSize} agentSndFileId = do
+ currentTs <- getCurrentTime
+ let chunkSize = 0
+ xftpSndFile = Just XFTPSndFile {agentSndFileId, privateSndFileDescr = Nothing}
+ DB.execute
+ db
+ "INSERT INTO files (contact_id, group_id, user_id, file_name, file_path, file_size, chunk_size, agent_snd_file_id, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
+ (contactAndGroupIds contactOrGroup :. (userId, fileName, filePath, fileSize, chunkSize, agentSndFileId, CIFSSndStored, currentTs, currentTs))
+ fileId <- insertedRowId db
+ pure FileTransferMeta {fileId, xftpSndFile, fileName, filePath, fileSize, fileInline = Nothing, chunkSize, cancelled = False}
+
+createSndDirectFTDescrXFTP :: DB.Connection -> User -> Contact -> FileTransferMeta -> Text -> IO ()
+createSndDirectFTDescrXFTP db User {userId} Contact {activeConn = Connection {connId}} FileTransferMeta {fileId} rfdText = do
+ let fileStatus = FSConnected
+ DB.execute db "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_complete) VALUES (?,?,?)" (userId, rfdText, True)
+ fileDescrId <- insertedRowId db
+ DB.execute
+ db
+ "INSERT INTO snd_files (file_id, file_status, file_descr_id, connection_id) VALUES (?,?,?,?)"
+ (fileId, fileStatus, fileDescrId, connId)
+
+getAgentSndFileXFTP :: DB.Connection -> User -> AgentSndFileId -> ExceptT StoreError IO FileTransferMeta
+getAgentSndFileXFTP db user aSndFileId = do
+ fileId <-
+ ExceptT . firstRow fromOnly (SESndFileNotFoundXFTP aSndFileId) $
+ DB.query db "SELECT file_id FROM files WHERE agent_snd_file_id = ?" (Only aSndFileId)
+ getFileTransferMeta db user fileId
+
+getAgentRcvFileXFTP :: DB.Connection -> User -> AgentRcvFileId -> ExceptT StoreError IO FileTransferMeta
+getAgentRcvFileXFTP _db _user _aFileId = undefined
+
updateFileCancelled :: MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> IO ()
updateFileCancelled db User {userId} fileId ciFileStatus = do
currentTs <- getCurrentTime
@@ -2845,32 +2897,46 @@ deleteSndFileChunks db SndFileTransfer {fileId, connId} =
DB.execute db "DELETE FROM snd_file_chunks WHERE file_id = ? AND connection_id = ?" (fileId, connId)
createRcvFileTransfer :: DB.Connection -> UserId -> Contact -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer
-createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
+createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, contactId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
fileId <- insertedRowId db
+ rfd <- mapM (createRcvFD_ db) fileDescr
+ let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd
DB.execute
db
- "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
- (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, currentTs, currentTs)
- pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
+ "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
+ (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, rfdId, currentTs, currentTs)
+ pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = rfd, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer
-createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
+createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
fileId <- insertedRowId db
+ rfd <- mapM (createRcvFD_ db) fileDescr
+ let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd
DB.execute
db
- "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
- (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, currentTs, currentTs)
- pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
+ "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
+ (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, rfdId, currentTs, currentTs)
+ pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = rfd, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
+
+createRcvFD_ :: DB.Connection -> FileDescr -> IO RcvFileDescr
+createRcvFD_ db FileDescr {fileDescrText, fileDescrComplete} = do
+ -- TODO validate that fileDescrPartNo = 0, probably when message is received
+ DB.execute
+ db
+ "INSERT INTO file_descriptions (file_descr_text, file_descr_complete) VALUES (?,?)"
+ (fileDescrText, fileDescrComplete)
+ fileDescrId <- insertedRowId db
+ pure RcvFileDescr {fileDescrId, fileDescrPartNo = 0, fileDescrText, fileDescrComplete}
getRcvFileTransferById :: DB.Connection -> FileTransferId -> ExceptT StoreError IO (User, RcvFileTransfer)
getRcvFileTransferById db fileId = do
@@ -3062,7 +3128,7 @@ getSndFileTransfers_ db userId fileId =
<$> DB.query
db
[sql|
- SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_inline, s.connection_id, c.agent_conn_id,
+ SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.connection_id, c.agent_conn_id,
cs.local_display_name, m.local_display_name
FROM snd_files s
JOIN files f USING (file_id)
@@ -3073,10 +3139,10 @@ getSndFileTransfers_ db userId fileId =
|]
(userId, fileId)
where
- sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Int64, AgentConnId, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
- sndFileTransfer (fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, connId, agentConnId, contactName_, memberName_) =
+ sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath) :. (Maybe Int64, Maybe InlineFileMode, Int64, AgentConnId, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
+ sndFileTransfer ((fileStatus, fileName, fileSize, chunkSize, filePath) :. (fileDescrId, fileInline, connId, agentConnId, contactName_, memberName_)) =
case contactName_ <|> memberName_ of
- Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, recipientDisplayName, connId, agentConnId}
+ Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId}
Nothing -> Left $ SESndFileInvalid fileId
getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta
@@ -3085,15 +3151,16 @@ getFileTransferMeta db User {userId} fileId =
DB.query
db
[sql|
- SELECT f.file_name, f.file_size, f.chunk_size, f.file_path, f.file_inline, f.cancelled
- FROM files f
- WHERE f.user_id = ? AND f.file_id = ?
+ SELECT file_name, file_size, chunk_size, file_path, file_inline, agent_snd_file_id, private_snd_file_descr, cancelled
+ FROM files
+ WHERE user_id = ? AND file_id = ?
|]
(userId, fileId)
where
- fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe Bool) -> FileTransferMeta
- fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileInline, cancelled_) =
- FileTransferMeta {fileId, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
+ fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe AgentSndFileId, Maybe Text, Maybe Bool) -> FileTransferMeta
+ fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileInline, aSndFileId_, privateSndFileDescr, cancelled_) =
+ let xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr}) <$> aSndFileId_
+ in FileTransferMeta {fileId, xftpSndFile, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo]
getContactFileInfo db User {userId} Contact {contactId} =
@@ -4979,6 +5046,7 @@ data StoreError
| SERcvFileInvalid {fileId :: FileTransferId}
| SESharedMsgIdNotFoundByFileId {fileId :: FileTransferId}
| SEFileIdNotFoundBySharedMsgId {sharedMsgId :: SharedMsgId}
+ | SESndFileNotFoundXFTP {agentFileId :: AgentSndFileId}
| SEConnectionNotFound {agentConnId :: AgentConnId}
| SEConnectionNotFoundById {connId :: Int64}
| SEPendingConnectionNotFound {connId :: Int64}
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 17b3c92f92..937ea81179 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -49,7 +49,7 @@ import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Generics (Generic)
import GHC.Records.Compat
import Simplex.FileTransfer.Description (FileDigest)
-import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..))
+import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..), UserId)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON)
import Simplex.Messaging.Protocol (AProtoServerWithAuth, ProtoServerWithAuth, ProtocolTypeI)
@@ -126,8 +126,6 @@ instance ToJSON UserInfo where
toJSON = J.genericToJSON J.defaultOptions
toEncoding = J.genericToEncoding J.defaultOptions
-type UserId = Int64
-
type ContactId = Int64
type ProfileId = Int64
@@ -289,6 +287,13 @@ instance ToJSON GroupInfo where toEncoding = J.genericToEncoding J.defaultOption
groupName' :: GroupInfo -> GroupName
groupName' GroupInfo {localDisplayName = g} = g
+data ContactOrGroup = CGContact Contact | CGGroup GroupInfo
+
+contactAndGroupIds :: ContactOrGroup -> (Maybe ContactId, Maybe GroupId)
+contactAndGroupIds = \case
+ CGContact Contact {contactId} -> (Just contactId, Nothing)
+ CGGroup GroupInfo {groupId} -> (Nothing, Just groupId)
+
-- TODO when more settings are added we should create another type to allow partial setting updates (with all Maybe properties)
data ChatSettings = ChatSettings
{ enableNtfs :: Bool
@@ -1457,6 +1462,7 @@ data SndFileTransfer = SndFileTransfer
connId :: Int64,
agentConnId :: AgentConnId,
fileStatus :: FileStatus,
+ fileDescrId :: Maybe Int64,
fileInline :: Maybe InlineFileMode
}
deriving (Eq, Show, Generic)
@@ -1485,19 +1491,27 @@ instance ToJSON FileInvitation where
instance FromJSON FileInvitation where
parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
-data FileDescr
- = FDText {fileDescrText :: Text}
- | FDInline {fileDescrSize :: Integer, fileDescrInline :: InlineFileMode}
- | FDPending
+data FileDescr = FileDescr {fileDescrText :: Text, fileDescrPartNo :: Int, fileDescrComplete :: Bool}
deriving (Eq, Show, Generic)
instance ToJSON FileDescr where
- toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "FD"
- toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "FD"
+ toEncoding = J.genericToEncoding J.defaultOptions
+ toJSON = J.genericToJSON J.defaultOptions
instance FromJSON FileDescr where
parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "FD"
+xftpFileInvitation :: FilePath -> Integer -> FileInvitation
+xftpFileInvitation fileName fileSize =
+ FileInvitation
+ { fileName,
+ fileSize,
+ fileDigest = Nothing,
+ fileConnReq = Nothing,
+ fileInline = Nothing,
+ fileDescr = Just FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
+ }
+
data InlineFileMode
= IFMOffer -- file will be sent inline once accepted
| IFMSent -- file is sent inline without acceptance
@@ -1540,9 +1554,9 @@ instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.default
data RcvFileDescr = RcvFileDescr
{ fileDescrId :: Int64,
- fileDescrStatus :: RcvFileStatus,
fileDescrText :: Text,
- chunkSize :: Integer
+ fileDescrPartNo :: Int,
+ fileDescrComplete :: Bool
}
deriving (Eq, Show, Generic)
@@ -1594,6 +1608,38 @@ instance FromField AgentConnId where fromField f = AgentConnId <$> fromField f
instance ToField AgentConnId where toField (AgentConnId m) = toField m
+newtype AgentSndFileId = AgentSndFileId ConnId
+ deriving (Eq, Show)
+
+instance StrEncoding AgentSndFileId where
+ strEncode (AgentSndFileId connId) = strEncode connId
+ strDecode s = AgentSndFileId <$> strDecode s
+ strP = AgentSndFileId <$> strP
+
+instance ToJSON AgentSndFileId where
+ toJSON = strToJSON
+ toEncoding = strToJEncoding
+
+instance FromField AgentSndFileId where fromField f = AgentSndFileId <$> fromField f
+
+instance ToField AgentSndFileId where toField (AgentSndFileId m) = toField m
+
+newtype AgentRcvFileId = AgentRcvFileId ConnId
+ deriving (Eq, Show)
+
+instance StrEncoding AgentRcvFileId where
+ strEncode (AgentRcvFileId connId) = strEncode connId
+ strDecode s = AgentRcvFileId <$> strDecode s
+ strP = AgentRcvFileId <$> strP
+
+instance ToJSON AgentRcvFileId where
+ toJSON = strToJSON
+ toEncoding = strToJEncoding
+
+instance FromField AgentRcvFileId where fromField f = AgentRcvFileId <$> fromField f
+
+instance ToField AgentRcvFileId where toField (AgentRcvFileId m) = toField m
+
newtype AgentInvId = AgentInvId InvitationId
deriving (Eq, Show)
@@ -1624,6 +1670,7 @@ instance ToJSON FileTransfer where
data FileTransferMeta = FileTransferMeta
{ fileId :: FileTransferId,
+ xftpSndFile :: Maybe XFTPSndFile,
fileName :: String,
filePath :: String,
fileSize :: Integer,
@@ -1635,10 +1682,19 @@ data FileTransferMeta = FileTransferMeta
instance ToJSON FileTransferMeta where toEncoding = J.genericToEncoding J.defaultOptions
+data XFTPSndFile = XFTPSndFile
+ { agentSndFileId :: AgentSndFileId,
+ privateSndFileDescr :: Maybe Text
+ }
+ deriving (Eq, Show, Generic)
+
+instance ToJSON XFTPSndFile where toEncoding = J.genericToEncoding J.defaultOptions
+
fileTransferCancelled :: FileTransfer -> Bool
fileTransferCancelled (FTSnd FileTransferMeta {cancelled} _) = cancelled
fileTransferCancelled (FTRcv RcvFileTransfer {cancelled}) = cancelled
+-- For XFTP file transfers FSConnected means "uploaded to XFTP relays"
data FileStatus = FSNew | FSAccepted | FSConnected | FSComplete | FSCancelled deriving (Eq, Ord, Show)
instance FromField FileStatus where fromField = fromTextField_ textDecode
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 0535e5a464..7f73be9dd4 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -130,6 +130,9 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
CRUserDeletedMember u g m -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"]
+ CRRcvFileDescrReady _ _ -> []
+ CRRcvFileDescrNotReady _ _ -> []
+ CRRcvFileProgressXFTP _ _ _ _ -> []
CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
CRSndGroupFileCancelled u _ ftm fts -> ttyUser u $ viewSndGroupFileCancelled ftm fts
@@ -147,6 +150,10 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft
+ CRSndFileStartXFTP _ _ _ -> []
+ CRSndFileProgressXFTP _ _ _ _ _ -> []
+ CRSndFileCompleteXFTP _ _ _ -> []
+ CRSndFileCancelledXFTP _ _ _ -> []
CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
CRContactConnecting u _ -> ttyUser u []
@@ -1007,7 +1014,7 @@ viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts = case filePa
where
ttySentFile fPath = ["/f " <> to <> ttyFilePath fPath] <> cancelSending
cancelSending = case fileStatus of
- CIFSSndTransfer -> []
+ CIFSSndTransfer _ _ -> []
_ -> ["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"]
sentWithTime_ :: CurrentTime -> [StyledString] -> CIMeta c d -> [StyledString]
@@ -1207,6 +1214,8 @@ viewChatError logLevel = \case
ChatError err -> case err of
CENoActiveUser -> ["error: active user is required"]
CENoConnectionUser agentConnId -> ["error: message user not found, conn id: " <> sShow agentConnId | logLevel <= CLLError]
+ CENoSndFileUser aFileId -> ["error: snd file user not found, file id: " <> sShow aFileId | logLevel <= CLLError]
+ CENoRcvFileUser aFileId -> ["error: rcv file user not found, file id: " <> sShow aFileId | logLevel <= CLLError]
CEActiveUserExists -> ["error: active user already exists"]
CEUserExists name -> ["user with the name " <> ttyContact name <> " already exists"]
CEDifferentActiveUser commandUserId activeUserId -> ["error: different active user, command user id: " <> sShow commandUserId <> ", active user id: " <> sShow activeUserId]
diff --git a/stack.yaml b/stack.yaml
index 208d3ca942..f3e19e6c53 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -49,7 +49,9 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
- commit: 8fde8e1344699cdcdc67709595c9285cd06bbef3
+ commit: bd4fecf4a84071079cffccfc0f35a916eac0e086
+ - github: kazu-yamamoto/http2
+ commit: 78e18f52295a7f89e828539a03fbcb24931461a3
# - ../direct-sqlcipher
- github: simplex-chat/direct-sqlcipher
commit: 34309410eb2069b029b8fc1872deb1e0db123294