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 01/17] 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 c5c00106e..b9ddbd34d 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 000000000..af4595207
--- /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 c94510158..bb3d71813 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 e2f31b94a..f50423069 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 f07fba4ca..110c1dbda 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 e9b499de0..cbf66ef4c 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 d94cff500..e6a45349e 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 1846de09d..40e7d0f0a 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 5562bce7d..5c2758508 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 604d33db4..d80afae62 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 17b3c92f9..937ea8117 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 0535e5a46..7f73be9dd 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 208d3ca94..f3e19e6c5 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
From bfc178faf370335fe3b532d77b46c1da0f1bc754 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 14 Mar 2023 11:42:44 +0400
Subject: [PATCH 02/17] core: process rcv file description (#1997)
* core: process rcv file description
* refactor, groups
* view
* refactor
* update simplexmq
* refactor
---------
Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
---
cabal.project | 2 +-
scripts/nix/sha256map.nix | 2 +-
src/Simplex/Chat.hs | 62 ++++++++++------
src/Simplex/Chat/Controller.hs | 9 ++-
src/Simplex/Chat/Store.hs | 131 ++++++++++++++++++++++++---------
src/Simplex/Chat/View.hs | 1 +
stack.yaml | 2 +-
7 files changed, 147 insertions(+), 62 deletions(-)
diff --git a/cabal.project b/cabal.project
index b9ddbd34d..5da331e77 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: bd4fecf4a84071079cffccfc0f35a916eac0e086
+ tag: ddc2da8fe44f95928213522ec43a40154fd3c050
source-repository-package
type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index bb3d71813..6e1fc47a8 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
{
- "https://github.com/simplex-chat/simplexmq.git"."bd4fecf4a84071079cffccfc0f35a916eac0e086" = "11sp91znlnfflilw0gdd64f4z6y9ni88iv7xjrdkyj6yhjqfa4wr";
+ "https://github.com/simplex-chat/simplexmq.git"."ddc2da8fe44f95928213522ec43a40154fd3c050" = "1c6bdl6vhy1h459hwsxdiw27xkckcw53c5g1g8fy2bp8gn9q5k4s";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/kazu-yamamoto/http2.git"."78e18f52295a7f89e828539a03fbcb24931461a3" = "05q165anvv0qrcxqbvq1dlvw0l8gmsa9kl6sazk1mfhz2g0yimdk";
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index f50423069..4c94150fb 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -41,6 +41,7 @@ import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
import Data.Text (Text)
import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
import Data.Time (NominalDiffTime, addUTCTime)
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds)
import Data.Time.Clock.System (SystemTime, systemToUTCTime)
@@ -58,6 +59,8 @@ import Simplex.Chat.Store
import Simplex.Chat.Types
import Simplex.Chat.Util (diffInMicros, diffInSeconds)
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
+import Simplex.FileTransfer.Description (ValidFileDescription)
+import Simplex.FileTransfer.Protocol (FileParty (..))
import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Client (AgentStatsKey (..))
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), AgentDatabase (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
@@ -168,7 +171,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
timedItemThreads <- atomically TM.empty
showLiveItems <- newTVarIO False
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}
+ tempDirectory <- newTVarIO Nothing
+ 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, tempDirectory, logFilePath = logFile}
where
configServers :: DefaultAgentServers
configServers =
@@ -402,7 +406,7 @@ processChatCommand = \case
(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
+ SendFileXFTP -> xftpSndFileTransfer user file fileSize 1 $ CGContact ct
where
smpSndFileTransfer :: FilePath -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer file fileSize fileInline = do
@@ -459,7 +463,7 @@ processChatCommand = \case
(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
+ SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ CGGroup gInfo
where
smpSndFileTransfer :: FilePath -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer file fileSize fileInline = do
@@ -524,11 +528,12 @@ 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
+ xftpSndFileTransfer :: User -> FilePath -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
+ xftpSndFileTransfer user file fileSize n contactOrGroup = do
let fileName = takeFileName file
fInv = xftpFileInvitation fileName fileSize
- aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) file n tempDirectory
+ tmp <- readTVarIO =<< asks tempDirectory
+ aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) file n tmp
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)
@@ -1478,7 +1483,7 @@ processChatCommand = \case
fileMode = case xftpCfg of
Just cfg
| fileInline == Just IFMSent || fileSize < minFileSize cfg -> SendFileSMP fileInline
- | otherwise -> SendFileXFTP cfg
+ | otherwise -> SendFileXFTP
_ -> SendFileSMP fileInline
pure (fileSize, fileMode)
inlineFileMode mc InlineFilesConfig {offerChunks, sendChunks, totalSendChunks} chunks n
@@ -2878,35 +2883,46 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
pure ci
messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> MsgMeta -> m ()
- messageFileDescription ct _sharedMsgId _fileDescr msgMeta = do
+ messageFileDescription ct@Contact {contactId} 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 ()
+ fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId
+ processFDMessage fileId fileDescr
groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> MsgMeta -> m ()
- groupMessageFileDescription _gInfo _m _sharedMsgId _fileDescr _msgMeta = do
- pure ()
+ groupMessageFileDescription GroupInfo {groupId} _m sharedMsgId fileDescr _msgMeta = do
+ fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
+ processFDMessage fileId fileDescr
+
+ processFDMessage :: FileTransferId -> FileDescr -> m ()
+ processFDMessage fileId fileDescr = do
+ (rfd, _aci) <- withStore $ \db -> do
+ rfd <- appendRcvFD db userId fileId fileDescr
+ aci <- getChatItemByFileId db user fileId
+ -- ? re-create file item if it does not exist
+ pure (rfd, aci)
+ let RcvFileDescr {fileDescrText, fileDescrComplete} = rfd
+ when fileDescrComplete $ do
+ rd <- parseRcvFileDescription fileDescrText
+ tmp <- readTVarIO =<< asks tempDirectory
+ aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd tmp
+ withStore' $ \db -> updateRcvFileAgentId db fileId aFileId
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
+ -- mark file as cancelled, remove description if exists
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 :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do
ChatConfig {fileChunkSize} <- asks config
inline <- receiveInlineMode fInv (Just mc) fileChunkSize
- ft@RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFT db fInv inline fileChunkSize
+ ft@RcvFileTransfer {fileId} <- withStore $ \db -> createRcvFT db fInv inline fileChunkSize
(filePath, fileStatus) <- case inline of
Just IFMSent -> do
fPath <- getRcvFilePath fileId Nothing fileName
@@ -3041,7 +3057,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
ChatConfig {fileChunkSize} <- asks config
inline <- receiveInlineMode fInv Nothing fileChunkSize
- RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFileTransfer db userId ct fInv inline 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)
@@ -3053,7 +3069,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do
ChatConfig {fileChunkSize} <- asks config
inline <- receiveInlineMode fInv Nothing fileChunkSize
- RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvGroupFileTransfer db userId m fInv inline 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
@@ -3565,6 +3581,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupMsgToView g' m ci msgMeta
createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'
+parseRcvFileDescription :: ChatMonad m => Text -> m (ValidFileDescription 'FRecipient)
+parseRcvFileDescription =
+ liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8)
+
sendDirectFileInline :: ChatMonad m => Contact -> FileTransferMeta -> SharedMsgId -> m ()
sendDirectFileInline ct ft sharedMsgId = do
msgDeliveryId <- sendFileInline_ ft sharedMsgId $ sendDirectContactMessage ct
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index cbf66ef4c..bf381218f 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -171,6 +171,7 @@ data ChatController = ChatController
timedItemThreads :: TMap (ChatRef, ChatItemId) (TVar (Maybe (Weak ThreadId))),
showLiveItems :: TVar Bool,
userXFTPFileConfig :: TVar (Maybe XFTPFileConfig),
+ tempDirectory :: TVar (Maybe FilePath),
logFilePath :: Maybe FilePath
}
@@ -619,13 +620,12 @@ instance ToJSON ComposedMessage where
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
data XFTPFileConfig = XFTPFileConfig
- { minFileSize :: Integer,
- tempDirectory :: Maybe FilePath
+ { minFileSize :: Integer
}
deriving (Show, Generic, FromJSON)
defaultXFTPFileConfig :: XFTPFileConfig
-defaultXFTPFileConfig = XFTPFileConfig {minFileSize = 0, tempDirectory = Nothing}
+defaultXFTPFileConfig = XFTPFileConfig {minFileSize = 0}
instance ToJSON XFTPFileConfig where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
@@ -693,7 +693,7 @@ instance ToJSON CoreVersionInfo where toEncoding = J.genericToEncoding J.default
data SendFileMode
= SendFileSMP (Maybe InlineFileMode)
- | SendFileXFTP XFTPFileConfig
+ | SendFileXFTP
deriving (Show, Generic)
data ChatError
@@ -764,6 +764,7 @@ data ChatErrorType
| CEAgentNoSubResult {agentConnId :: AgentConnId}
| CECommandError {message :: String}
| CEAgentCommandError {message :: String}
+ | CEInvalidFileDescription {message :: String}
| CEInternalError {message :: String}
deriving (Show, Exception, Generic)
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index d80afae62..1e60ead21 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -173,6 +173,8 @@ module Simplex.Chat.Store
deleteSndFileChunks,
createRcvFileTransfer,
createRcvGroupFileTransfer,
+ appendRcvFD,
+ updateRcvFileAgentId,
getRcvFileTransferById,
getRcvFileTransfer,
acceptRcvFileTransfer,
@@ -355,7 +357,7 @@ 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 (..), UserId)
+import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..), RcvFileId, 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
@@ -2896,47 +2898,107 @@ deleteSndFileChunks :: DB.Connection -> SndFileTransfer -> IO ()
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.Connection -> UserId -> Contact -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
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
+ currentTs <- liftIO getCurrentTime
+ fileId <- liftIO $ do
+ 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)
+ insertedRowId db
+ rfd <- mapM (createRcvFD_ db userId) 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, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
- (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, rfdId, currentTs, currentTs)
+ liftIO $
+ DB.execute
+ db
+ "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.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
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
+ currentTs <- liftIO getCurrentTime
+ fileId <- liftIO $ do
+ 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)
+ insertedRowId db
+ rfd <- mapM (createRcvFD_ db userId) 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, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
- (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, rfdId, currentTs, currentTs)
+ liftIO $
+ DB.execute
+ db
+ "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}
+createRcvFD_ :: DB.Connection -> UserId -> FileDescr -> ExceptT StoreError IO RcvFileDescr
+createRcvFD_ db userId FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
+ when (fileDescrPartNo /= 0) $ throwError SERcvFileInvalidDescrPart
+ fileDescrId <- liftIO $ do
+ DB.execute
+ db
+ "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete) VALUES (?,?,?,?)"
+ (userId, fileDescrText, fileDescrPartNo, fileDescrComplete)
+ insertedRowId db
+ pure RcvFileDescr {fileDescrId, fileDescrPartNo, fileDescrText, fileDescrComplete}
+
+appendRcvFD :: DB.Connection -> UserId -> FileTransferId -> FileDescr -> ExceptT StoreError IO RcvFileDescr
+appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
+ currentTs <- liftIO getCurrentTime
+ liftIO (getRcvFileDescrByFileId_ db fileId) >>= \case
+ Nothing -> do
+ rfd@RcvFileDescr {fileDescrId} <- createRcvFD_ db userId fd
+ liftIO $
+ DB.execute
+ db
+ "UPDATE rcv_files SET file_descr_id = ?, updated_at = ? WHERE file_id = ?"
+ (fileDescrId, currentTs, fileId)
+ pure rfd
+ Just
+ RcvFileDescr
+ { fileDescrId,
+ fileDescrText = rfdText,
+ fileDescrPartNo = rfdPNo,
+ fileDescrComplete = rfdComplete
+ } -> do
+ when (fileDescrPartNo /= rfdPNo + 1 || rfdComplete) $ throwError SERcvFileInvalidDescrPart
+ let fileDescrText' = rfdText <> fileDescrText
+ liftIO $
+ DB.execute
+ db
+ [sql|
+ UPDATE xftp_file_descriptions
+ SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?
+ WHERE file_descr_id = ?
+ |]
+ (fileDescrText', fileDescrPartNo, fileDescrComplete, fileDescrId)
+ pure RcvFileDescr {fileDescrId, fileDescrText = fileDescrText', fileDescrPartNo, fileDescrComplete}
+
+getRcvFileDescrByFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
+getRcvFileDescrByFileId_ db fileId =
+ maybeFirstRow toRcvFileDescr $
+ DB.query
+ db
+ [sql|
+ SELECT d.file_descr_id, d.file_descr_text, d.file_descr_part_no, d.file_descr_complete
+ FROM xftp_file_descriptions d
+ JOIN rcv_files f ON f.file_descr_id = d.file_descr_id
+ WHERE f.file_id = ?
+ LIMIT 1
+ |]
+ (Only fileId)
+ where
+ toRcvFileDescr :: (Int64, Text, Int, Bool) -> RcvFileDescr
+ toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
+ RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
+
+updateRcvFileAgentId :: DB.Connection -> FileTransferId -> RcvFileId -> IO ()
+updateRcvFileAgentId db fileId aFileId = do
+ currentTs <- getCurrentTime
+ DB.execute db "UPDATE rcv_files SET agent_rcv_file_id = ?, updated_at = ? WHERE file_id = ?" (aFileId, currentTs, fileId)
getRcvFileTransferById :: DB.Connection -> FileTransferId -> ExceptT StoreError IO (User, RcvFileTransfer)
getRcvFileTransferById db fileId = do
@@ -5044,6 +5106,7 @@ data StoreError
| SERcvFileNotFound {fileId :: FileTransferId}
| SEFileNotFound {fileId :: FileTransferId}
| SERcvFileInvalid {fileId :: FileTransferId}
+ | SERcvFileInvalidDescrPart
| SESharedMsgIdNotFoundByFileId {fileId :: FileTransferId}
| SEFileIdNotFoundBySharedMsgId {sharedMsgId :: SharedMsgId}
| SESndFileNotFoundXFTP {agentFileId :: AgentSndFileId}
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 7f73be9dd..8cfbe66cd 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -1271,6 +1271,7 @@ viewChatError logLevel = \case
CEAgentNoSubResult connId -> ["no subscription result for connection: " <> sShow connId]
CECommandError e -> ["bad chat command: " <> plain e]
CEAgentCommandError e -> ["agent command error: " <> plain e]
+ CEInvalidFileDescription e -> ["invalid file description: " <> plain e]
CEInternalError e -> ["internal chat error: " <> plain e]
-- e -> ["chat error: " <> sShow e]
ChatErrorStore err -> case err of
diff --git a/stack.yaml b/stack.yaml
index f3e19e6c5..a6063f8e0 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -49,7 +49,7 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
- commit: bd4fecf4a84071079cffccfc0f35a916eac0e086
+ commit: ddc2da8fe44f95928213522ec43a40154fd3c050
- github: kazu-yamamoto/http2
commit: 78e18f52295a7f89e828539a03fbcb24931461a3
# - ../direct-sqlcipher
From e21b4d42368a64842eb5d92eb1f917a10710e59c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Tue, 14 Mar 2023 09:28:54 +0000
Subject: [PATCH 03/17] xftp: send file descriptions when ready (#1999)
* xftp: send file descriptions when ready
* remove comments, update progress on completion
* update simplexmq
* fix error condition
Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
* fix conflict
* saveMemberFD
* more efficient list merging
---------
Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
---
src/Simplex/Chat.hs | 92 ++++++++++++++++++++++-----------------
src/Simplex/Chat/Store.hs | 87 +++++++++++++++++++++++-------------
src/Simplex/Chat/Types.hs | 11 ++---
3 files changed, 115 insertions(+), 75 deletions(-)
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 4c94150fb..96aaf9a8a 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -442,12 +442,12 @@ processChatCommand = \case
quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False)
quoteData _ = throwChatError CEInvalidQuote
CTGroup -> do
- Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId
+ g@(Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms) <- withStore $ \db -> getGroup db user chatId
assertUserGroupRole gInfo GRAuthor
if isVoice mc && not (groupFeatureAllowed SGFVoice gInfo)
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFVoice))
else do
- (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo (length $ filter memberCurrent ms)
+ (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live gInfo
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
msg@SndMessage {sharedMsgId} <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
@@ -458,12 +458,12 @@ processChatCommand = \case
setActive $ ActiveG gName
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
where
- setupSndFileTransfer :: GroupInfo -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
- setupSndFileTransfer gInfo n = forM file_ $ \file -> do
+ setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
+ setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do
(fileSize, fileMode) <- checkSndFile mc file $ fromIntegral n
case fileMode of
SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
- SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ CGGroup gInfo
+ SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ CGGroup g
where
smpSndFileTransfer :: FilePath -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer file fileSize fileInline = do
@@ -531,11 +531,21 @@ processChatCommand = \case
xftpSndFileTransfer :: User -> FilePath -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
xftpSndFileTransfer user file fileSize n contactOrGroup = do
let fileName = takeFileName file
- fInv = xftpFileInvitation fileName fileSize
+ fileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
+ fInv = xftpFileInvitation fileName fileSize fileDescr
tmp <- readTVarIO =<< asks tempDirectory
aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) file n tmp
ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv $ AgentSndFileId aFileId
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
+ case contactOrGroup of
+ CGContact Contact {activeConn} -> withStore' $ \db -> createSndFTDescrXFTP db user Nothing activeConn ft fileDescr
+ CGGroup (Group _ ms) -> forM_ ms $ \m -> saveMemberFD m `catchError` (toView . CRChatError (Just user))
+ where
+ -- we are not sending files to pending members, same as with inline files
+ saveMemberFD m@GroupMember {activeConn = Just conn@Connection {connStatus}} =
+ when ((connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn)) $
+ withStore' $ \db -> createSndFTDescrXFTP db user (Just m) conn ft fileDescr
+ saveMemberFD _ = pure ()
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)
@@ -2147,51 +2157,53 @@ processAgentMsgSndFile _corrId aFileId msg =
where
process :: User -> m ()
process user = do
- ft@FileTransferMeta {fileId} <- withStore $ \db -> getAgentSndFileXFTP db user $ AgentSndFileId aFileId
+ fileId <- withStore $ \db -> getAgentSndFileIdXFTP 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}} <-
+ ci@(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 ()
+ (Just sharedMsgId, Nothing) -> do
+ (ft, sfts) <- withStore $ \db -> getSndFileTransfer db user fileId
+ when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send"
+ toView $ CRSndFileProgressXFTP user ci ft 1 1
+ case (rfds, sfts, d, cInfo) of
+ (rfd : _, sft : _, SMDSnd, DirectChat ct) ->
+ sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
+ (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
+ ms <- withStore' $ \db -> getGroupMembers db user g
+ forM_ (zip rfds $ memberFTs ms) $ \mt -> sendToMember mt `catchError` (toView . CRChatError (Just user))
+ where
+ memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
+ memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
+ where
+ mConns' = mapMaybe useMember ms
+ sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts
+ useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}}
+ | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn)
+ | otherwise = Nothing
+ useMember _ = Nothing
+ sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
+ sendToMember (rfd, (conn, sft)) =
+ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
+ _ -> pure ()
+ _ -> pure () -- TODO error?
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
+ sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m ()
+ sendFileDescription sft rfd msgId sendMsg = do
+ let rfdText = safeDecodeUtf8 $ strEncode rfd
+ withStore' $ \db -> updateSndFTDescrXFTP db user sft rfdText
partSize <- asks $ xftpDescrPartSize . config
- sendParts 1 partSize rfdText
+ msgDeliveryId <- sendParts 1 partSize rfdText
+ -- msgDeliveryId <- sendFileDescription_ rfd sharedMsgId sendMsg
+ withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
where
- sendParts partNo partSize rfd = do
- let (part, rest) = T.splitAt partSize rfd
+ sendParts partNo partSize rfdText = do
+ let (part, rest) = T.splitAt partSize rfdText
complete = T.null rest
fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
(_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileDescr}
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index 1e60ead21..1eea4df69 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -156,8 +156,10 @@ module Simplex.Chat.Store
updateSndGroupFTDelivery,
getSndFTViaMsgDelivery,
createSndFileTransferXFTP,
- createSndDirectFTDescrXFTP,
- getAgentSndFileXFTP,
+ createSndFTDescrXFTP,
+ updateSndFTDescrXFTP,
+ updateSndFTDeliveryXFTP,
+ getAgentSndFileIdXFTP,
getAgentRcvFileXFTP,
updateFileCancelled,
updateCIFileStatus,
@@ -190,6 +192,7 @@ module Simplex.Chat.Store
getFileTransferProgress,
getFileTransferMeta,
getSndFileTransfer,
+ getSndFileTransfers,
getContactFileInfo,
deleteContactCIs,
getGroupFileInfo,
@@ -1742,7 +1745,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_descr_id, 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, s.group_member_id, 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)
@@ -1750,10 +1753,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 Int64, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
- sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, contactName_, memberName_) =
+ sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
+ sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, contactName_, memberName_) =
case contactName_ <|> memberName_ of
- Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId}
+ Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId, groupMemberId}
Nothing -> Left $ SESndFileInvalid fileId
getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
getUserContact_ userContactLinkId = ExceptT $ do
@@ -2681,7 +2684,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, fileDescrId = Nothing, fileInline = fileInline'}
+ pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, groupMemberId = Nothing, 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
@@ -2692,7 +2695,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, fileDescrId = Nothing, fileInline = fileInline'}
+ pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, groupMemberId = Just groupMemberId, fileStatus, fileDescrId = Nothing, fileInline = fileInline'}
updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> IO ()
updateSndDirectFTDelivery db Contact {activeConn = Connection {connId}} FileTransferMeta {fileId} msgDeliveryId =
@@ -2714,7 +2717,7 @@ getSndFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMs
<$> 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_descr_id, 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, s.group_member_id, 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
@@ -2725,9 +2728,9 @@ getSndFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMs
|]
(connId, agentMsgId, userId)
where
- 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})
+ sndFileTransfer_ :: (Int64, FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Maybe SndFileTransfer
+ sndFileTransfer_ (fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, contactName_, memberName_) =
+ (\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, recipientDisplayName = n, connId, agentConnId})
<$> (contactName_ <|> memberName_)
createSndFileTransferXFTP :: DB.Connection -> User -> ContactOrGroup -> FilePath -> FileInvitation -> AgentSndFileId -> IO FileTransferMeta
@@ -2742,22 +2745,43 @@ createSndFileTransferXFTP db User {userId} contactOrGroup filePath FileInvitatio
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)
+createSndFTDescrXFTP :: DB.Connection -> User -> Maybe GroupMember -> Connection -> FileTransferMeta -> FileDescr -> IO ()
+createSndFTDescrXFTP db User {userId} m Connection {connId} FileTransferMeta {fileId} FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
+ let fileStatus = FSNew
+ DB.execute
+ db
+ "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete) VALUES (?,?,?,?)"
+ (userId, fileDescrText, fileDescrPartNo, fileDescrComplete)
fileDescrId <- insertedRowId db
DB.execute
db
- "INSERT INTO snd_files (file_id, file_status, file_descr_id, connection_id) VALUES (?,?,?,?)"
- (fileId, fileStatus, fileDescrId, connId)
+ "INSERT INTO snd_files (file_id, file_status, file_descr_id, group_member_id, connection_id) VALUES (?,?,?,?,?)"
+ (fileId, fileStatus, fileDescrId, groupMemberId' <$> m, 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
+updateSndFTDescrXFTP :: DB.Connection -> User -> SndFileTransfer -> Text -> IO ()
+updateSndFTDescrXFTP db user@User {userId} sft@SndFileTransfer {fileId, fileDescrId} rfdText = do
+ DB.execute
+ db
+ [sql|
+ UPDATE xftp_file_descriptions
+ SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?
+ WHERE user_id = ? AND file_descr_id = ?
+ |]
+ (rfdText, 1 :: Int, True, userId, fileDescrId)
+ updateCIFileStatus db user fileId $ CIFSSndTransfer 1 1
+ updateSndFileStatus db sft FSConnected
+
+updateSndFTDeliveryXFTP :: DB.Connection -> SndFileTransfer -> Int64 -> IO ()
+updateSndFTDeliveryXFTP db SndFileTransfer {connId, fileId, fileDescrId} msgDeliveryId =
+ DB.execute
+ db
+ "UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE connection_id = ? AND file_id = ? AND file_descr_id = ?"
+ (msgDeliveryId, connId, fileId, fileDescrId)
+
+getAgentSndFileIdXFTP :: DB.Connection -> User -> AgentSndFileId -> ExceptT StoreError IO Int64
+getAgentSndFileIdXFTP db User {userId} aSndFileId =
+ ExceptT . firstRow fromOnly (SESndFileNotFoundXFTP aSndFileId) $
+ DB.query db "SELECT file_id FROM files WHERE user_id = ? AND agent_snd_file_id = ?" (userId, aSndFileId)
getAgentRcvFileXFTP :: DB.Connection -> User -> AgentRcvFileId -> ExceptT StoreError IO FileTransferMeta
getAgentRcvFileXFTP _db _user _aFileId = undefined
@@ -3179,18 +3203,21 @@ getFileTransfer db user@User {userId} fileId =
(userId, fileId)
getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
-getSndFileTransfer db user@User {userId} fileId = do
+getSndFileTransfer db user fileId = do
fileTransferMeta <- getFileTransferMeta db user fileId
- sndFileTransfers <- ExceptT $ getSndFileTransfers_ db userId fileId
+ sndFileTransfers <- getSndFileTransfers db user fileId
pure (fileTransferMeta, sndFileTransfers)
+getSndFileTransfers :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO [SndFileTransfer]
+getSndFileTransfers db User {userId} fileId = ExceptT $ getSndFileTransfers_ db userId fileId
+
getSndFileTransfers_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError [SndFileTransfer])
getSndFileTransfers_ db userId fileId =
mapM sndFileTransfer
<$> DB.query
db
[sql|
- 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,
+ 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, s.group_member_id,
cs.local_display_name, m.local_display_name
FROM snd_files s
JOIN files f USING (file_id)
@@ -3201,10 +3228,10 @@ getSndFileTransfers_ db userId fileId =
|]
(userId, fileId)
where
- 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_)) =
+ sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath) :. (Maybe Int64, Maybe InlineFileMode, Int64, AgentConnId, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
+ sndFileTransfer ((fileStatus, fileName, fileSize, chunkSize, filePath) :. (fileDescrId, fileInline, connId, agentConnId, groupMemberId, contactName_, memberName_)) =
case contactName_ <|> memberName_ of
- Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId}
+ Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId, groupMemberId}
Nothing -> Left $ SESndFileInvalid fileId
getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 937ea8117..10f3851c3 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -287,12 +287,12 @@ instance ToJSON GroupInfo where toEncoding = J.genericToEncoding J.defaultOption
groupName' :: GroupInfo -> GroupName
groupName' GroupInfo {localDisplayName = g} = g
-data ContactOrGroup = CGContact Contact | CGGroup GroupInfo
+data ContactOrGroup = CGContact Contact | CGGroup Group
contactAndGroupIds :: ContactOrGroup -> (Maybe ContactId, Maybe GroupId)
contactAndGroupIds = \case
CGContact Contact {contactId} -> (Just contactId, Nothing)
- CGGroup GroupInfo {groupId} -> (Nothing, Just groupId)
+ CGGroup (Group 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
@@ -1461,6 +1461,7 @@ data SndFileTransfer = SndFileTransfer
recipientDisplayName :: ContactName,
connId :: Int64,
agentConnId :: AgentConnId,
+ groupMemberId :: Maybe Int64,
fileStatus :: FileStatus,
fileDescrId :: Maybe Int64,
fileInline :: Maybe InlineFileMode
@@ -1501,15 +1502,15 @@ instance ToJSON FileDescr where
instance FromJSON FileDescr where
parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "FD"
-xftpFileInvitation :: FilePath -> Integer -> FileInvitation
-xftpFileInvitation fileName fileSize =
+xftpFileInvitation :: FilePath -> Integer -> FileDescr -> FileInvitation
+xftpFileInvitation fileName fileSize fileDescr =
FileInvitation
{ fileName,
fileSize,
fileDigest = Nothing,
fileConnReq = Nothing,
fileInline = Nothing,
- fileDescr = Just FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
+ fileDescr = Just fileDescr
}
data InlineFileMode
From 9b7fbfd5130b774bcf0d9a86cd6087705b677ae9 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 14 Mar 2023 15:26:40 +0400
Subject: [PATCH 04/17] core: rcv file events (#2002)
---
src/Simplex/Chat.hs | 22 +++++++++----------
.../Migrations/M20230304_file_description.hs | 4 ++++
src/Simplex/Chat/Migrations/chat_schema.sql | 2 ++
src/Simplex/Chat/Store.hs | 21 ++++++++++++------
4 files changed, 30 insertions(+), 19 deletions(-)
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 96aaf9a8a..ca0ab31b9 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -2219,18 +2219,20 @@ processAgentMsgRcvFile _corrId aFileId msg =
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)
+ fileId <- withStore (`getAgentRcvFileIdXFTP` AgentRcvFileId aFileId)
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 ()
+ ci <- withStore $ \db -> do
+ liftIO $ do
+ updateRcvFileStatus' db fileId FSComplete
+ updateCIFileStatus db user fileId CIFSRcvComplete
+ getChatItemByFileId db user fileId
+ -- ack to agent
+ toView $ CRRcvFileComplete user ci
RFERR _e -> do
-- update chat item status
-- send status to view
@@ -2907,17 +2909,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
processFDMessage :: FileTransferId -> FileDescr -> m ()
processFDMessage fileId fileDescr = do
- (rfd, _aci) <- withStore $ \db -> do
- rfd <- appendRcvFD db userId fileId fileDescr
- aci <- getChatItemByFileId db user fileId
- -- ? re-create file item if it does not exist
- pure (rfd, aci)
+ rfd <- withStore $ \db -> appendRcvFD db userId fileId fileDescr
let RcvFileDescr {fileDescrText, fileDescrComplete} = rfd
when fileDescrComplete $ do
rd <- parseRcvFileDescription fileDescrText
tmp <- readTVarIO =<< asks tempDirectory
aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd tmp
- withStore' $ \db -> updateRcvFileAgentId db fileId aFileId
+ withStore' $ \db -> updateRcvFileAgentId db fileId (AgentRcvFileId aFileId)
cancelMessageFile :: Contact -> SharedMsgId -> MsgMeta -> m ()
cancelMessageFile ct _sharedMsgId msgMeta = do
diff --git a/src/Simplex/Chat/Migrations/M20230304_file_description.hs b/src/Simplex/Chat/Migrations/M20230304_file_description.hs
index 40e7d0f0a..54bf3b8ff 100644
--- a/src/Simplex/Chat/Migrations/M20230304_file_description.hs
+++ b/src/Simplex/Chat/Migrations/M20230304_file_description.hs
@@ -28,8 +28,12 @@ ALTER TABLE files ADD COLUMN private_snd_file_descr TEXT NULL;
ALTER TABLE snd_files ADD COLUMN file_descr_id INTEGER NULL
REFERENCES xftp_file_descriptions ON DELETE SET NULL;
+CREATE INDEX idx_snd_files_file_descr_id ON snd_files(file_descr_id);
+
ALTER TABLE rcv_files ADD COLUMN file_descr_id INTEGER NULL
REFERENCES xftp_file_descriptions ON DELETE SET NULL;
+CREATE INDEX idx_rcv_files_file_descr_id ON rcv_files(file_descr_id);
+
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 5c2758508..1e36360b4 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -567,3 +567,5 @@ CREATE TABLE xftp_file_descriptions(
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
+CREATE INDEX idx_snd_files_file_descr_id ON snd_files(file_descr_id);
+CREATE INDEX idx_rcv_files_file_descr_id ON rcv_files(file_descr_id);
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index 1eea4df69..44be7f2f7 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -160,7 +160,7 @@ module Simplex.Chat.Store
updateSndFTDescrXFTP,
updateSndFTDeliveryXFTP,
getAgentSndFileIdXFTP,
- getAgentRcvFileXFTP,
+ getAgentRcvFileIdXFTP,
updateFileCancelled,
updateCIFileStatus,
getSharedMsgIdByFileId,
@@ -184,6 +184,7 @@ module Simplex.Chat.Store
acceptRcvInlineFT,
startRcvInlineFT,
updateRcvFileStatus,
+ updateRcvFileStatus',
createRcvFileChunk,
updatedRcvFileChunkStored,
deleteRcvFileChunks,
@@ -360,7 +361,7 @@ 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 (..), RcvFileId, UserId)
+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
@@ -2783,8 +2784,10 @@ getAgentSndFileIdXFTP db User {userId} aSndFileId =
ExceptT . firstRow fromOnly (SESndFileNotFoundXFTP aSndFileId) $
DB.query db "SELECT file_id FROM files WHERE user_id = ? AND agent_snd_file_id = ?" (userId, aSndFileId)
-getAgentRcvFileXFTP :: DB.Connection -> User -> AgentRcvFileId -> ExceptT StoreError IO FileTransferMeta
-getAgentRcvFileXFTP _db _user _aFileId = undefined
+getAgentRcvFileIdXFTP :: DB.Connection -> AgentRcvFileId -> ExceptT StoreError IO FileTransferId
+getAgentRcvFileIdXFTP db aRcvFileId =
+ ExceptT . firstRow fromOnly (SERcvFileNotFoundXFTP aRcvFileId) $
+ DB.query db "SELECT file_id FROM rcv_files WHERE agent_rcv_file_id = ?" (Only aRcvFileId)
updateFileCancelled :: MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> IO ()
updateFileCancelled db User {userId} fileId ciFileStatus = do
@@ -3019,7 +3022,7 @@ getRcvFileDescrByFileId_ db fileId =
toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
-updateRcvFileAgentId :: DB.Connection -> FileTransferId -> RcvFileId -> IO ()
+updateRcvFileAgentId :: DB.Connection -> FileTransferId -> AgentRcvFileId -> IO ()
updateRcvFileAgentId db fileId aFileId = do
currentTs <- getCurrentTime
DB.execute db "UPDATE rcv_files SET agent_rcv_file_id = ?, updated_at = ? WHERE file_id = ?" (aFileId, currentTs, fileId)
@@ -3115,7 +3118,10 @@ acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do
(rcvFileInline, FSAccepted, currentTs, fileId)
updateRcvFileStatus :: DB.Connection -> RcvFileTransfer -> FileStatus -> IO ()
-updateRcvFileStatus db RcvFileTransfer {fileId} status = do
+updateRcvFileStatus db RcvFileTransfer {fileId} = updateRcvFileStatus' db fileId
+
+updateRcvFileStatus' :: DB.Connection -> FileTransferId -> FileStatus -> IO ()
+updateRcvFileStatus' db fileId status = do
currentTs <- getCurrentTime
DB.execute db "UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?" (status, currentTs, fileId)
@@ -5136,7 +5142,8 @@ data StoreError
| SERcvFileInvalidDescrPart
| SESharedMsgIdNotFoundByFileId {fileId :: FileTransferId}
| SEFileIdNotFoundBySharedMsgId {sharedMsgId :: SharedMsgId}
- | SESndFileNotFoundXFTP {agentFileId :: AgentSndFileId}
+ | SESndFileNotFoundXFTP {agentSndFileId :: AgentSndFileId}
+ | SERcvFileNotFoundXFTP {agentRcvFileId :: AgentRcvFileId}
| SEConnectionNotFound {agentConnId :: AgentConnId}
| SEConnectionNotFoundById {connId :: Int64}
| SEPendingConnectionNotFound {connId :: Int64}
From fda41817e994670166b4474337a9ef26b820c0e2 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 14 Mar 2023 21:51:35 +0400
Subject: [PATCH 05/17] core: XFTP accept; provide save path to agent (#2005)
---
cabal.project | 2 +-
scripts/nix/sha256map.nix | 2 +-
src/Simplex/Chat.hs | 34 ++++++++++++++++++++++------------
src/Simplex/Chat/Store.hs | 22 ++++++++++++++++------
stack.yaml | 2 +-
5 files changed, 41 insertions(+), 21 deletions(-)
diff --git a/cabal.project b/cabal.project
index 5da331e77..67dce5538 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: ddc2da8fe44f95928213522ec43a40154fd3c050
+ tag: db120b6d2eee04836a132f0bfbca9491cacf3dc8
source-repository-package
type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 6e1fc47a8..1f4922a61 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
{
- "https://github.com/simplex-chat/simplexmq.git"."ddc2da8fe44f95928213522ec43a40154fd3c050" = "1c6bdl6vhy1h459hwsxdiw27xkckcw53c5g1g8fy2bp8gn9q5k4s";
+ "https://github.com/simplex-chat/simplexmq.git"."db120b6d2eee04836a132f0bfbca9491cacf3dc8" = "0md0i4vl84mdmkgwjrmlkipqm9k1rqbld0ld1xxss3z1xdb7fdrj";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/kazu-yamamoto/http2.git"."78e18f52295a7f89e828539a03fbcb24931461a3" = "05q165anvv0qrcxqbvq1dlvw0l8gmsa9kl6sazk1mfhz2g0yimdk";
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index ca0ab31b9..44fff46ab 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1768,11 +1768,13 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, rcvFileDescription
connIds <- joinAgentConnectionAsync user True connReq . directMessage $ XFileAcpt fName
filePath <- getRcvFilePath fileId filePath_ fName
withStore $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath
+ -- XFTP
+ (Just rfd, _) -> do
+ filePath <- getRcvFilePath fileId filePath_ fName
+ ci <- withStore $ \db -> xftpAcceptRcvFT db user fileId filePath
+ receiveViaCompleteFD user fileId filePath rfd
+ pure ci
-- group & direct file protocol
- (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
@@ -1813,6 +1815,14 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, rcvFileDescription
|| (rcvInline_ == Just True && fileSize <= fileChunkSize * offerChunks)
)
+receiveViaCompleteFD :: ChatMonad m => User -> FileTransferId -> FilePath -> RcvFileDescr -> m ()
+receiveViaCompleteFD user fileId filePath RcvFileDescr {fileDescrText, fileDescrComplete} =
+ when fileDescrComplete $ do
+ rd <- parseRcvFileDescription fileDescrText
+ tmp <- readTVarIO =<< asks tempDirectory
+ aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd tmp filePath
+ withStore' $ \db -> updateRcvFileAgentId db fileId (AgentRcvFileId aFileId)
+
getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> m FilePath
getRcvFilePath fileId fPath_ fn = case fPath_ of
Nothing ->
@@ -2225,7 +2235,7 @@ processAgentMsgRcvFile _corrId aFileId msg =
-- update chat item status
-- send status to view
pure ()
- RFDONE _filePath -> do
+ RFDONE -> do
ci <- withStore $ \db -> do
liftIO $ do
updateRcvFileStatus' db fileId FSComplete
@@ -2909,13 +2919,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
processFDMessage :: FileTransferId -> FileDescr -> m ()
processFDMessage fileId fileDescr = do
- rfd <- withStore $ \db -> appendRcvFD db userId fileId fileDescr
- let RcvFileDescr {fileDescrText, fileDescrComplete} = rfd
- when fileDescrComplete $ do
- rd <- parseRcvFileDescription fileDescrText
- tmp <- readTVarIO =<< asks tempDirectory
- aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd tmp
- withStore' $ \db -> updateRcvFileAgentId db fileId (AgentRcvFileId aFileId)
+ (rfd, RcvFileTransfer {fileStatus}) <- withStore $ \db -> do
+ rfd <- appendRcvFD db userId fileId fileDescr
+ ft <- getRcvFileTransfer db user fileId
+ pure (rfd, ft)
+ case fileStatus of
+ RFSAccepted RcvFileInfo {filePath} -> receiveViaCompleteFD user fileId filePath rfd
+ _ -> pure ()
cancelMessageFile :: Contact -> SharedMsgId -> MsgMeta -> m ()
cancelMessageFile ct _sharedMsgId msgMeta = do
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index 44be7f2f7..ea53ef562 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -183,6 +183,7 @@ module Simplex.Chat.Store
getContactByFileId,
acceptRcvInlineFT,
startRcvInlineFT,
+ xftpAcceptRcvFT,
updateRcvFileStatus,
updateRcvFileStatus',
createRcvFileChunk,
@@ -1439,7 +1440,9 @@ getLiveRcvFileTransfers db user@User {userId} = do
SELECT f.file_id
FROM files f
JOIN rcv_files r USING (file_id)
- WHERE f.user_id = ? AND r.file_status IN (?, ?) AND r.rcv_file_inline IS NULL
+ WHERE f.user_id = ? AND r.file_status IN (?, ?)
+ AND r.rcv_file_inline IS NULL
+ AND r.file_descr_id IS NULL
AND r.created_at > ?
|]
(userId, FSAccepted, FSConnected, cutoffTs)
@@ -3050,12 +3053,14 @@ getRcvFileTransfer db User {userId} fileId = do
WHERE f.user_id = ? AND f.file_id = ?
|]
(userId, fileId)
- rcvFileTransfer rftRow
+ rfd <- liftIO $ getRcvFileDescrByFileId_ db fileId
+ rcvFileTransfer rfd rftRow
where
rcvFileTransfer ::
+ Maybe RcvFileDescr ->
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe InlineFileMode, Maybe InlineFileMode) :. (Maybe Int64, Maybe AgentConnId) ->
ExceptT StoreError IO RcvFileTransfer
- rcvFileTransfer ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileInline, rcvFileInline) :. (connId_, agentConnId_)) = do
+ rcvFileTransfer rcvFileDescription ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileInline, rcvFileInline) :. (connId_, agentConnId_)) = do
let fileInv = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
fileInfo = (filePath_, connId_, agentConnId_)
case contactName_ <|> memberName_ of
@@ -3069,7 +3074,7 @@ getRcvFileTransfer db User {userId} fileId = do
FSCancelled -> ft name fileInv . RFSCancelled <$> rfi_ fileInfo
where
ft senderDisplayName fileInvitation fileStatus =
- RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName, chunkSize, cancelled, grpMemberId}
+ RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, rcvFileDescription, senderDisplayName, chunkSize, cancelled, grpMemberId}
rfi fileInfo = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_ fileInfo
rfi_ = \case
(Just filePath, connId, agentConnId) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
@@ -3097,7 +3102,7 @@ getContactByFileId db user@User {userId} fileId = do
ExceptT . firstRow fromOnly (SEContactNotFoundByFileId fileId) $
DB.query db "SELECT contact_id FROM files WHERE user_id = ? AND file_id = ?" (userId, fileId)
-acceptRcvInlineFT :: DB.Connection -> User -> Int64 -> FilePath -> ExceptT StoreError IO AChatItem
+acceptRcvInlineFT :: DB.Connection -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvInlineFT db user fileId filePath = do
liftIO $ acceptRcvFT_ db user fileId filePath (Just IFMOffer) =<< getCurrentTime
getChatItemByFileId db user fileId
@@ -3106,7 +3111,12 @@ startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Mayb
startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline =
acceptRcvFT_ db user fileId filePath rcvFileInline =<< getCurrentTime
-acceptRcvFT_ :: DB.Connection -> User -> Int64 -> FilePath -> Maybe InlineFileMode -> UTCTime -> IO ()
+xftpAcceptRcvFT :: DB.Connection -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
+xftpAcceptRcvFT db user fileId filePath = do
+ liftIO $ acceptRcvFT_ db user fileId filePath Nothing =<< getCurrentTime
+ getChatItemByFileId db user fileId
+
+acceptRcvFT_ :: DB.Connection -> User -> FileTransferId -> FilePath -> Maybe InlineFileMode -> UTCTime -> IO ()
acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do
DB.execute
db
diff --git a/stack.yaml b/stack.yaml
index a6063f8e0..610e54e77 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -49,7 +49,7 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
- commit: ddc2da8fe44f95928213522ec43a40154fd3c050
+ commit: db120b6d2eee04836a132f0bfbca9491cacf3dc8
- github: kazu-yamamoto/http2
commit: 78e18f52295a7f89e828539a03fbcb24931461a3
# - ../direct-sqlcipher
From 12200a74ffb2d5494efc8ee8dbd9251e7b90038d Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 16 Mar 2023 10:49:57 +0400
Subject: [PATCH 06/17] core: XFTP file transfer test (#2009)
---
cabal.project | 2 +-
scripts/nix/sha256map.nix | 2 +-
src/Simplex/Chat.hs | 57 ++++++++++++++++++++--------------
src/Simplex/Chat/Controller.hs | 1 +
src/Simplex/Chat/Store.hs | 34 +++++++++-----------
src/Simplex/Chat/Types.hs | 2 +-
stack.yaml | 2 +-
tests/ChatTests/Files.hs | 26 +++++++++++++++-
8 files changed, 78 insertions(+), 48 deletions(-)
diff --git a/cabal.project b/cabal.project
index 67dce5538..e66052985 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: db120b6d2eee04836a132f0bfbca9491cacf3dc8
+ tag: a0eb53b891b1f4f765f440020654fbae45bf8b00
source-repository-package
type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 1f4922a61..a057c9a51 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
{
- "https://github.com/simplex-chat/simplexmq.git"."db120b6d2eee04836a132f0bfbca9491cacf3dc8" = "0md0i4vl84mdmkgwjrmlkipqm9k1rqbld0ld1xxss3z1xdb7fdrj";
+ "https://github.com/simplex-chat/simplexmq.git"."a0eb53b891b1f4f765f440020654fbae45bf8b00" = "0nbqj26yzdw3h5p4zdw4l65ybi60f571gpl3244fmmv7ll8v8ys8";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/kazu-yamamoto/http2.git"."78e18f52295a7f89e828539a03fbcb24931461a3" = "05q165anvv0qrcxqbvq1dlvw0l8gmsa9kl6sazk1mfhz2g0yimdk";
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 44fff46ab..ff05f4fed 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -15,7 +15,7 @@
module Simplex.Chat where
import Control.Applicative (optional, (<|>))
-import Control.Concurrent.STM (retry, stateTVar)
+import Control.Concurrent.STM (retry)
import Control.Logger.Simple
import Control.Monad.Except
import Control.Monad.IO.Unlift
@@ -111,6 +111,7 @@ defaultChatConfig =
xftpDescrPartSize = 14000,
inlineFiles = defaultInlineFilesConfig,
xftpFileConfig = Nothing,
+ tempDir = Nothing,
logLevel = CLLImportant,
subscriptionEvents = False,
hostEvents = False,
@@ -145,7 +146,7 @@ createChatDatabase filePrefix key yesToMigrations = do
pure ChatDatabase {chatStore, agentStore}
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController
-newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles} ChatOpts {coreOptions = CoreChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do
+newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do
let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
config = cfg {logLevel, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'}
sendNotification = fromMaybe (const $ pure ()) sendToast
@@ -171,7 +172,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
timedItemThreads <- atomically TM.empty
showLiveItems <- newTVarIO False
userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
- tempDirectory <- newTVarIO Nothing
+ tempDirectory <- newTVarIO tempDir
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, tempDirectory, logFilePath = logFile}
where
configServers :: DefaultAgentServers
@@ -535,6 +536,7 @@ processChatCommand = \case
fInv = xftpFileInvitation fileName fileSize fileDescr
tmp <- readTVarIO =<< asks tempDirectory
aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) file n tmp
+ -- TODO CRSndFileStart event for XFTP
ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv $ AgentSndFileId aFileId
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
case contactOrGroup of
@@ -1766,11 +1768,11 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, rcvFileDescription
-- direct file protocol
(Nothing, Just connReq) -> do
connIds <- joinAgentConnectionAsync user True connReq . directMessage $ XFileAcpt fName
- filePath <- getRcvFilePath fileId filePath_ fName
+ filePath <- getRcvFilePath fileId filePath_ fName True
withStore $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath
-- XFTP
(Just rfd, _) -> do
- filePath <- getRcvFilePath fileId filePath_ fName
+ filePath <- getRcvFilePath fileId filePath_ fName False
ci <- withStore $ \db -> xftpAcceptRcvFT db user fileId filePath
receiveViaCompleteFD user fileId filePath rfd
pure ci
@@ -1791,7 +1793,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, rcvFileDescription
where
acceptFile :: CommandFunction -> (ChatMsgEvent 'Json -> m ()) -> m AChatItem
acceptFile cmdFunction send = do
- filePath <- getRcvFilePath fileId filePath_ fName
+ filePath <- getRcvFilePath fileId filePath_ fName True
inline <- receiveInline
if
| inline -> do
@@ -1821,10 +1823,19 @@ receiveViaCompleteFD user fileId filePath RcvFileDescr {fileDescrText, fileDescr
rd <- parseRcvFileDescription fileDescrText
tmp <- readTVarIO =<< asks tempDirectory
aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd tmp filePath
+ startReceivingFile user fileId
withStore' $ \db -> updateRcvFileAgentId db fileId (AgentRcvFileId aFileId)
-getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> m FilePath
-getRcvFilePath fileId fPath_ fn = case fPath_ of
+startReceivingFile :: ChatMonad m => User -> FileTransferId -> m ()
+startReceivingFile user fileId = do
+ ci <- withStore $ \db -> do
+ liftIO $ updateRcvFileStatus db fileId FSConnected
+ liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
+ getChatItemByFileId db user fileId
+ toView $ CRRcvFileStart user ci
+
+getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> Bool -> m FilePath
+getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
Nothing ->
asks filesFolder >>= readTVarIO >>= \case
Nothing -> do
@@ -1849,9 +1860,15 @@ getRcvFilePath fileId fPath_ fn = case fPath_ of
createEmptyFile fPath = emptyFile fPath `E.catch` (throwChatError . CEFileWrite fPath . (show :: E.SomeException -> String))
emptyFile :: FilePath -> m FilePath
emptyFile fPath = do
- h <- getFileHandle fileId fPath rcvFiles AppendMode
+ h <-
+ if keepHandle
+ then getFileHandle fileId fPath rcvFiles AppendMode
+ else getTmpHandle fPath
liftIO $ B.hPut h "" >> hFlush h
pure fPath
+ getTmpHandle :: FilePath -> m Handle
+ getTmpHandle fPath =
+ liftIO (openFile fPath AppendMode) `E.catch` (throwChatError . CEFileInternal . (show :: E.SomeException -> String))
uniqueCombine :: FilePath -> String -> m FilePath
uniqueCombine filePath fileName = tryCombine (0 :: Int)
where
@@ -2238,7 +2255,7 @@ processAgentMsgRcvFile _corrId aFileId msg =
RFDONE -> do
ci <- withStore $ \db -> do
liftIO $ do
- updateRcvFileStatus' db fileId FSComplete
+ updateRcvFileStatus db fileId FSComplete
updateCIFileStatus db user fileId CIFSRcvComplete
getChatItemByFileId db user fileId
-- ack to agent
@@ -2673,7 +2690,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
case chatMsgEvent of
XOk -> allowAgentConnectionAsync user conn confId XOk -- [async agent commands] no continuation needed, but command should be asynchronous for stability
_ -> pure ()
- CON -> startReceivingFile ft
+ CON -> startReceivingFile user fileId
MSG meta _ msgBody -> do
parseFileChunk msgBody >>= receiveFileChunk ft (Just conn) meta
OK ->
@@ -2688,14 +2705,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- TODO add debugging output
_ -> pure ()
- startReceivingFile :: RcvFileTransfer -> m ()
- startReceivingFile ft@RcvFileTransfer {fileId} = do
- ci <- withStore $ \db -> do
- liftIO $ updateRcvFileStatus db ft FSConnected
- liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
- getChatItemByFileId db user fileId
- toView $ CRRcvFileStart user ci
-
receiveFileChunk :: RcvFileTransfer -> Maybe Connection -> MsgMeta -> FileChunk -> m ()
receiveFileChunk ft@RcvFileTransfer {fileId, chunkSize, cancelled} conn_ meta@MsgMeta {recipient = (msgId, _), integrity} = \case
FileChunkCancel ->
@@ -2720,7 +2729,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
appendFileChunk ft chunkNo chunk
ci <- withStore $ \db -> do
liftIO $ do
- updateRcvFileStatus db ft FSComplete
+ updateRcvFileStatus db fileId FSComplete
updateCIFileStatus db user fileId CIFSRcvComplete
deleteRcvFileChunks db ft
getChatItemByFileId db user fileId
@@ -2945,7 +2954,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ft@RcvFileTransfer {fileId} <- withStore $ \db -> createRcvFT db fInv inline fileChunkSize
(filePath, fileStatus) <- case inline of
Just IFMSent -> do
- fPath <- getRcvFilePath fileId Nothing fileName
+ fPath <- getRcvFilePath fileId Nothing fileName True
withStore' $ \db -> startRcvInlineFT db user ft fPath inline
pure (Just fPath, CIFSRcvAccepted)
_ -> pure (Nothing, CIFSRcvInvitation)
@@ -3171,9 +3180,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _
| chunkNo == 1 = throwChatError $ CEInlineFileProhibited fileId
| otherwise = pure ()
- receiveInlineChunk ft chunk meta = do
+ receiveInlineChunk ft@RcvFileTransfer {fileId} chunk meta = do
case chunk of
- FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile ft
+ FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile user fileId
_ -> pure ()
receiveFileChunk ft Nothing meta chunk
@@ -3714,7 +3723,7 @@ cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, rcvFileInline} =
closeFileHandle fileId rcvFiles
withStore' $ \db -> do
updateFileCancelled db user fileId CIFSRcvCancelled
- updateRcvFileStatus db ft FSCancelled
+ updateRcvFileStatus db fileId FSCancelled
deleteRcvFileChunks db ft
pure fileConnId
fileConnId = if isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index bf381218f..0cb8f8441 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -108,6 +108,7 @@ data ChatConfig = ChatConfig
xftpDescrPartSize :: Int,
inlineFiles :: InlineFilesConfig,
xftpFileConfig :: Maybe XFTPFileConfig, -- Nothing - XFTP is disabled
+ tempDir :: Maybe FilePath,
subscriptionEvents :: Bool,
hostEvents :: Bool,
logLevel :: ChatLogLevel,
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index ea53ef562..7669816dc 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -185,7 +185,6 @@ module Simplex.Chat.Store
startRcvInlineFT,
xftpAcceptRcvFT,
updateRcvFileStatus,
- updateRcvFileStatus',
createRcvFileChunk,
updatedRcvFileChunkStored,
deleteRcvFileChunks,
@@ -274,7 +273,6 @@ module Simplex.Chat.Store
where
import Control.Applicative ((<|>))
-import Control.Concurrent.STM (stateTVar)
import Control.Exception (Exception)
import qualified Control.Exception as E
import Control.Monad.Except
@@ -562,7 +560,7 @@ getUserByASndFileId db 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)
+ DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id JOIN rcv_files r ON r.file_id = f.file_id WHERE r.agent_rcv_file_id = ?") (Only aRcvFileId)
getUserByContactId :: DB.Connection -> ContactId -> ExceptT StoreError IO User
getUserByContactId db contactId =
@@ -2751,16 +2749,17 @@ createSndFileTransferXFTP db User {userId} contactOrGroup filePath FileInvitatio
createSndFTDescrXFTP :: DB.Connection -> User -> Maybe GroupMember -> Connection -> FileTransferMeta -> FileDescr -> IO ()
createSndFTDescrXFTP db User {userId} m Connection {connId} FileTransferMeta {fileId} FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
+ currentTs <- getCurrentTime
let fileStatus = FSNew
DB.execute
db
- "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete) VALUES (?,?,?,?)"
- (userId, fileDescrText, fileDescrPartNo, fileDescrComplete)
+ "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)"
+ (userId, fileDescrText, fileDescrPartNo, fileDescrComplete, currentTs, currentTs)
fileDescrId <- insertedRowId db
DB.execute
db
- "INSERT INTO snd_files (file_id, file_status, file_descr_id, group_member_id, connection_id) VALUES (?,?,?,?,?)"
- (fileId, fileStatus, fileDescrId, groupMemberId' <$> m, connId)
+ "INSERT INTO snd_files (file_id, file_status, file_descr_id, group_member_id, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
+ (fileId, fileStatus, fileDescrId, groupMemberId' <$> m, connId, currentTs, currentTs)
updateSndFTDescrXFTP :: DB.Connection -> User -> SndFileTransfer -> Text -> IO ()
updateSndFTDescrXFTP db user@User {userId} sft@SndFileTransfer {fileId, fileDescrId} rfdText = do
@@ -2937,7 +2936,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
"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)
insertedRowId db
- rfd <- mapM (createRcvFD_ db userId) fileDescr
+ rfd <- mapM (createRcvFD_ db userId currentTs) fileDescr
let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd
liftIO $
DB.execute
@@ -2955,7 +2954,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
"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)
insertedRowId db
- rfd <- mapM (createRcvFD_ db userId) fileDescr
+ rfd <- mapM (createRcvFD_ db userId currentTs) fileDescr
let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd
liftIO $
DB.execute
@@ -2964,14 +2963,14 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
(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 -> UserId -> FileDescr -> ExceptT StoreError IO RcvFileDescr
-createRcvFD_ db userId FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
+createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr
+createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
when (fileDescrPartNo /= 0) $ throwError SERcvFileInvalidDescrPart
fileDescrId <- liftIO $ do
DB.execute
db
- "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete) VALUES (?,?,?,?)"
- (userId, fileDescrText, fileDescrPartNo, fileDescrComplete)
+ "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)"
+ (userId, fileDescrText, fileDescrPartNo, fileDescrComplete, currentTs, currentTs)
insertedRowId db
pure RcvFileDescr {fileDescrId, fileDescrPartNo, fileDescrText, fileDescrComplete}
@@ -2980,7 +2979,7 @@ appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileD
currentTs <- liftIO getCurrentTime
liftIO (getRcvFileDescrByFileId_ db fileId) >>= \case
Nothing -> do
- rfd@RcvFileDescr {fileDescrId} <- createRcvFD_ db userId fd
+ rfd@RcvFileDescr {fileDescrId} <- createRcvFD_ db userId currentTs fd
liftIO $
DB.execute
db
@@ -3127,11 +3126,8 @@ acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do
"UPDATE rcv_files SET rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?"
(rcvFileInline, FSAccepted, currentTs, fileId)
-updateRcvFileStatus :: DB.Connection -> RcvFileTransfer -> FileStatus -> IO ()
-updateRcvFileStatus db RcvFileTransfer {fileId} = updateRcvFileStatus' db fileId
-
-updateRcvFileStatus' :: DB.Connection -> FileTransferId -> FileStatus -> IO ()
-updateRcvFileStatus' db fileId status = do
+updateRcvFileStatus :: DB.Connection -> FileTransferId -> FileStatus -> IO ()
+updateRcvFileStatus db fileId status = do
currentTs <- getCurrentTime
DB.execute db "UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?" (status, currentTs, fileId)
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 10f3851c3..6c475b24f 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -1500,7 +1500,7 @@ instance ToJSON FileDescr where
toJSON = J.genericToJSON J.defaultOptions
instance FromJSON FileDescr where
- parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "FD"
+ parseJSON = J.genericParseJSON J.defaultOptions
xftpFileInvitation :: FilePath -> Integer -> FileDescr -> FileInvitation
xftpFileInvitation fileName fileSize fileDescr =
diff --git a/stack.yaml b/stack.yaml
index 610e54e77..aa8d3d969 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -49,7 +49,7 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
- commit: db120b6d2eee04836a132f0bfbca9491cacf3dc8
+ commit: a0eb53b891b1f4f765f440020654fbae45bf8b00
- github: kazu-yamamoto/http2
commit: 78e18f52295a7f89e828539a03fbcb24931461a3
# - ../direct-sqlcipher
diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs
index b28f6c0d0..16335d628 100644
--- a/tests/ChatTests/Files.hs
+++ b/tests/ChatTests/Files.hs
@@ -8,7 +8,7 @@ import ChatTests.Utils
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
import qualified Data.ByteString.Char8 as B
-import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), defaultInlineFilesConfig)
+import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), XFTPFileConfig (..), defaultInlineFilesConfig)
import Simplex.Chat.Options (ChatOpts (..))
import Simplex.Messaging.Util (unlessM)
import System.Directory (copyFile, doesFileExist)
@@ -48,6 +48,8 @@ chatFileTests = do
it "v2" testAsyncFileTransfer
it "v1" testAsyncFileTransferV1
xit "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer
+ describe "file transfer over XFTP" $ do
+ it "send and receive file" testXFTPFileTransfer
runTestFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
runTestFileTransfer alice bob = do
@@ -915,6 +917,28 @@ testAsyncGroupFileTransfer tmp = do
dest2 <- B.readFile "./tests/tmp/test_1.jpg"
dest2 `shouldBe` src
+testXFTPFileTransfer :: HasCallStack => FilePath -> IO ()
+testXFTPFileTransfer =
+ testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
+ connectUsers alice bob
+
+ alice #> "/f @bob ./tests/fixtures/test.pdf"
+ alice <## "use /fc 1 to cancel sending"
+ bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
+ bob <## "use /fr 1 [/ | ] to receive it"
+ bob ##> "/fr 1 ./tests/tmp"
+ bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
+ -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
+ alice <## "completed sending file 1 (test.pdf) to bob"
+ bob <## "started receiving file 1 (test.pdf) from alice"
+ bob <## "completed receiving file 1 (test.pdf) from alice"
+
+ src <- B.readFile "./tests/fixtures/test.pdf"
+ dest <- B.readFile "./tests/tmp/test.pdf"
+ dest `shouldBe` src
+ where
+ cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
startFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
startFileTransfer alice bob =
startFileTransfer' alice bob "test.jpg" "136.5 KiB / 139737 bytes"
From 34a3387830e5c7569013e47fc315e89cd9ed30f4 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 16 Mar 2023 14:12:19 +0400
Subject: [PATCH 07/17] core: xftp servers option; use local xftp server in
tests (#2015)
---
src/Simplex/Chat.hs | 5 +++--
src/Simplex/Chat/Mobile.hs | 1 +
src/Simplex/Chat/Options.hs | 18 ++++++++++++++++-
tests/ChatClient.hs | 40 +++++++++++++++++++++++++++++++++++++
tests/ChatTests/Files.hs | 29 ++++++++++++++-------------
5 files changed, 76 insertions(+), 17 deletions(-)
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index ff05f4fed..51b0c5278 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -146,7 +146,7 @@ createChatDatabase filePrefix key yesToMigrations = do
pure ChatDatabase {chatStore, agentStore}
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController
-newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do
+newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do
let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
config = cfg {logLevel, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'}
sendNotification = fromMaybe (const $ pure ()) sendToast
@@ -178,7 +178,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
configServers :: DefaultAgentServers
configServers =
let smp' = fromMaybe (smp (defaultServers :: DefaultAgentServers)) (nonEmpty smpServers)
- in defaultServers {smp = smp', netCfg = networkConfig}
+ xftp' = fromMaybe (xftp (defaultServers :: DefaultAgentServers)) (nonEmpty xftpServers)
+ in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig}
agentServers :: ChatConfig -> IO InitialAgentServers
agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do
users <- withTransaction chatStore getUsers
diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs
index 172a0c179..d40df7cfe 100644
--- a/src/Simplex/Chat/Mobile.hs
+++ b/src/Simplex/Chat/Mobile.hs
@@ -130,6 +130,7 @@ mobileChatOpts dbFilePrefix dbKey =
{ dbFilePrefix,
dbKey,
smpServers = [],
+ xftpServers = [],
networkConfig = defaultNetworkConfig,
logLevel = CLLImportant,
logConnections = False,
diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs
index 8631e7a27..20053a806 100644
--- a/src/Simplex/Chat/Options.hs
+++ b/src/Simplex/Chat/Options.hs
@@ -25,7 +25,7 @@ import Simplex.Chat.Controller (ChatLogLevel (..), updateStr, versionNumber, ver
import Simplex.Messaging.Client (NetworkConfig (..), defaultNetworkConfig)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Protocol (SMPServerWithAuth)
+import Simplex.Messaging.Protocol (SMPServerWithAuth, XFTPServerWithAuth)
import Simplex.Messaging.Transport.Client (SocksProxy, defaultSocksProxy)
import System.FilePath (combine)
@@ -43,6 +43,7 @@ data CoreChatOpts = CoreChatOpts
{ dbFilePrefix :: String,
dbKey :: String,
smpServers :: [SMPServerWithAuth],
+ xftpServers :: [XFTPServerWithAuth],
networkConfig :: NetworkConfig,
logLevel :: ChatLogLevel,
logConnections :: Bool,
@@ -88,6 +89,14 @@ coreChatOptsP appDir defaultDbFileName = do
<> help "Semicolon-separated list of SMP server(s) to use (each server can have more than one hostname)"
<> value []
)
+ xftpServers <-
+ option
+ parseXFTPServers
+ ( long "xftp-server"
+ <> metavar "SERVER"
+ <> help "Semicolon-separated list of XFTP server(s) to use (each server can have more than one hostname)"
+ <> value []
+ )
socksProxy <-
flag' (Just defaultSocksProxy) (short 'x' <> help "Use local SOCKS5 proxy at :9050")
<|> option
@@ -156,6 +165,7 @@ coreChatOptsP appDir defaultDbFileName = do
{ dbFilePrefix,
dbKey,
smpServers,
+ xftpServers,
networkConfig = fullNetworkConfig socksProxy (useTcpTimeout socksProxy t) (logTLSErrors || logLevel == CLLDebug),
logLevel,
logConnections = logConnections || logLevel <= CLLInfo,
@@ -236,6 +246,9 @@ fullNetworkConfig socksProxy tcpTimeout logTLSErrors =
parseSMPServers :: ReadM [SMPServerWithAuth]
parseSMPServers = eitherReader $ parseAll smpServersP . B.pack
+parseXFTPServers :: ReadM [XFTPServerWithAuth]
+parseXFTPServers = eitherReader $ parseAll xftpServersP . B.pack
+
parseSocksProxy :: ReadM (Maybe SocksProxy)
parseSocksProxy = eitherReader $ parseAll strP . B.pack
@@ -248,6 +261,9 @@ serverPortP = Just . B.unpack <$> A.takeWhile A.isDigit
smpServersP :: A.Parser [SMPServerWithAuth]
smpServersP = strP `A.sepBy1` A.char ';'
+xftpServersP :: A.Parser [XFTPServerWithAuth]
+xftpServersP = strP `A.sepBy1` A.char ';'
+
parseLogLevel :: ReadM ChatLogLevel
parseLogLevel = eitherReader $ \case
"debug" -> Right CLLDebug
diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs
index b914dd2e3..3d782603a 100644
--- a/tests/ChatClient.hs
+++ b/tests/ChatClient.hs
@@ -26,6 +26,9 @@ import Simplex.Chat.Store
import Simplex.Chat.Terminal
import Simplex.Chat.Terminal.Output (newChatTerminal)
import Simplex.Chat.Types (AgentUserId (..), Profile, User (..))
+import Simplex.FileTransfer.Description (kb, mb)
+import Simplex.FileTransfer.Server (runXFTPServerBlocking)
+import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration)
import Simplex.Messaging.Agent.Env.SQLite
import Simplex.Messaging.Agent.RetryInterval
import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultNetworkConfig)
@@ -55,6 +58,7 @@ testOpts =
dbKey = "",
-- dbKey = "this is a pass-phrase to encrypt the database",
smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"],
+ xftpServers = ["xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7002"],
networkConfig = defaultNetworkConfig,
logLevel = CLLImportant,
logConnections = False,
@@ -305,6 +309,42 @@ serverCfg =
withSmpServer :: IO () -> IO ()
withSmpServer = serverBracket (`runSMPServerBlocking` serverCfg)
+xftpTestPort :: ServiceName
+xftpTestPort = "7002"
+
+xftpServerFiles :: FilePath
+xftpServerFiles = "tests/tmp/xftp-server-files"
+
+xftpServerConfig :: XFTPServerConfig
+xftpServerConfig =
+ XFTPServerConfig
+ { xftpPort = xftpTestPort,
+ fileIdSize = 16,
+ storeLogFile = Nothing,
+ filesPath = xftpServerFiles,
+ fileSizeQuota = Nothing,
+ allowedChunkSizes = [kb 128, kb 256, mb 1, mb 4],
+ allowNewFiles = True,
+ newFileBasicAuth = Nothing,
+ fileExpiration = Just defaultFileExpiration,
+ caCertificateFile = "tests/fixtures/tls/ca.crt",
+ privateKeyFile = "tests/fixtures/tls/server.key",
+ certificateFile = "tests/fixtures/tls/server.crt",
+ logStatsInterval = Nothing,
+ logStatsStartTime = 0,
+ serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log",
+ serverStatsBackupFile = Nothing,
+ logTLSErrors = True
+ }
+
+withXFTPServer :: IO () -> IO ()
+withXFTPServer =
+ serverBracket
+ ( \started -> do
+ createDirectoryIfMissing False xftpServerFiles
+ runXFTPServerBlocking started xftpServerConfig
+ )
+
serverBracket :: (TMVar Bool -> IO ()) -> IO () -> IO ()
serverBracket server f = do
started <- newEmptyTMVarIO
diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs
index 16335d628..396cd4839 100644
--- a/tests/ChatTests/Files.hs
+++ b/tests/ChatTests/Files.hs
@@ -920,22 +920,23 @@ testAsyncGroupFileTransfer tmp = do
testXFTPFileTransfer :: HasCallStack => FilePath -> IO ()
testXFTPFileTransfer =
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
- connectUsers alice bob
+ withXFTPServer $ do
+ connectUsers alice bob
- alice #> "/f @bob ./tests/fixtures/test.pdf"
- alice <## "use /fc 1 to cancel sending"
- bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
- bob <## "use /fr 1 [/ | ] to receive it"
- bob ##> "/fr 1 ./tests/tmp"
- bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
- -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
- alice <## "completed sending file 1 (test.pdf) to bob"
- bob <## "started receiving file 1 (test.pdf) from alice"
- bob <## "completed receiving file 1 (test.pdf) from alice"
+ alice #> "/f @bob ./tests/fixtures/test.pdf"
+ alice <## "use /fc 1 to cancel sending"
+ bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
+ bob <## "use /fr 1 [/ | ] to receive it"
+ bob ##> "/fr 1 ./tests/tmp"
+ bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
+ -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
+ alice <## "completed sending file 1 (test.pdf) to bob"
+ bob <## "started receiving file 1 (test.pdf) from alice"
+ bob <## "completed receiving file 1 (test.pdf) from alice"
- src <- B.readFile "./tests/fixtures/test.pdf"
- dest <- B.readFile "./tests/tmp/test.pdf"
- dest `shouldBe` src
+ src <- B.readFile "./tests/fixtures/test.pdf"
+ dest <- B.readFile "./tests/tmp/test.pdf"
+ dest `shouldBe` src
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
From f379fd0f8c7fd21f24cf533fcdfbaf2b0ccccbdb Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 16 Mar 2023 13:58:01 +0000
Subject: [PATCH 08/17] xftp: sending file completion status (#2016)
* xftp: sending file completion status
* fix type
* fix type 2
* fix
---
src/Simplex/Chat.hs | 16 +++++++++-------
1 file changed, 9 insertions(+), 7 deletions(-)
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 51b0c5278..e8c0790bc 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -2198,13 +2198,17 @@ processAgentMsgSndFile _corrId aFileId msg =
(Just sharedMsgId, Nothing) -> do
(ft, sfts) <- withStore $ \db -> getSndFileTransfer db user fileId
when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send"
+ -- TODO either update database status or move to SFPROG
toView $ CRSndFileProgressXFTP user ci ft 1 1
case (rfds, sfts, d, cInfo) of
- (rfd : _, sft : _, SMDSnd, DirectChat ct) ->
- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
+ (rfd : _, sft : _, SMDSnd, DirectChat ct) -> do
+ msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
+ withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
(_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
ms <- withStore' $ \db -> getGroupMembers db user g
forM_ (zip rfds $ memberFTs ms) $ \mt -> sendToMember mt `catchError` (toView . CRChatError (Just user))
+ -- TODO update database status and send event to view CRSndFileCompleteXFTP
+ pure ()
where
memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
@@ -2217,18 +2221,16 @@ processAgentMsgSndFile _corrId aFileId msg =
useMember _ = Nothing
sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
sendToMember (rfd, (conn, sft)) =
- sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
+ void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
_ -> pure ()
_ -> pure () -- TODO error?
where
- sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m ()
+ sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m Int64
sendFileDescription sft rfd msgId sendMsg = do
let rfdText = safeDecodeUtf8 $ strEncode rfd
withStore' $ \db -> updateSndFTDescrXFTP db user sft rfdText
partSize <- asks $ xftpDescrPartSize . config
- msgDeliveryId <- sendParts 1 partSize rfdText
- -- msgDeliveryId <- sendFileDescription_ rfd sharedMsgId sendMsg
- withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
+ sendParts 1 partSize rfdText
where
sendParts partNo partSize rfdText = do
let (part, rest) = T.splitAt partSize rfdText
From 60d6a47bdba5a024ffc6621c1f2a1e2da9c7736f Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 21 Mar 2023 15:21:14 +0400
Subject: [PATCH 09/17] xftp: delete agent rcv files on completion, error, item
delete (#2040)
---
cabal.project | 2 +-
scripts/nix/sha256map.nix | 2 +-
simplex-chat.cabal | 1 +
src/Simplex/Chat.hs | 69 ++++++++++++------
.../M20230321_agent_file_deleted.hs | 20 ++++++
src/Simplex/Chat/Migrations/chat_schema.sql | 6 +-
src/Simplex/Chat/Store.hs | 71 +++++++++++--------
src/Simplex/Chat/Types.hs | 28 ++++++--
stack.yaml | 2 +-
tests/Test.hs | 2 +-
10 files changed, 140 insertions(+), 63 deletions(-)
create mode 100644 src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs
diff --git a/cabal.project b/cabal.project
index 354d04277..b3943d990 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: 40da7e76ddd5694da386720f61a69d5a15812a81
+ tag: 7e265e5c59dedaabd0b77ce55d49e0bc6fa92f20
source-repository-package
type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 974347c1f..1bf57f9ba 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
{
- "https://github.com/simplex-chat/simplexmq.git"."40da7e76ddd5694da386720f61a69d5a15812a81" = "16lv8h18v96r71wil6d9lac93y1rchrzmqfxqbxya4jgmyl8m9bc";
+ "https://github.com/simplex-chat/simplexmq.git"."7e265e5c59dedaabd0b77ce55d49e0bc6fa92f20" = "162j0187kzwihg0pa91mwqavk93jdx5y5davl7fik8q6svvwqrpq";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/kazu-yamamoto/http2.git"."78e18f52295a7f89e828539a03fbcb24931461a3" = "05q165anvv0qrcxqbvq1dlvw0l8gmsa9kl6sazk1mfhz2g0yimdk";
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index f25ff03e6..782dfc74f 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -86,6 +86,7 @@ library
Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
Simplex.Chat.Migrations.M20230303_group_link_role
Simplex.Chat.Migrations.M20230304_file_description
+ Simplex.Chat.Migrations.M20230321_agent_file_deleted
Simplex.Chat.Mobile
Simplex.Chat.Mobile.WebRTC
Simplex.Chat.Options
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index d3044b267..7464c1f3a 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1761,21 +1761,21 @@ 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, rcvFileDescription, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId} rcvInline_ filePath_ = do
+acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, 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 (rcvFileDescription, fileConnReq) of
+ case (xftpRcvFile, fileConnReq) of
-- direct file protocol
(Nothing, Just connReq) -> do
connIds <- joinAgentConnectionAsync user True connReq . directMessage $ XFileAcpt fName
filePath <- getRcvFilePath fileId filePath_ fName True
withStore $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath
-- XFTP
- (Just rfd, _) -> do
+ (Just XFTPRcvFile {rcvFileDescription}, _) -> do
filePath <- getRcvFilePath fileId filePath_ fName False
ci <- withStore $ \db -> xftpAcceptRcvFT db user fileId filePath
- receiveViaCompleteFD user fileId filePath rfd
+ receiveViaCompleteFD user fileId rcvFileDescription
pure ci
-- group & direct file protocol
_ -> do
@@ -1818,12 +1818,12 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, rcvFileDescription
|| (rcvInline_ == Just True && fileSize <= fileChunkSize * offerChunks)
)
-receiveViaCompleteFD :: ChatMonad m => User -> FileTransferId -> FilePath -> RcvFileDescr -> m ()
-receiveViaCompleteFD user fileId filePath RcvFileDescr {fileDescrText, fileDescrComplete} =
+receiveViaCompleteFD :: ChatMonad m => User -> FileTransferId -> RcvFileDescr -> m ()
+receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} =
when fileDescrComplete $ do
rd <- parseRcvFileDescription fileDescrText
tmp <- readTVarIO =<< asks tempDirectory
- aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd tmp filePath
+ aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd tmp
startReceivingFile user fileId
withStore' $ \db -> updateRcvFileAgentId db fileId (AgentRcvFileId aFileId)
@@ -2185,7 +2185,7 @@ processAgentMsgSndFile _corrId aFileId msg =
where
process :: User -> m ()
process user = do
- fileId <- withStore $ \db -> getAgentSndFileIdXFTP db user $ AgentSndFileId aFileId
+ fileId <- withStore $ \db -> getXFTPSndFileDBId db user $ AgentSndFileId aFileId
case msg of
SFPROG _sent _total -> do
-- update chat item status
@@ -2249,23 +2249,29 @@ processAgentMsgRcvFile _corrId aFileId msg =
where
process :: User -> m ()
process user = do
- fileId <- withStore (`getAgentRcvFileIdXFTP` AgentRcvFileId aFileId)
+ fileId <- withStore (`getXFTPRcvFileDBId` AgentRcvFileId aFileId)
case msg of
RFPROG _sent _total -> do
-- update chat item status
-- send status to view
pure ()
- RFDONE -> do
- ci <- withStore $ \db -> do
- liftIO $ do
- updateRcvFileStatus db fileId FSComplete
- updateCIFileStatus db user fileId CIFSRcvComplete
- getChatItemByFileId db user fileId
- -- ack to agent
- toView $ CRRcvFileComplete user ci
+ RFDONE xftpPath -> do
+ ft <- withStore $ \db -> getRcvFileTransfer db user fileId
+ case liveRcvFileTransferPath ft of
+ Nothing -> throwChatError $ CEInternalError "no target path for received XFTP file"
+ Just targetPath -> do
+ renameFile xftpPath targetPath
+ ci <- withStore $ \db -> do
+ liftIO $ do
+ updateRcvFileStatus db fileId FSComplete
+ updateCIFileStatus db user fileId CIFSRcvComplete
+ getChatItemByFileId db user fileId
+ agentXFTPDeleteRcvFile user aFileId fileId
+ toView $ CRRcvFileComplete user ci
RFERR _e -> do
-- update chat item status
-- send status to view
+ agentXFTPDeleteRcvFile user aFileId fileId
pure ()
processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
@@ -2936,7 +2942,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ft <- getRcvFileTransfer db user fileId
pure (rfd, ft)
case fileStatus of
- RFSAccepted RcvFileInfo {filePath} -> receiveViaCompleteFD user fileId filePath rfd
+ RFSAccepted _ -> receiveViaCompleteFD user fileId rfd
_ -> pure ()
cancelMessageFile :: Contact -> SharedMsgId -> MsgMeta -> m ()
@@ -3719,7 +3725,7 @@ isFileActive fileId files = do
isJust . M.lookup fileId <$> readTVarIO fs
cancelRcvFileTransfer :: ChatMonad m => User -> RcvFileTransfer -> m (Maybe ConnId)
-cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, rcvFileInline} =
+cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInline} =
cancel' `catchError` (\e -> toView (CRChatError (Just user) e) $> fileConnId)
where
cancel' = do
@@ -3728,14 +3734,26 @@ cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, rcvFileInline} =
updateFileCancelled db user fileId CIFSRcvCancelled
updateRcvFileStatus db fileId FSCancelled
deleteRcvFileChunks db ft
+ case xftpRcvFile of
+ Just XFTPRcvFile {agentRcvFileId = Just (AgentRcvFileId aFileId), agentRcvFileDeleted} ->
+ unless agentRcvFileDeleted $ agentXFTPDeleteRcvFile user aFileId fileId
+ _ -> pure ()
pure fileConnId
- fileConnId = if isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing
+ fileConnId = if isNothing xftpRcvFile && isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing
cancelSndFile :: ChatMonad m => User -> FileTransferMeta -> [SndFileTransfer] -> Bool -> m [ConnId]
-cancelSndFile user FileTransferMeta {fileId} fts sendCancel = do
+cancelSndFile user FileTransferMeta {fileId, xftpSndFile} fts sendCancel = do
withStore' (\db -> updateFileCancelled db user fileId CIFSSndCancelled)
`catchError` (toView . CRChatError (Just user))
- catMaybes <$> forM fts (\ft -> cancelSndFileTransfer user ft sendCancel)
+ case xftpSndFile of
+ Nothing ->
+ catMaybes <$> forM fts (\ft -> cancelSndFileTransfer user ft sendCancel)
+ Just _patternAgentSndFileId -> do
+ forM_ fts (\ft -> cancelSndFileTransfer user ft False)
+ -- TODO unless agentSndFileDeleted, do agentXFTPDeleteSndFile:
+ -- TODO - with agent xftpDeleteSndFile
+ -- TODO - with store setSndFTAgentDeleted
+ pure []
cancelSndFileTransfer :: ChatMonad m => User -> SndFileTransfer -> Bool -> m (Maybe ConnId)
cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, agentConnId = AgentConnId acId, fileStatus, fileInline} sendCancel =
@@ -3753,7 +3771,7 @@ cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, age
void . sendDirectMessage conn (BFileChunk sharedMsgId FileChunkCancel) $ ConnectionId connId
_ -> withAgent $ \a -> void . sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunkCancel
pure fileConnId
- fileConnId = if isJust fileInline then Nothing else Just acId
+ fileConnId = if isNothing fileInline then Just acId else Nothing
closeFileHandle :: ChatMonad m => Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> m ()
closeFileHandle fileId files = do
@@ -3961,6 +3979,11 @@ deleteAgentConnectionsAsync _ [] = pure ()
deleteAgentConnectionsAsync user acIds =
withAgent (`deleteConnectionsAsync` acIds) `catchError` (toView . CRChatError (Just user))
+agentXFTPDeleteRcvFile :: ChatMonad m => User -> RcvFileId -> FileTransferId -> m ()
+agentXFTPDeleteRcvFile user aFileId fileId = do
+ withAgent $ \a -> xftpDeleteRcvFile a (aUserId user) aFileId
+ withStore' $ \db -> setRcvFTAgentDeleted db fileId
+
userProfileToSend :: User -> Maybe Profile -> Maybe Contact -> Profile
userProfileToSend user@User {profile = p} incognitoProfile ct =
let p' = fromMaybe (fromLocalProfile p) incognitoProfile
diff --git a/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs b/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs
new file mode 100644
index 000000000..15a08febf
--- /dev/null
+++ b/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20230321_agent_file_deleted where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230321_agent_file_deleted :: Query
+m20230321_agent_file_deleted =
+ [sql|
+PRAGMA ignore_check_constraints=ON;
+
+ALTER TABLE files ADD COLUMN agent_snd_file_deleted INTEGER DEFAULT 0 CHECK (agent_snd_file_deleted NOT NULL);
+UPDATE files SET agent_snd_file_deleted = 0;
+
+ALTER TABLE rcv_files ADD COLUMN agent_rcv_file_deleted INTEGER DEFAULT 0 CHECK (agent_rcv_file_deleted NOT NULL);
+UPDATE rcv_files SET agent_rcv_file_deleted = 0;
+
+PRAGMA ignore_check_constraints=OFF;
+|]
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index 1e36360b4..68ebe73e2 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -195,7 +195,8 @@ CREATE TABLE files(
ci_file_status TEXT,
file_inline TEXT,
agent_snd_file_id BLOB NULL,
- private_snd_file_descr TEXT NULL
+ private_snd_file_descr TEXT NULL,
+ agent_snd_file_deleted INTEGER DEFAULT 0 CHECK(agent_snd_file_deleted NOT NULL)
);
CREATE TABLE snd_files(
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
@@ -222,7 +223,8 @@ CREATE TABLE rcv_files(
file_inline TEXT,
file_descr_id INTEGER NULL
REFERENCES xftp_file_descriptions ON DELETE SET NULL,
- agent_rcv_file_id BLOB NULL
+ agent_rcv_file_id BLOB NULL,
+ agent_rcv_file_deleted INTEGER DEFAULT 0 CHECK(agent_rcv_file_deleted NOT NULL)
);
CREATE TABLE snd_file_chunks(
file_id INTEGER NOT NULL,
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index 492dc0ad1..be444e545 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -159,8 +159,8 @@ module Simplex.Chat.Store
createSndFTDescrXFTP,
updateSndFTDescrXFTP,
updateSndFTDeliveryXFTP,
- getAgentSndFileIdXFTP,
- getAgentRcvFileIdXFTP,
+ getXFTPSndFileDBId,
+ getXFTPRcvFileDBId,
updateFileCancelled,
updateCIFileStatus,
getSharedMsgIdByFileId,
@@ -184,6 +184,7 @@ module Simplex.Chat.Store
acceptRcvInlineFT,
startRcvInlineFT,
xftpAcceptRcvFT,
+ setRcvFTAgentDeleted,
updateRcvFileStatus,
createRcvFileChunk,
updatedRcvFileChunkStored,
@@ -357,6 +358,7 @@ 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.M20230321_agent_file_deleted
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Util (week)
@@ -424,7 +426,8 @@ schemaMigrations =
("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)
+ ("20230304_file_description", m20230304_file_description),
+ ("20230321_agent_file_deleted", m20230321_agent_file_deleted)
]
-- | The list of migrations in ascending order by date
@@ -2801,13 +2804,13 @@ updateSndFTDeliveryXFTP db SndFileTransfer {connId, fileId, fileDescrId} msgDeli
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE connection_id = ? AND file_id = ? AND file_descr_id = ?"
(msgDeliveryId, connId, fileId, fileDescrId)
-getAgentSndFileIdXFTP :: DB.Connection -> User -> AgentSndFileId -> ExceptT StoreError IO Int64
-getAgentSndFileIdXFTP db User {userId} aSndFileId =
+getXFTPSndFileDBId :: DB.Connection -> User -> AgentSndFileId -> ExceptT StoreError IO FileTransferId
+getXFTPSndFileDBId db User {userId} aSndFileId =
ExceptT . firstRow fromOnly (SESndFileNotFoundXFTP aSndFileId) $
DB.query db "SELECT file_id FROM files WHERE user_id = ? AND agent_snd_file_id = ?" (userId, aSndFileId)
-getAgentRcvFileIdXFTP :: DB.Connection -> AgentRcvFileId -> ExceptT StoreError IO FileTransferId
-getAgentRcvFileIdXFTP db aRcvFileId =
+getXFTPRcvFileDBId :: DB.Connection -> AgentRcvFileId -> ExceptT StoreError IO FileTransferId
+getXFTPRcvFileDBId db aRcvFileId =
ExceptT . firstRow fromOnly (SERcvFileNotFoundXFTP aRcvFileId) $
DB.query db "SELECT file_id FROM rcv_files WHERE agent_rcv_file_id = ?" (Only aRcvFileId)
@@ -2956,14 +2959,15 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
"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)
insertedRowId db
- rfd <- mapM (createRcvFD_ db userId currentTs) fileDescr
- let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd
+ rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
+ let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
+ xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
liftIO $
DB.execute
db
"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}
+ pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
@@ -2974,14 +2978,15 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
"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)
insertedRowId db
- rfd <- mapM (createRcvFD_ db userId currentTs) fileDescr
- let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd
+ rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
+ let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
+ xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
liftIO $
DB.execute
db
"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}
+ pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr
createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
@@ -3063,7 +3068,7 @@ getRcvFileTransfer db User {userId} fileId = do
[sql|
SELECT r.file_status, r.file_queue_info, r.group_member_id, f.file_name,
f.file_size, f.chunk_size, f.cancelled, cs.local_display_name, m.local_display_name,
- f.file_path, r.file_inline, r.rcv_file_inline, c.connection_id, c.agent_conn_id
+ f.file_path, r.file_inline, r.rcv_file_inline, r.agent_rcv_file_id, r.agent_rcv_file_deleted, c.connection_id, c.agent_conn_id
FROM rcv_files r
JOIN files f USING (file_id)
LEFT JOIN connections c ON r.file_id = c.rcv_file_id
@@ -3072,30 +3077,30 @@ getRcvFileTransfer db User {userId} fileId = do
WHERE f.user_id = ? AND f.file_id = ?
|]
(userId, fileId)
- rfd <- liftIO $ getRcvFileDescrByFileId_ db fileId
- rcvFileTransfer rfd rftRow
+ rfd_ <- liftIO $ getRcvFileDescrByFileId_ db fileId
+ rcvFileTransfer rfd_ rftRow
where
rcvFileTransfer ::
Maybe RcvFileDescr ->
- (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe InlineFileMode, Maybe InlineFileMode) :. (Maybe Int64, Maybe AgentConnId) ->
+ (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, Bool) :. (Maybe Int64, Maybe AgentConnId) ->
ExceptT StoreError IO RcvFileTransfer
- rcvFileTransfer rcvFileDescription ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileInline, rcvFileInline) :. (connId_, agentConnId_)) = do
- let fileInv = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
- fileInfo = (filePath_, connId_, agentConnId_)
+ rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileInline, rcvFileInline, agentRcvFileId, agentRcvFileDeleted) :. (connId_, agentConnId_)) =
case contactName_ <|> memberName_ of
Nothing -> throwError $ SERcvFileInvalid fileId
Just name -> do
case fileStatus' of
- FSNew -> pure $ ft name fileInv RFSNew
- FSAccepted -> ft name fileInv . RFSAccepted <$> rfi fileInfo
- FSConnected -> ft name fileInv . RFSConnected <$> rfi fileInfo
- FSComplete -> ft name fileInv . RFSComplete <$> rfi fileInfo
- FSCancelled -> ft name fileInv . RFSCancelled <$> rfi_ fileInfo
+ FSNew -> pure $ ft name RFSNew
+ FSAccepted -> ft name . RFSAccepted <$> rfi
+ FSConnected -> ft name . RFSConnected <$> rfi
+ FSComplete -> ft name . RFSComplete <$> rfi
+ FSCancelled -> ft name . RFSCancelled <$> rfi_
where
- ft senderDisplayName fileInvitation fileStatus =
- RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, rcvFileDescription, senderDisplayName, chunkSize, cancelled, grpMemberId}
- rfi fileInfo = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_ fileInfo
- rfi_ = \case
+ ft senderDisplayName fileStatus =
+ let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
+ xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted}) <$> rfd_
+ in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
+ rfi = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_
+ rfi_ = case (filePath_, connId_, agentConnId_) of
(Just filePath, connId, agentConnId) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
_ -> pure Nothing
cancelled = fromMaybe False cancelled_
@@ -3146,6 +3151,14 @@ acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do
"UPDATE rcv_files SET rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?"
(rcvFileInline, FSAccepted, currentTs, fileId)
+setRcvFTAgentDeleted :: DB.Connection -> FileTransferId -> IO ()
+setRcvFTAgentDeleted db fileId = do
+ currentTs <- getCurrentTime
+ DB.execute
+ db
+ "UPDATE rcv_files SET agent_rcv_file_deleted = 1, updated_at = ? WHERE file_id = ?"
+ (currentTs, fileId)
+
updateRcvFileStatus :: DB.Connection -> FileTransferId -> FileStatus -> IO ()
updateRcvFileStatus db fileId status = do
currentTs <- getCurrentTime
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 5140ca7f7..d0fc6acf1 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -1543,10 +1543,10 @@ instance ToJSON InlineFileMode where
data RcvFileTransfer = RcvFileTransfer
{ fileId :: FileTransferId,
+ xftpRcvFile :: Maybe XFTPRcvFile,
fileInvitation :: FileInvitation,
fileStatus :: RcvFileStatus,
rcvFileInline :: Maybe InlineFileMode,
- rcvFileDescription :: Maybe RcvFileDescr,
senderDisplayName :: ContactName,
chunkSize :: Integer,
cancelled :: Bool,
@@ -1556,6 +1556,15 @@ data RcvFileTransfer = RcvFileTransfer
instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
+data XFTPRcvFile = XFTPRcvFile
+ { rcvFileDescription :: RcvFileDescr,
+ agentRcvFileId :: Maybe AgentRcvFileId,
+ agentRcvFileDeleted :: Bool
+ }
+ deriving (Eq, Show, Generic)
+
+instance ToJSON XFTPRcvFile where toEncoding = J.genericToEncoding J.defaultOptions
+
data RcvFileDescr = RcvFileDescr
{ fileDescrId :: Int64,
fileDescrText :: Text,
@@ -1587,15 +1596,23 @@ data RcvFileInfo = RcvFileInfo
instance ToJSON RcvFileInfo where toEncoding = J.genericToEncoding J.defaultOptions
-liveRcvFileTransferConnId :: RcvFileTransfer -> Maybe ConnId
-liveRcvFileTransferConnId RcvFileTransfer {fileStatus} = case fileStatus of
- RFSAccepted fi -> acId fi
- RFSConnected fi -> acId fi
+liveRcvFileTransferInfo :: RcvFileTransfer -> Maybe RcvFileInfo
+liveRcvFileTransferInfo RcvFileTransfer {fileStatus} = case fileStatus of
+ RFSAccepted fi -> Just fi
+ RFSConnected fi -> Just fi
_ -> Nothing
+
+liveRcvFileTransferConnId :: RcvFileTransfer -> Maybe ConnId
+liveRcvFileTransferConnId ft = acId =<< liveRcvFileTransferInfo ft
where
acId RcvFileInfo {agentConnId = Just (AgentConnId cId)} = Just cId
acId _ = Nothing
+liveRcvFileTransferPath :: RcvFileTransfer -> Maybe FilePath
+liveRcvFileTransferPath ft = fp <$> liveRcvFileTransferInfo ft
+ where
+ fp RcvFileInfo {filePath} = filePath
+
newtype AgentConnId = AgentConnId ConnId
deriving (Eq, Show)
@@ -1689,6 +1706,7 @@ instance ToJSON FileTransferMeta where toEncoding = J.genericToEncoding J.defaul
data XFTPSndFile = XFTPSndFile
{ agentSndFileId :: AgentSndFileId,
privateSndFileDescr :: Maybe Text
+ -- TODO agentSndFileDeleted :: Bool
}
deriving (Eq, Show, Generic)
diff --git a/stack.yaml b/stack.yaml
index c4fbfa130..4bca20bc3 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -49,7 +49,7 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
- commit: 40da7e76ddd5694da386720f61a69d5a15812a81
+ commit: 7e265e5c59dedaabd0b77ce55d49e0bc6fa92f20
- github: kazu-yamamoto/http2
commit: 78e18f52295a7f89e828539a03fbcb24931461a3
# - ../direct-sqlcipher
diff --git a/tests/Test.hs b/tests/Test.hs
index 0cbf14796..4ea3e9ef5 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -25,7 +25,7 @@ main = do
testBracket test = do
t <- getSystemTime
let ts = show (systemSeconds t) <> show (systemNanoseconds t)
- withSmpServer $ withTmpFiles $ withTempDirectory "tests" ("tmp" <> ts) test
+ withSmpServer $ withTmpFiles $ withTempDirectory "tests/tmp" ts test
logCfg :: LogConfig
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
From 47c6daf0cc1f29da45fa066fa411f34eedb545d4 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Wed, 22 Mar 2023 18:48:38 +0400
Subject: [PATCH 10/17] xftp: set app tmp directory (#2054)
---
cabal.project | 2 +-
scripts/nix/sha256map.nix | 2 +-
src/Simplex/Chat.hs | 26 ++++++++----
src/Simplex/Chat/Controller.hs | 1 +
stack.yaml | 2 +-
tests/ChatClient.hs | 2 +-
tests/ChatTests/Files.hs | 74 ++++++++++++++++++++++++++++++++++
7 files changed, 98 insertions(+), 11 deletions(-)
diff --git a/cabal.project b/cabal.project
index b3943d990..332ebdc79 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: 7e265e5c59dedaabd0b77ce55d49e0bc6fa92f20
+ tag: 0df7733125add475f9de88a362bcd526091f187c
source-repository-package
type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 1bf57f9ba..fab104c40 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
{
- "https://github.com/simplex-chat/simplexmq.git"."7e265e5c59dedaabd0b77ce55d49e0bc6fa92f20" = "162j0187kzwihg0pa91mwqavk93jdx5y5davl7fik8q6svvwqrpq";
+ "https://github.com/simplex-chat/simplexmq.git"."0df7733125add475f9de88a362bcd526091f187c" = "09s2dimdq88lm4mb2xcl5vch2qb21llj8ss649vlxpkm69njpyj0";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/kazu-yamamoto/http2.git"."78e18f52295a7f89e828539a03fbcb24931461a3" = "05q165anvv0qrcxqbvq1dlvw0l8gmsa9kl6sazk1mfhz2g0yimdk";
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 7464c1f3a..d7963c287 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -78,7 +78,7 @@ import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport.Client (defaultSocksProxy)
import Simplex.Messaging.Util
import System.Exit (exitFailure, exitSuccess)
-import System.FilePath (combine, splitExtensions, takeFileName)
+import System.FilePath (combine, splitExtensions, takeFileName, ())
import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
import Text.Read (readMaybe)
import UnliftIO.Async
@@ -219,9 +219,15 @@ startChatController subConns enableExpireCIs = do
then Just <$> async (subscribeUsers users)
else pure Nothing
atomically . writeTVar s $ Just (a1, a2)
+ startXFTP
startCleanupManager
when enableExpireCIs $ startExpireCIs users
pure a1
+ startXFTP = do
+ tmp <- readTVarIO =<< asks tempDirectory
+ runExceptT (withAgent $ \a -> xftpStartWorkers a tmp) >>= \case
+ Left e -> liftIO $ print $ "Error starting XFTP workers: " <> show e
+ Right _ -> pure ()
startCleanupManager = do
cleanupAsync <- asks cleanupManagerAsync
readTVarIO cleanupAsync >>= \case
@@ -355,6 +361,11 @@ processChatCommand = \case
withAgent (`suspendAgent` t)
ok_
ResubscribeAllConnections -> withStore' getUsers >>= subscribeUsers >> ok_
+ -- has to be called before StartChat
+ SetTempFolder tf -> do
+ createDirectoryIfMissing True tf
+ asks tempDirectory >>= atomically . (`writeTVar` Just tf)
+ ok_
SetFilesFolder ff -> do
createDirectoryIfMissing True ff
asks filesFolder >>= atomically . (`writeTVar` Just ff)
@@ -535,8 +546,8 @@ processChatCommand = \case
let fileName = takeFileName file
fileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
fInv = xftpFileInvitation fileName fileSize fileDescr
- tmp <- readTVarIO =<< asks tempDirectory
- aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) file n tmp
+ fsFilePath <- toFSFilePath file
+ aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) fsFilePath n
-- TODO CRSndFileStart event for XFTP
ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv $ AgentSndFileId aFileId
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
@@ -1758,7 +1769,7 @@ callStatusItemContent user Contact {contactId} chatItemId receivedStatus = do
-- used during file transfer for actual operations with file system
toFSFilePath :: ChatMonad m => FilePath -> m FilePath
toFSFilePath f =
- maybe f (<> "/" <> f) <$> (readTVarIO =<< asks filesFolder)
+ 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, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId} rcvInline_ filePath_ = do
@@ -1822,8 +1833,7 @@ receiveViaCompleteFD :: ChatMonad m => User -> FileTransferId -> RcvFileDescr ->
receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} =
when fileDescrComplete $ do
rd <- parseRcvFileDescription fileDescrText
- tmp <- readTVarIO =<< asks tempDirectory
- aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd tmp
+ aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd
startReceivingFile user fileId
withStore' $ \db -> updateRcvFileAgentId db fileId (AgentRcvFileId aFileId)
@@ -2260,7 +2270,8 @@ processAgentMsgRcvFile _corrId aFileId msg =
case liveRcvFileTransferPath ft of
Nothing -> throwChatError $ CEInternalError "no target path for received XFTP file"
Just targetPath -> do
- renameFile xftpPath targetPath
+ fsTargetPath <- toFSFilePath targetPath
+ renameFile xftpPath fsTargetPath
ci <- withStore $ \db -> do
liftIO $ do
updateRcvFileStatus db fileId FSComplete
@@ -4202,6 +4213,7 @@ chatCommandP =
"/_app activate" $> APIActivateChat,
"/_app suspend " *> (APISuspendChat <$> A.decimal),
"/_resubscribe all" $> ResubscribeAllConnections,
+ "/_temp_folder " *> (SetTempFolder <$> filePath),
"/_files_folder " *> (SetFilesFolder <$> filePath),
"/_db export " *> (APIExportArchive <$> jsonP),
"/_db import " *> (APIImportArchive <$> jsonP),
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 0cb8f8441..a4c77ca88 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -196,6 +196,7 @@ data ChatCommand
| APIActivateChat
| APISuspendChat {suspendTimeout :: Int}
| ResubscribeAllConnections
+ | SetTempFolder FilePath
| SetFilesFolder FilePath
| SetIncognito Bool
| APIExportArchive ArchiveConfig
diff --git a/stack.yaml b/stack.yaml
index 4bca20bc3..6e935ec9f 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -49,7 +49,7 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
- commit: 7e265e5c59dedaabd0b77ce55d49e0bc6fa92f20
+ commit: 0df7733125add475f9de88a362bcd526091f187c
- github: kazu-yamamoto/http2
commit: 78e18f52295a7f89e828539a03fbcb24931461a3
# - ../direct-sqlcipher
diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs
index 3d782603a..c0107c6f7 100644
--- a/tests/ChatClient.hs
+++ b/tests/ChatClient.hs
@@ -320,7 +320,7 @@ xftpServerConfig =
XFTPServerConfig
{ xftpPort = xftpTestPort,
fileIdSize = 16,
- storeLogFile = Nothing,
+ storeLogFile = Just "tests/tmp/xftp-server-store.log",
filesPath = xftpServerFiles,
fileSizeQuota = Nothing,
allowedChunkSizes = [kb 128, kb 256, mb 1, mb 4],
diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs
index 396cd4839..8b776fec2 100644
--- a/tests/ChatTests/Files.hs
+++ b/tests/ChatTests/Files.hs
@@ -50,6 +50,8 @@ chatFileTests = do
xit "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer
describe "file transfer over XFTP" $ do
it "send and receive file" testXFTPFileTransfer
+ it "with relative paths: send and receive file" testXFTPWithRelativePaths
+ it "continue receiving file after restart" testXFTPContinueRcv
runTestFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
runTestFileTransfer alice bob = do
@@ -940,6 +942,78 @@ testXFTPFileTransfer =
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+testXFTPWithRelativePaths :: HasCallStack => FilePath -> IO ()
+testXFTPWithRelativePaths =
+ testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
+ withXFTPServer $ do
+ -- agent is passed xftp work directory only on chat start,
+ -- so for test we work around by stopping and starting chat
+ alice ##> "/_stop"
+ alice <## "chat stopped"
+ alice #$> ("/_files_folder ./tests/fixtures", id, "ok")
+ alice #$> ("/_temp_folder ./tests/tmp/alice_xftp", id, "ok")
+ alice ##> "/_start"
+ alice <## "chat started"
+
+ bob ##> "/_stop"
+ bob <## "chat stopped"
+ bob #$> ("/_files_folder ./tests/tmp/bob_files", id, "ok")
+ bob #$> ("/_temp_folder ./tests/tmp/bob_xftp", id, "ok")
+ bob ##> "/_start"
+ bob <## "chat started"
+
+ connectUsers alice bob
+
+ alice #> "/f @bob test.pdf"
+ alice <## "use /fc 1 to cancel sending"
+ bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
+ bob <## "use /fr 1 [/ | ] to receive it"
+ bob ##> "/fr 1"
+ bob <## "saving file 1 from alice to test.pdf"
+ -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
+ alice <## "completed sending file 1 (test.pdf) to bob"
+ bob <## "started receiving file 1 (test.pdf) from alice"
+ bob <## "completed receiving file 1 (test.pdf) from alice"
+
+ src <- B.readFile "./tests/fixtures/test.pdf"
+ dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
+ dest `shouldBe` src
+ where
+ cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}}
+
+testXFTPContinueRcv :: HasCallStack => FilePath -> IO ()
+testXFTPContinueRcv tmp = do
+ withXFTPServer $ do
+ withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
+ withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
+ connectUsers alice bob
+
+ alice #> "/f @bob ./tests/fixtures/test.pdf"
+ alice <## "use /fc 1 to cancel sending"
+ bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
+ bob <## "use /fr 1 [/ | ] to receive it"
+ -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
+ alice <## "completed sending file 1 (test.pdf) to bob"
+
+ -- server is down - file is not received
+ withTestChatCfg tmp cfg "bob" $ \bob -> do
+ bob <## "1 contacts connected (use /cs for the list)"
+ bob ##> "/fr 1 ./tests/tmp"
+ bob <## "started receiving file 1 (test.pdf) from alice"
+ bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
+ (bob do
+ bob <## "1 contacts connected (use /cs for the list)"
+ bob <## "completed receiving file 1 (test.pdf) from alice"
+ src <- B.readFile "./tests/fixtures/test.pdf"
+ dest <- B.readFile "./tests/tmp/test.pdf"
+ dest `shouldBe` src
+ where
+ cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
startFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
startFileTransfer alice bob =
startFileTransfer' alice bob "test.jpg" "136.5 KiB / 139737 bytes"
From 2a9c138a23b3eb0adcf6a235816cdda8e689c293 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Wed, 22 Mar 2023 22:20:12 +0400
Subject: [PATCH 11/17] xftp: set xftp config (#2059)
---
src/Simplex/Chat.hs | 18 +++++++++++++++++-
src/Simplex/Chat/Controller.hs | 1 +
tests/ChatTests/Files.hs | 30 ++++++++++++++++++++++++++++++
3 files changed, 48 insertions(+), 1 deletion(-)
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index d7963c287..d58b0a4bd 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -59,7 +59,7 @@ import Simplex.Chat.Store
import Simplex.Chat.Types
import Simplex.Chat.Util (diffInMicros, diffInSeconds)
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
-import Simplex.FileTransfer.Description (ValidFileDescription)
+import Simplex.FileTransfer.Description (ValidFileDescription, gb, kb, mb)
import Simplex.FileTransfer.Protocol (FileParty (..))
import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Client (AgentStatsKey (..))
@@ -370,6 +370,9 @@ processChatCommand = \case
createDirectoryIfMissing True ff
asks filesFolder >>= atomically . (`writeTVar` Just ff)
ok_
+ APISetXFTPConfig cfg -> do
+ asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
+ ok_
SetIncognito onOff -> do
asks incognitoMode >>= atomically . (`writeTVar` onOff)
ok_
@@ -4215,6 +4218,8 @@ chatCommandP =
"/_resubscribe all" $> ResubscribeAllConnections,
"/_temp_folder " *> (SetTempFolder <$> filePath),
"/_files_folder " *> (SetFilesFolder <$> filePath),
+ "/_xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> jsonP) <|> ("off" $> Nothing))),
+ "/xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> xftpCfgP) <|> ("off" $> Nothing))),
"/_db export " *> (APIExportArchive <$> jsonP),
"/_db import " *> (APIImportArchive <$> jsonP),
"/_db delete" $> APIDeleteStorage,
@@ -4474,6 +4479,17 @@ chatCommandP =
logErrors <- " log=" *> onOffP <|> pure False
let tcpTimeout = 1000000 * fromMaybe (maybe 5 (const 10) socksProxy) t_
pure $ fullNetworkConfig socksProxy tcpTimeout logErrors
+ xftpCfgP = do
+ minFileSize <- "minFileSize=" *> fileSizeP
+ pure $ XFTPFileConfig {minFileSize}
+ -- TODO move to Utils in simplexmq
+ fileSizeP =
+ A.choice
+ [ gb <$> A.decimal <* "gb",
+ mb <$> A.decimal <* "mb",
+ kb <$> A.decimal <* "kb",
+ A.decimal
+ ]
dbKeyP = nonEmptyKey <$?> strP
nonEmptyKey k@(DBEncryptionKey s) = if null s then Left "empty key" else Right k
autoAcceptP =
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index a4c77ca88..c1192dfe5 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -198,6 +198,7 @@ data ChatCommand
| ResubscribeAllConnections
| SetTempFolder FilePath
| SetFilesFolder FilePath
+ | APISetXFTPConfig (Maybe XFTPFileConfig)
| SetIncognito Bool
| APIExportArchive ArchiveConfig
| APIImportArchive ArchiveConfig
diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs
index 8b776fec2..2f2d93744 100644
--- a/tests/ChatTests/Files.hs
+++ b/tests/ChatTests/Files.hs
@@ -50,6 +50,7 @@ chatFileTests = do
xit "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer
describe "file transfer over XFTP" $ do
it "send and receive file" testXFTPFileTransfer
+ it "with changed XFTP config: send and receive file" testXFTPWithChangedConfig
it "with relative paths: send and receive file" testXFTPWithRelativePaths
it "continue receiving file after restart" testXFTPContinueRcv
@@ -942,6 +943,35 @@ testXFTPFileTransfer =
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+testXFTPWithChangedConfig :: HasCallStack => FilePath -> IO ()
+testXFTPWithChangedConfig =
+ testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
+ withXFTPServer $ do
+ alice #$> ("/_xftp off", id, "ok")
+ alice #$> ("/_xftp on {\"minFileSize\":1024}", id, "ok")
+
+ bob #$> ("/xftp off", id, "ok")
+ bob #$> ("/xftp on minFileSize=1kb", id, "ok")
+
+ connectUsers alice bob
+
+ alice #> "/f @bob ./tests/fixtures/test.pdf"
+ alice <## "use /fc 1 to cancel sending"
+ bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
+ bob <## "use /fr 1 [/ | ] to receive it"
+ bob ##> "/fr 1 ./tests/tmp"
+ bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
+ -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
+ alice <## "completed sending file 1 (test.pdf) to bob"
+ bob <## "started receiving file 1 (test.pdf) from alice"
+ bob <## "completed receiving file 1 (test.pdf) from alice"
+
+ src <- B.readFile "./tests/fixtures/test.pdf"
+ dest <- B.readFile "./tests/tmp/test.pdf"
+ dest `shouldBe` src
+ where
+ cfg = testCfg {tempDir = Just "./tests/tmp"}
+
testXFTPWithRelativePaths :: HasCallStack => FilePath -> IO ()
testXFTPWithRelativePaths =
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
From 8d6fe2be99d22766ae98e883835e9ebd0496bfcf Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 23 Mar 2023 17:29:04 +0400
Subject: [PATCH 12/17] core: restore stateTVar imports
---
src/Simplex/Chat.hs | 2 +-
src/Simplex/Chat/Store.hs | 1 +
2 files changed, 2 insertions(+), 1 deletion(-)
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 392e260e7..a07979fab 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -15,7 +15,7 @@
module Simplex.Chat where
import Control.Applicative (optional, (<|>))
-import Control.Concurrent.STM (retry)
+import Control.Concurrent.STM (retry, stateTVar)
import Control.Logger.Simple
import Control.Monad.Except
import Control.Monad.IO.Unlift
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index b443fa36e..d9f01985b 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -275,6 +275,7 @@ module Simplex.Chat.Store
where
import Control.Applicative ((<|>))
+import Control.Concurrent.STM (stateTVar)
import Control.Exception (Exception)
import qualified Control.Exception as E
import Control.Monad.Except
From aeb732c2f6feb2c8336db851fbed5735f5832872 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Fri, 24 Mar 2023 15:20:15 +0400
Subject: [PATCH 13/17] ios: support XFTP files (#2064)
---
apps/ios/Shared/Model/SimpleXAPI.swift | 14 ++++++++
.../Views/Chat/ChatItem/CIFileView.swift | 25 +++++++++++---
.../Views/Chat/ChatItem/CIVoiceView.swift | 2 +-
.../Chat/ChatItem/FramedCIVoiceView.swift | 2 +-
.../ExperimentalFeaturesView.swift | 14 ++++++--
.../Views/UserSettings/SettingsView.swift | 12 +++----
.../ios/SimpleX NSE/NotificationService.swift | 17 +++++++++-
apps/ios/SimpleXChat/APITypes.swift | 14 ++++++++
apps/ios/SimpleXChat/AppGroup.swift | 11 +++++-
apps/ios/SimpleXChat/ChatTypes.swift | 34 +++++++++++++------
apps/ios/SimpleXChat/FileUtils.swift | 7 +++-
11 files changed, 124 insertions(+), 28 deletions(-)
diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift
index d5ad40b85..9c23b01cf 100644
--- a/apps/ios/Shared/Model/SimpleXAPI.swift
+++ b/apps/ios/Shared/Model/SimpleXAPI.swift
@@ -215,12 +215,24 @@ func apiSuspendChat(timeoutMicroseconds: Int) {
logger.error("apiSuspendChat error: \(String(describing: r))")
}
+func apiSetTempFolder(tempFolder: String) throws {
+ let r = chatSendCmdSync(.setTempFolder(tempFolder: tempFolder))
+ if case .cmdOk = r { return }
+ throw r
+}
+
func apiSetFilesFolder(filesFolder: String) throws {
let r = chatSendCmdSync(.setFilesFolder(filesFolder: filesFolder))
if case .cmdOk = r { return }
throw r
}
+func setXFTPConfig(_ cfg: XFTPFileConfig?) throws {
+ let r = chatSendCmdSync(.apiSetXFTPConfig(config: cfg))
+ if case .cmdOk = r { return }
+ throw r
+}
+
func apiSetIncognito(incognito: Bool) throws {
let r = chatSendCmdSync(.setIncognito(incognito: incognito))
if case .cmdOk = r { return }
@@ -992,7 +1004,9 @@ func initializeChat(start: Bool, dbKey: String? = nil, refreshInvitations: Bool
if encryptionStartedDefault.get() {
encryptionStartedDefault.set(false)
}
+ try apiSetTempFolder(tempFolder: getTempFilesDirectory().path)
try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path)
+ try setXFTPConfig(getXFTPCfg())
try apiSetIncognito(incognito: incognitoGroupDefault.get())
m.chatInitialized = true
m.currentUser = try apiGetActiveUser()
diff --git a/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift b/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift
index 3f04253e5..08170f825 100644
--- a/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift
+++ b/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift
@@ -16,8 +16,8 @@ struct CIFileView: View {
var body: some View {
let metaReserve = edited
- ? " "
- : " "
+ ? " "
+ : " "
Button(action: fileAction) {
HStack(alignment: .bottom, spacing: 6) {
fileIndicator()
@@ -45,7 +45,24 @@ struct CIFileView: View {
.padding(.leading, 10)
.padding(.trailing, 12)
}
- .disabled(file == nil || (file?.fileStatus != .rcvInvitation && file?.fileStatus != .rcvAccepted && file?.fileStatus != .rcvComplete))
+ .disabled(!itemInteractive)
+ }
+
+ var itemInteractive: Bool {
+ if let file = file {
+ switch (file.fileStatus) {
+ case .sndStored: return false
+ case .sndTransfer: return false
+ case .sndComplete: return false
+ case .sndCancelled: return false
+ case .rcvInvitation: return true
+ case .rcvAccepted: return true
+ case .rcvTransfer: return false
+ case .rcvComplete: return true
+ case .rcvCancelled: return false
+ }
+ }
+ return false
}
func fileSizeValid() -> Bool {
@@ -155,7 +172,7 @@ struct CIFileView_Previews: PreviewProvider {
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(), revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileName: "some_long_file_name_here", fileStatus: .rcvInvitation), revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileStatus: .rcvAccepted), revealed: Binding.constant(false))
- ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileStatus: .rcvTransfer), revealed: Binding.constant(false))
+ ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileStatus: .rcvTransfer(rcvProgress: 7, rcvTotal: 10)), revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileStatus: .rcvCancelled), revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileSize: 1_000_000_000, fileStatus: .rcvInvitation), revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(text: "Hello there", fileStatus: .rcvInvitation), revealed: Binding.constant(false))
diff --git a/apps/ios/Shared/Views/Chat/ChatItem/CIVoiceView.swift b/apps/ios/Shared/Views/Chat/ChatItem/CIVoiceView.swift
index e17968b7e..111643e6a 100644
--- a/apps/ios/Shared/Views/Chat/ChatItem/CIVoiceView.swift
+++ b/apps/ios/Shared/Views/Chat/ChatItem/CIVoiceView.swift
@@ -243,7 +243,7 @@ struct CIVoiceView_Previews: PreviewProvider {
)
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: sentVoiceMessage, revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(), revealed: Binding.constant(false))
- ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(fileStatus: .rcvTransfer), revealed: Binding.constant(false))
+ ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(fileStatus: .rcvTransfer(rcvProgress: 7, rcvTotal: 10)), revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: voiceMessageWtFile, revealed: Binding.constant(false))
}
.previewLayout(.fixed(width: 360, height: 360))
diff --git a/apps/ios/Shared/Views/Chat/ChatItem/FramedCIVoiceView.swift b/apps/ios/Shared/Views/Chat/ChatItem/FramedCIVoiceView.swift
index 5d25a489a..34c3ecb4a 100644
--- a/apps/ios/Shared/Views/Chat/ChatItem/FramedCIVoiceView.swift
+++ b/apps/ios/Shared/Views/Chat/ChatItem/FramedCIVoiceView.swift
@@ -62,7 +62,7 @@ struct FramedCIVoiceView_Previews: PreviewProvider {
Group {
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: sentVoiceMessage, revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(text: "Hello there"), revealed: Binding.constant(false))
- ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(text: "Hello there", fileStatus: .rcvTransfer), revealed: Binding.constant(false))
+ ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(text: "Hello there", fileStatus: .rcvTransfer(rcvProgress: 7, rcvTotal: 10)), revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(text: "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."), revealed: Binding.constant(false))
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: voiceMessageWithQuote, revealed: Binding.constant(false))
}
diff --git a/apps/ios/Shared/Views/UserSettings/ExperimentalFeaturesView.swift b/apps/ios/Shared/Views/UserSettings/ExperimentalFeaturesView.swift
index 0fa754ec2..fa8be9f06 100644
--- a/apps/ios/Shared/Views/UserSettings/ExperimentalFeaturesView.swift
+++ b/apps/ios/Shared/Views/UserSettings/ExperimentalFeaturesView.swift
@@ -7,15 +7,23 @@
//
import SwiftUI
+import SimpleXChat
struct ExperimentalFeaturesView: View {
- @AppStorage(DEFAULT_EXPERIMENTAL_CALLS) private var enableCalls = false
+ @AppStorage(GROUP_DEFAULT_XFTP_SEND_ENABLED, store: UserDefaults(suiteName: APP_GROUP_NAME)!) private var xftpSendEnabled = false
var body: some View {
List {
Section("") {
- settingsRow("video") {
- Toggle("Audio & video calls", isOn: $enableCalls)
+ settingsRow("arrow.up.doc") {
+ Toggle("Send files via XFTP", isOn: $xftpSendEnabled)
+ .onChange(of: xftpSendEnabled) { _ in
+ do {
+ try setXFTPConfig(getXFTPCfg())
+ } catch {
+ logger.error("setXFTPConfig: cannot set XFTP config \(responseError(error))")
+ }
+ }
}
}
}
diff --git a/apps/ios/Shared/Views/UserSettings/SettingsView.swift b/apps/ios/Shared/Views/UserSettings/SettingsView.swift
index cb58d2fea..7d5f0115d 100644
--- a/apps/ios/Shared/Views/UserSettings/SettingsView.swift
+++ b/apps/ios/Shared/Views/UserSettings/SettingsView.swift
@@ -277,12 +277,12 @@ struct SettingsView: View {
.padding(.leading, indent)
}
}
-// NavigationLink {
-// ExperimentalFeaturesView()
-// .navigationTitle("Experimental features")
-// } label: {
-// settingsRow("gauge") { Text("Experimental features") }
-// }
+ NavigationLink {
+ ExperimentalFeaturesView()
+ .navigationTitle("Experimental features")
+ } label: {
+ settingsRow("gauge") { Text("Experimental features") }
+ }
NavigationLink {
VersionView()
.navigationBarTitle("App version")
diff --git a/apps/ios/SimpleX NSE/NotificationService.swift b/apps/ios/SimpleX NSE/NotificationService.swift
index 5eda201f2..3740ba464 100644
--- a/apps/ios/SimpleX NSE/NotificationService.swift
+++ b/apps/ios/SimpleX NSE/NotificationService.swift
@@ -199,6 +199,7 @@ class NotificationService: UNNotificationServiceExtension {
var chatStarted = false
var networkConfig: NetCfg = getNetCfg()
+var xftpConfig: XFTPFileConfig? = getXFTPCfg()
func startChat() -> DBMigrationResult? {
hs_init(0, nil)
@@ -212,10 +213,12 @@ func startChat() -> DBMigrationResult? {
logger.debug("active user \(String(describing: user))")
do {
try setNetworkConfig(networkConfig)
+ try apiSetTempFolder(tempFolder: getTempFilesDirectory().path)
+ try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path)
+ try setXFTPConfig(xftpConfig)
let justStarted = try apiStartChat()
chatStarted = true
if justStarted {
- try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path)
try apiSetIncognito(incognito: incognitoGroupDefault.get())
chatLastStartGroupDefault.set(Date.now)
Task { await receiveMessages() }
@@ -329,12 +332,24 @@ func apiStartChat() throws -> Bool {
}
}
+func apiSetTempFolder(tempFolder: String) throws {
+ let r = sendSimpleXCmd(.setTempFolder(tempFolder: tempFolder))
+ if case .cmdOk = r { return }
+ throw r
+}
+
func apiSetFilesFolder(filesFolder: String) throws {
let r = sendSimpleXCmd(.setFilesFolder(filesFolder: filesFolder))
if case .cmdOk = r { return }
throw r
}
+func setXFTPConfig(_ cfg: XFTPFileConfig?) throws {
+ let r = sendSimpleXCmd(.apiSetXFTPConfig(config: cfg))
+ if case .cmdOk = r { return }
+ throw r
+}
+
func apiSetIncognito(incognito: Bool) throws {
let r = sendSimpleXCmd(.setIncognito(incognito: incognito))
if case .cmdOk = r { return }
diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift
index ededd5b26..defc069a7 100644
--- a/apps/ios/SimpleXChat/APITypes.swift
+++ b/apps/ios/SimpleXChat/APITypes.swift
@@ -26,7 +26,9 @@ public enum ChatCommand {
case apiStopChat
case apiActivateChat
case apiSuspendChat(timeoutMicroseconds: Int)
+ case setTempFolder(tempFolder: String)
case setFilesFolder(filesFolder: String)
+ case apiSetXFTPConfig(config: XFTPFileConfig?)
case setIncognito(incognito: Bool)
case apiExportArchive(config: ArchiveConfig)
case apiImportArchive(config: ArchiveConfig)
@@ -117,7 +119,13 @@ public enum ChatCommand {
case .apiStopChat: return "/_stop"
case .apiActivateChat: return "/_app activate"
case let .apiSuspendChat(timeoutMicroseconds): return "/_app suspend \(timeoutMicroseconds)"
+ case let .setTempFolder(tempFolder): return "/_temp_folder \(tempFolder)"
case let .setFilesFolder(filesFolder): return "/_files_folder \(filesFolder)"
+ case let .apiSetXFTPConfig(cfg): if let cfg = cfg {
+ return "/_xftp on \(encodeJSON(cfg))"
+ } else {
+ return "/_xftp off"
+ }
case let .setIncognito(incognito): return "/incognito \(onOff(incognito))"
case let .apiExportArchive(cfg): return "/_db export \(encodeJSON(cfg))"
case let .apiImportArchive(cfg): return "/_db import \(encodeJSON(cfg))"
@@ -219,7 +227,9 @@ public enum ChatCommand {
case .apiStopChat: return "apiStopChat"
case .apiActivateChat: return "apiActivateChat"
case .apiSuspendChat: return "apiSuspendChat"
+ case .setTempFolder: return "setTempFolder"
case .setFilesFolder: return "setFilesFolder"
+ case .apiSetXFTPConfig: return "apiSetXFTPConfig"
case .setIncognito: return "setIncognito"
case .apiExportArchive: return "apiExportArchive"
case .apiImportArchive: return "apiImportArchive"
@@ -712,6 +722,10 @@ struct ComposedMessage: Encodable {
var msgContent: MsgContent
}
+public struct XFTPFileConfig: Encodable {
+ var minFileSize: Int64
+}
+
public struct ArchiveConfig: Encodable {
var archivePath: String
var disableCompression: Bool?
diff --git a/apps/ios/SimpleXChat/AppGroup.swift b/apps/ios/SimpleXChat/AppGroup.swift
index 3ea392c22..a39419b43 100644
--- a/apps/ios/SimpleXChat/AppGroup.swift
+++ b/apps/ios/SimpleXChat/AppGroup.swift
@@ -30,6 +30,7 @@ let GROUP_DEFAULT_INCOGNITO = "incognito"
let GROUP_DEFAULT_STORE_DB_PASSPHRASE = "storeDBPassphrase"
let GROUP_DEFAULT_INITIAL_RANDOM_DB_PASSPHRASE = "initialRandomDBPassphrase"
public let GROUP_DEFAULT_CALL_KIT_ENABLED = "callKitEnabled"
+public let GROUP_DEFAULT_XFTP_SEND_ENABLED = "xftpSendEnabled"
public let APP_GROUP_NAME = "group.chat.simplex.app"
@@ -52,7 +53,8 @@ public func registerGroupDefaults() {
GROUP_DEFAULT_INITIAL_RANDOM_DB_PASSPHRASE: false,
GROUP_DEFAULT_PRIVACY_ACCEPT_IMAGES: true,
GROUP_DEFAULT_PRIVACY_TRANSFER_IMAGES_INLINE: false,
- GROUP_DEFAULT_CALL_KIT_ENABLED: true
+ GROUP_DEFAULT_CALL_KIT_ENABLED: true,
+ GROUP_DEFAULT_XFTP_SEND_ENABLED: false
])
}
@@ -123,6 +125,8 @@ public let initialRandomDBPassphraseGroupDefault = BoolDefault(defaults: groupDe
public let callKitEnabledGroupDefault = BoolDefault(defaults: groupDefaults, forKey: GROUP_DEFAULT_CALL_KIT_ENABLED)
+public let xftpSendEnabledGroupDefault = BoolDefault(defaults: groupDefaults, forKey: GROUP_DEFAULT_XFTP_SEND_ENABLED)
+
public class DateDefault {
var defaults: UserDefaults
var key: String
@@ -195,6 +199,11 @@ public class Default {
}
}
+public func getXFTPCfg() -> XFTPFileConfig? {
+ let xftpSendEnabled = xftpSendEnabledGroupDefault.get()
+ return xftpSendEnabled ? XFTPFileConfig(minFileSize: 0) : nil
+}
+
public func getNetCfg() -> NetCfg {
let onionHosts = networkUseOnionHostsGroupDefault.get()
let (hostMode, requiredHostMode) = onionHosts.hostMode
diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift
index d5c692f1f..bcd033f67 100644
--- a/apps/ios/SimpleXChat/ChatTypes.swift
+++ b/apps/ios/SimpleXChat/ChatTypes.swift
@@ -2237,16 +2237,30 @@ public struct CIFile: Decodable {
}
}
-public enum CIFileStatus: String, Decodable {
- case sndStored = "snd_stored"
- case sndTransfer = "snd_transfer"
- case sndComplete = "snd_complete"
- case sndCancelled = "snd_cancelled"
- case rcvInvitation = "rcv_invitation"
- case rcvAccepted = "rcv_accepted"
- case rcvTransfer = "rcv_transfer"
- case rcvComplete = "rcv_complete"
- case rcvCancelled = "rcv_cancelled"
+public enum CIFileStatus: Decodable {
+ case sndStored
+ case sndTransfer(sndProgress: Int, sndTotal: Int)
+ case sndComplete
+ case sndCancelled
+ case rcvInvitation
+ case rcvAccepted
+ case rcvTransfer(rcvProgress: Int, rcvTotal: Int)
+ case rcvComplete
+ case rcvCancelled
+
+ var id: String {
+ switch self {
+ case .sndStored: return "sndStored"
+ case let .sndTransfer(sndProgress, sndTotal): return "sndTransfer \(sndProgress) \(sndTotal)"
+ case .sndComplete: return "sndComplete"
+ case .sndCancelled: return "sndCancelled"
+ case .rcvInvitation: return "rcvInvitation"
+ case .rcvAccepted: return "rcvAccepted"
+ case let .rcvTransfer(rcvProgress, rcvTotal): return "rcvTransfer \(rcvProgress) \(rcvTotal)"
+ case .rcvComplete: return "rcvComplete"
+ case .rcvCancelled: return "rcvCancelled"
+ }
+ }
}
public enum MsgContent {
diff --git a/apps/ios/SimpleXChat/FileUtils.swift b/apps/ios/SimpleXChat/FileUtils.swift
index 7df65f244..09cc0b996 100644
--- a/apps/ios/SimpleXChat/FileUtils.swift
+++ b/apps/ios/SimpleXChat/FileUtils.swift
@@ -16,7 +16,8 @@ public let MAX_IMAGE_SIZE: Int64 = 236700
public let MAX_IMAGE_SIZE_AUTO_RCV: Int64 = MAX_IMAGE_SIZE * 2
-public let MAX_FILE_SIZE: Int64 = 8000000
+//public let MAX_FILE_SIZE_SMP: Int64 = 8000000 // TODO distinguish between XFTP and SMP files
+public let MAX_FILE_SIZE: Int64 = 1_073_741_824
public let MAX_VOICE_MESSAGE_LENGTH = TimeInterval(30)
@@ -158,6 +159,10 @@ public func removeLegacyDatabaseAndFiles() -> Bool {
return r1 && r2
}
+public func getTempFilesDirectory() -> URL {
+ getAppDirectory().appendingPathComponent("temp_files", isDirectory: true)
+}
+
public func getAppFilesDirectory() -> URL {
getAppDirectory().appendingPathComponent("app_files", isDirectory: true)
}
From 1ba210fe771208ef20d2b83fccf467701e5465ff Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Fri, 24 Mar 2023 19:06:36 +0400
Subject: [PATCH 14/17] android: support XFTP files (#2070)
---
.../java/chat/simplex/app/model/ChatModel.kt | 38 +++++++++----------
.../java/chat/simplex/app/model/SimpleXAPI.kt | 33 +++++++++++++++-
.../simplex/app/views/chat/item/CIFileView.kt | 26 ++++++-------
.../app/views/chat/item/CIImageView.kt | 12 +++---
.../app/views/chat/item/CIVoiceView.kt | 6 +--
.../chat/simplex/app/views/helpers/Util.kt | 7 +++-
.../usersettings/ExperimentalFeaturesView.kt | 14 ++++---
.../app/views/usersettings/SettingsView.kt | 4 +-
.../app/src/main/res/values/strings.xml | 1 +
9 files changed, 91 insertions(+), 50 deletions(-)
diff --git a/apps/android/app/src/main/java/chat/simplex/app/model/ChatModel.kt b/apps/android/app/src/main/java/chat/simplex/app/model/ChatModel.kt
index b573a1375..58238b48b 100644
--- a/apps/android/app/src/main/java/chat/simplex/app/model/ChatModel.kt
+++ b/apps/android/app/src/main/java/chat/simplex/app/model/ChatModel.kt
@@ -1674,15 +1674,15 @@ class CIFile(
val fileStatus: CIFileStatus
) {
val loaded: Boolean = when (fileStatus) {
- CIFileStatus.SndStored -> true
- CIFileStatus.SndTransfer -> true
- CIFileStatus.SndComplete -> true
- CIFileStatus.SndCancelled -> true
- CIFileStatus.RcvInvitation -> false
- CIFileStatus.RcvAccepted -> false
- CIFileStatus.RcvTransfer -> false
- CIFileStatus.RcvCancelled -> false
- CIFileStatus.RcvComplete -> true
+ is CIFileStatus.SndStored -> true
+ is CIFileStatus.SndTransfer -> true
+ is CIFileStatus.SndComplete -> true
+ is CIFileStatus.SndCancelled -> true
+ is CIFileStatus.RcvInvitation -> false
+ is CIFileStatus.RcvAccepted -> false
+ is CIFileStatus.RcvTransfer -> false
+ is CIFileStatus.RcvCancelled -> false
+ is CIFileStatus.RcvComplete -> true
}
companion object {
@@ -1698,16 +1698,16 @@ class CIFile(
}
@Serializable
-enum class CIFileStatus {
- @SerialName("snd_stored") SndStored,
- @SerialName("snd_transfer") SndTransfer,
- @SerialName("snd_complete") SndComplete,
- @SerialName("snd_cancelled") SndCancelled,
- @SerialName("rcv_invitation") RcvInvitation,
- @SerialName("rcv_accepted") RcvAccepted,
- @SerialName("rcv_transfer") RcvTransfer,
- @SerialName("rcv_complete") RcvComplete,
- @SerialName("rcv_cancelled") RcvCancelled;
+sealed class CIFileStatus {
+ @Serializable @SerialName("sndStored") object SndStored: CIFileStatus()
+ @Serializable @SerialName("sndTransfer") class SndTransfer(val sndProgress: Int, val sndTotal: Int): CIFileStatus()
+ @Serializable @SerialName("sndComplete") object SndComplete: CIFileStatus()
+ @Serializable @SerialName("sndCancelled") object SndCancelled: CIFileStatus()
+ @Serializable @SerialName("rcvInvitation") object RcvInvitation: CIFileStatus()
+ @Serializable @SerialName("rcvAccepted") object RcvAccepted: CIFileStatus()
+ @Serializable @SerialName("rcvTransfer") class RcvTransfer(val rcvProgress: Int, val rcvTotal: Int): CIFileStatus()
+ @Serializable @SerialName("rcvComplete") object RcvComplete: CIFileStatus()
+ @Serializable @SerialName("rcvCancelled") object RcvCancelled: CIFileStatus()
}
@Suppress("SERIALIZER_TYPE_INCOMPATIBLE")
diff --git a/apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt b/apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt
index 35b918776..58d41984b 100644
--- a/apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt
+++ b/apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt
@@ -146,6 +146,8 @@ class AppPreferences(val context: Context) {
val whatsNewVersion = mkStrPreference(SHARED_PREFS_WHATS_NEW_VERSION, null)
+ val xftpSendEnabled = mkBoolPreference(SHARED_PREFS_XFTP_SEND_ENABLED, false)
+
private fun mkIntPreference(prefName: String, default: Int) =
SharedPreference(
get = fun() = sharedPreferences.getInt(prefName, default),
@@ -241,6 +243,7 @@ class AppPreferences(val context: Context) {
private const val SHARED_PREFS_CURRENT_THEME = "CurrentTheme"
private const val SHARED_PREFS_PRIMARY_COLOR = "PrimaryColor"
private const val SHARED_PREFS_WHATS_NEW_VERSION = "WhatsNewVersion"
+ private const val SHARED_PREFS_XFTP_SEND_ENABLED = "XFTPSendEnabled"
}
}
@@ -266,6 +269,9 @@ open class ChatController(var ctrl: ChatCtrl?, val ntfManager: NtfManager, val a
try {
if (chatModel.chatRunning.value == true) return
apiSetNetworkConfig(getNetCfg())
+ apiSetTempFolder(getTempFilesDirectory(appContext))
+ apiSetFilesFolder(getAppFilesDirectory(appContext))
+ apiSetXFTPConfig(getXFTPCfg())
val justStarted = apiStartChat()
val users = listUsers()
chatModel.users.clear()
@@ -273,7 +279,6 @@ open class ChatController(var ctrl: ChatCtrl?, val ntfManager: NtfManager, val a
if (justStarted) {
chatModel.currentUser.value = user
chatModel.userCreated.value = true
- apiSetFilesFolder(getAppFilesDirectory(appContext))
apiSetIncognito(chatModel.incognito.value)
getUserChatData()
chatModel.onboardingStage.value = OnboardingStage.OnboardingComplete
@@ -434,12 +439,24 @@ open class ChatController(var ctrl: ChatCtrl?, val ntfManager: NtfManager, val a
}
}
+ private suspend fun apiSetTempFolder(tempFolder: String) {
+ val r = sendCmd(CC.SetTempFolder(tempFolder))
+ if (r is CR.CmdOk) return
+ throw Error("failed to set temp folder: ${r.responseType} ${r.details}")
+ }
+
private suspend fun apiSetFilesFolder(filesFolder: String) {
val r = sendCmd(CC.SetFilesFolder(filesFolder))
if (r is CR.CmdOk) return
throw Error("failed to set files folder: ${r.responseType} ${r.details}")
}
+ suspend fun apiSetXFTPConfig(cfg: XFTPFileConfig?) {
+ val r = sendCmd(CC.ApiSetXFTPConfig(cfg))
+ if (r is CR.CmdOk) return
+ throw Error("apiSetXFTPConfig bad response: ${r.responseType} ${r.details}")
+ }
+
suspend fun apiSetIncognito(incognito: Boolean) {
val r = sendCmd(CC.SetIncognito(incognito))
if (r is CR.CmdOk) return
@@ -1683,6 +1700,11 @@ open class ChatController(var ctrl: ChatCtrl?, val ntfManager: NtfManager, val a
}
}
+ fun getXFTPCfg(): XFTPFileConfig? {
+ val prefXFTPSendEnabled = appPrefs.xftpSendEnabled.get()
+ return if (prefXFTPSendEnabled) XFTPFileConfig(minFileSize = 0) else null
+ }
+
fun getNetCfg(): NetCfg {
val useSocksProxy = appPrefs.networkUseSocksProxy.get()
val socksProxy = if (useSocksProxy) ":9050" else null
@@ -1758,7 +1780,9 @@ sealed class CC {
class ApiDeleteUser(val userId: Long, val delSMPQueues: Boolean): CC()
class StartChat(val expire: Boolean): CC()
class ApiStopChat: CC()
+ class SetTempFolder(val tempFolder: String): CC()
class SetFilesFolder(val filesFolder: String): CC()
+ class ApiSetXFTPConfig(val config: XFTPFileConfig?): CC()
class SetIncognito(val incognito: Boolean): CC()
class ApiExportArchive(val config: ArchiveConfig): CC()
class ApiImportArchive(val config: ArchiveConfig): CC()
@@ -1835,7 +1859,9 @@ sealed class CC {
is ApiDeleteUser -> "/_delete user $userId del_smp=${onOff(delSMPQueues)}"
is StartChat -> "/_start subscribe=on expire=${onOff(expire)}"
is ApiStopChat -> "/_stop"
+ is SetTempFolder -> "/_temp_folder $tempFolder"
is SetFilesFolder -> "/_files_folder $filesFolder"
+ is ApiSetXFTPConfig -> if (config != null) "/_xftp on ${json.encodeToString(config)}" else "/_xftp off"
is SetIncognito -> "/incognito ${onOff(incognito)}"
is ApiExportArchive -> "/_db export ${json.encodeToString(config)}"
is ApiImportArchive -> "/_db import ${json.encodeToString(config)}"
@@ -1913,7 +1939,9 @@ sealed class CC {
is ApiDeleteUser -> "apiDeleteUser"
is StartChat -> "startChat"
is ApiStopChat -> "apiStopChat"
+ is SetTempFolder -> "setTempFolder"
is SetFilesFolder -> "setFilesFolder"
+ is ApiSetXFTPConfig -> "apiSetXFTPConfig"
is SetIncognito -> "setIncognito"
is ApiExportArchive -> "apiExportArchive"
is ApiImportArchive -> "apiImportArchive"
@@ -2027,6 +2055,9 @@ sealed class ChatPagination {
@Serializable
class ComposedMessage(val filePath: String?, val quotedItemId: Long?, val msgContent: MsgContent)
+@Serializable
+class XFTPFileConfig(val minFileSize: Long)
+
@Serializable
class ArchiveConfig(val archivePath: String, val disableCompression: Boolean? = null, val parentTempDirectory: String? = null)
diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIFileView.kt b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIFileView.kt
index b9e3bbc62..0df2c1518 100644
--- a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIFileView.kt
+++ b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIFileView.kt
@@ -72,7 +72,7 @@ fun CIFileView(
fun fileAction() {
if (file != null) {
when (file.fileStatus) {
- CIFileStatus.RcvInvitation -> {
+ is CIFileStatus.RcvInvitation -> {
if (fileSizeValid()) {
receiveFile(file.fileId)
} else {
@@ -82,12 +82,12 @@ fun CIFileView(
)
}
}
- CIFileStatus.RcvAccepted ->
+ is CIFileStatus.RcvAccepted ->
AlertManager.shared.showAlertMsg(
generalGetString(R.string.waiting_for_file),
String.format(generalGetString(R.string.file_will_be_received_when_contact_is_online), MAX_FILE_SIZE)
)
- CIFileStatus.RcvComplete -> {
+ is CIFileStatus.RcvComplete -> {
val filePath = getLoadedFilePath(context, file)
if (filePath != null) {
saveFileLauncher.launch(file.fileName)
@@ -120,19 +120,19 @@ fun CIFileView(
) {
if (file != null) {
when (file.fileStatus) {
- CIFileStatus.SndStored -> fileIcon()
- CIFileStatus.SndTransfer -> progressIndicator()
- CIFileStatus.SndComplete -> fileIcon(innerIcon = Icons.Filled.Check)
- CIFileStatus.SndCancelled -> fileIcon(innerIcon = Icons.Outlined.Close)
- CIFileStatus.RcvInvitation ->
+ is CIFileStatus.SndStored -> fileIcon()
+ is CIFileStatus.SndTransfer -> progressIndicator()
+ is CIFileStatus.SndComplete -> fileIcon(innerIcon = Icons.Filled.Check)
+ is CIFileStatus.SndCancelled -> fileIcon(innerIcon = Icons.Outlined.Close)
+ is CIFileStatus.RcvInvitation ->
if (fileSizeValid())
fileIcon(innerIcon = Icons.Outlined.ArrowDownward, color = MaterialTheme.colors.primary)
else
fileIcon(innerIcon = Icons.Outlined.PriorityHigh, color = WarningOrange)
- CIFileStatus.RcvAccepted -> fileIcon(innerIcon = Icons.Outlined.MoreHoriz)
- CIFileStatus.RcvTransfer -> progressIndicator()
- CIFileStatus.RcvComplete -> fileIcon()
- CIFileStatus.RcvCancelled -> fileIcon(innerIcon = Icons.Outlined.Close)
+ is CIFileStatus.RcvAccepted -> fileIcon(innerIcon = Icons.Outlined.MoreHoriz)
+ is CIFileStatus.RcvTransfer -> progressIndicator()
+ is CIFileStatus.RcvComplete -> fileIcon()
+ is CIFileStatus.RcvCancelled -> fileIcon(innerIcon = Icons.Outlined.Close)
}
} else {
fileIcon()
@@ -191,7 +191,7 @@ class ChatItemProvider: PreviewParameterProvider {
ChatItem.getFileMsgContentSample(),
ChatItem.getFileMsgContentSample(fileName = "some_long_file_name_here", fileStatus = CIFileStatus.RcvInvitation),
ChatItem.getFileMsgContentSample(fileStatus = CIFileStatus.RcvAccepted),
- ChatItem.getFileMsgContentSample(fileStatus = CIFileStatus.RcvTransfer),
+ ChatItem.getFileMsgContentSample(fileStatus = CIFileStatus.RcvTransfer(rcvProgress = 7, rcvTotal = 10)),
ChatItem.getFileMsgContentSample(fileStatus = CIFileStatus.RcvCancelled),
ChatItem.getFileMsgContentSample(fileSize = 1_000_000_000, fileStatus = CIFileStatus.RcvInvitation),
ChatItem.getFileMsgContentSample(text = "Hello there", fileStatus = CIFileStatus.RcvInvitation),
diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIImageView.kt b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIImageView.kt
index 644bacfe6..7fb2e92f9 100644
--- a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIImageView.kt
+++ b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIImageView.kt
@@ -55,33 +55,33 @@ fun CIImageView(
contentAlignment = Alignment.Center
) {
when (file.fileStatus) {
- CIFileStatus.SndTransfer ->
+ is CIFileStatus.SndTransfer ->
CircularProgressIndicator(
Modifier.size(16.dp),
color = Color.White,
strokeWidth = 2.dp
)
- CIFileStatus.SndComplete ->
+ is CIFileStatus.SndComplete ->
Icon(
Icons.Filled.Check,
stringResource(R.string.icon_descr_image_snd_complete),
Modifier.fillMaxSize(),
tint = Color.White
)
- CIFileStatus.RcvAccepted ->
+ is CIFileStatus.RcvAccepted ->
Icon(
Icons.Outlined.MoreHoriz,
stringResource(R.string.icon_descr_waiting_for_image),
Modifier.fillMaxSize(),
tint = Color.White
)
- CIFileStatus.RcvTransfer ->
+ is CIFileStatus.RcvTransfer ->
CircularProgressIndicator(
Modifier.size(16.dp),
color = Color.White,
strokeWidth = 2.dp
)
- CIFileStatus.RcvInvitation ->
+ is CIFileStatus.RcvInvitation ->
Icon(
Icons.Outlined.ArrowDownward,
stringResource(R.string.icon_descr_asked_to_receive),
@@ -187,7 +187,7 @@ fun CIImageView(
generalGetString(R.string.waiting_for_image),
generalGetString(R.string.image_will_be_received_when_contact_is_online)
)
- CIFileStatus.RcvTransfer -> {} // ?
+ CIFileStatus.RcvTransfer(rcvProgress = 7, rcvTotal = 10) -> {} // ?
CIFileStatus.RcvComplete -> {} // ?
CIFileStatus.RcvCancelled -> {} // TODO
else -> {}
diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIVoiceView.kt b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIVoiceView.kt
index a42acadea..c20df776a 100644
--- a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIVoiceView.kt
+++ b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIVoiceView.kt
@@ -210,9 +210,9 @@ private fun VoiceMsgIndicator(
PlayPauseButton(audioPlaying, sent, angle, strokeWidth, strokeColor, true, error, play, pause, longClick = longClick)
}
} else {
- if (file?.fileStatus == CIFileStatus.RcvInvitation
- || file?.fileStatus == CIFileStatus.RcvTransfer
- || file?.fileStatus == CIFileStatus.RcvAccepted
+ if (file?.fileStatus is CIFileStatus.RcvInvitation
+ || file?.fileStatus is CIFileStatus.RcvTransfer
+ || file?.fileStatus is CIFileStatus.RcvAccepted
) {
Box(
Modifier
diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/helpers/Util.kt b/apps/android/app/src/main/java/chat/simplex/app/views/helpers/Util.kt
index 17a462f58..d5e2978d9 100644
--- a/apps/android/app/src/main/java/chat/simplex/app/views/helpers/Util.kt
+++ b/apps/android/app/src/main/java/chat/simplex/app/views/helpers/Util.kt
@@ -234,12 +234,17 @@ const val MAX_VOICE_SIZE_AUTO_RCV: Long = MAX_IMAGE_SIZE
const val MAX_VOICE_SIZE_FOR_SENDING: Long = 94680 // 6 chunks * 15780 bytes per chunk
const val MAX_VOICE_MILLIS_FOR_SENDING: Int = 43_000
-const val MAX_FILE_SIZE: Long = 8000000
+//const val MAX_FILE_SIZE_SMP: Long = 8000000 // TODO distinguish between XFTP and SMP files
+const val MAX_FILE_SIZE: Long = 1_073_741_824
fun getFilesDirectory(context: Context): String {
return context.filesDir.toString()
}
+fun getTempFilesDirectory(context: Context): String {
+ return "${getFilesDirectory(context)}/temp_files"
+}
+
fun getAppFilesDirectory(context: Context): String {
return "${getFilesDirectory(context)}/app_files"
}
diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/usersettings/ExperimentalFeaturesView.kt b/apps/android/app/src/main/java/chat/simplex/app/views/usersettings/ExperimentalFeaturesView.kt
index 3fb3ee9db..637bda9eb 100644
--- a/apps/android/app/src/main/java/chat/simplex/app/views/usersettings/ExperimentalFeaturesView.kt
+++ b/apps/android/app/src/main/java/chat/simplex/app/views/usersettings/ExperimentalFeaturesView.kt
@@ -5,18 +5,18 @@ import androidx.compose.foundation.layout.*
import androidx.compose.material.MaterialTheme
import androidx.compose.material.Text
import androidx.compose.material.icons.Icons
-import androidx.compose.material.icons.outlined.Videocam
+import androidx.compose.material.icons.outlined.UploadFile
import androidx.compose.runtime.Composable
-import androidx.compose.runtime.MutableState
import androidx.compose.ui.Alignment
import androidx.compose.ui.Modifier
import androidx.compose.ui.res.stringResource
import androidx.compose.ui.unit.dp
import chat.simplex.app.R
import chat.simplex.app.model.ChatModel
+import chat.simplex.app.views.helpers.withApi
@Composable
-fun ExperimentalFeaturesView(chatModel: ChatModel, enableCalls: MutableState) {
+fun ExperimentalFeaturesView(chatModel: ChatModel) {
Column(
Modifier.fillMaxWidth(),
horizontalAlignment = Alignment.Start
@@ -27,7 +27,11 @@ fun ExperimentalFeaturesView(chatModel: ChatModel, enableCalls: MutableStateMESSAGES
CALLS
Incognito mode
+ Send files via XFTP
Your chat database
From c79eb36a7abb36ba61c59771cd57a7a0dd208aa0 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 27 Mar 2023 12:37:22 +0100
Subject: [PATCH 15/17] core: update file status on XFTP progress events
(#2079)
* core: update file status on XFTP progress events
* update simplexmq
---
cabal.project | 2 +-
scripts/nix/sha256map.nix | 2 +-
src/Simplex/Chat.hs | 21 +++++++++++++--------
src/Simplex/Chat/Controller.hs | 4 ++--
src/Simplex/Chat/Messages.hs | 10 +++++-----
stack.yaml | 2 +-
6 files changed, 23 insertions(+), 18 deletions(-)
diff --git a/cabal.project b/cabal.project
index 332ebdc79..b05e83ecd 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: 0df7733125add475f9de88a362bcd526091f187c
+ tag: c5eb65fec873e0493c28af8b190c3458445d1811
source-repository-package
type: git
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index fab104c40..e5f9c20ab 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
{
- "https://github.com/simplex-chat/simplexmq.git"."0df7733125add475f9de88a362bcd526091f187c" = "09s2dimdq88lm4mb2xcl5vch2qb21llj8ss649vlxpkm69njpyj0";
+ "https://github.com/simplex-chat/simplexmq.git"."c5eb65fec873e0493c28af8b190c3458445d1811" = "1cqxl2862fxfl9zv2i1ckvq4xcminslqwfgy5q1w71qk0g2gg96h";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/kazu-yamamoto/http2.git"."78e18f52295a7f89e828539a03fbcb24931461a3" = "05q165anvv0qrcxqbvq1dlvw0l8gmsa9kl6sazk1mfhz2g0yimdk";
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index a07979fab..939c8985a 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -2274,10 +2274,13 @@ processAgentMsgSndFile _corrId aFileId msg =
process user = do
fileId <- withStore $ \db -> getXFTPSndFileDBId db user $ AgentSndFileId aFileId
case msg of
- SFPROG _sent _total -> do
- -- update chat item status
- -- send status to view
- pure ()
+ SFPROG sndProgress sndTotal -> do
+ let status = CIFSSndTransfer {sndProgress, sndTotal}
+ (ci, ft) <- withStore $ \db -> do
+ liftIO $ updateCIFileStatus db user fileId status
+ ft <- getFileTransferMeta db user fileId
+ (,ft) <$> getChatItemByFileId db user fileId
+ toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal
SFDONE _sndDescr rfds -> do
ci@(AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) <-
withStore $ \db -> getChatItemByFileId db user fileId
@@ -2338,10 +2341,12 @@ processAgentMsgRcvFile _corrId aFileId msg =
process user = do
fileId <- withStore (`getXFTPRcvFileDBId` AgentRcvFileId aFileId)
case msg of
- RFPROG _sent _total -> do
- -- update chat item status
- -- send status to view
- pure ()
+ RFPROG rcvProgress rcvTotal -> do
+ let status = CIFSRcvTransfer {rcvProgress, rcvTotal}
+ ci <- withStore $ \db -> do
+ liftIO $ updateCIFileStatus db user fileId status
+ getChatItemByFileId db user fileId
+ toView $ CRRcvFileProgressXFTP user ci rcvProgress rcvTotal
RFDONE xftpPath -> do
ft <- withStore $ \db -> getRcvFileTransfer db user fileId
case liveRcvFileTransferPath ft of
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 7a4e91150..7c3712397 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -443,7 +443,7 @@ data ChatResponse
| CRRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileDescrNotReady {user :: User, chatItem :: AChatItem}
| CRRcvFileStart {user :: User, chatItem :: AChatItem}
- | CRRcvFileProgressXFTP {user :: User, chatItem :: AChatItem, receivedChunks :: Int, totalChunks :: Int}
+ | CRRcvFileProgressXFTP {user :: User, chatItem :: AChatItem, receivedSize :: Int64, totalSize :: Int64}
| CRRcvFileComplete {user :: User, chatItem :: AChatItem}
| CRRcvFileCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
@@ -453,7 +453,7 @@ data ChatResponse
| 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}
+ | CRSndFileProgressXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sentSize :: Int64, totalSize :: Int64}
| CRSndFileCompleteXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
| CRSndFileCancelledXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
| CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile}
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index e6a45349e..f84d1ab29 100644
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -419,12 +419,12 @@ instance MsgDirectionI d => ToJSON (CIFile d) where
data CIFileStatus (d :: MsgDirection) where
CIFSSndStored :: CIFileStatus 'MDSnd
- CIFSSndTransfer :: {sndProgress :: Int, sndTotal :: Int} -> CIFileStatus 'MDSnd
+ CIFSSndTransfer :: {sndProgress :: Int64, sndTotal :: Int64} -> CIFileStatus 'MDSnd
CIFSSndCancelled :: CIFileStatus 'MDSnd
CIFSSndComplete :: CIFileStatus 'MDSnd
CIFSRcvInvitation :: CIFileStatus 'MDRcv
CIFSRcvAccepted :: CIFileStatus 'MDRcv
- CIFSRcvTransfer :: {rcvProgress :: Int, rcvTotal :: Int} -> CIFileStatus 'MDRcv
+ CIFSRcvTransfer :: {rcvProgress :: Int64, rcvTotal :: Int64} -> CIFileStatus 'MDRcv
CIFSRcvComplete :: CIFileStatus 'MDRcv
CIFSRcvCancelled :: CIFileStatus 'MDRcv
@@ -484,18 +484,18 @@ instance StrEncoding ACIFileStatus where
"rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled
_ -> fail "bad file status"
where
- progress :: (Int -> Int -> a) -> A.Parser a
+ progress :: (Int64 -> Int64 -> 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}
+ | JCIFSSndTransfer {sndProgress :: Int64, sndTotal :: Int64}
| JCIFSSndCancelled
| JCIFSSndComplete
| JCIFSRcvInvitation
| JCIFSRcvAccepted
- | JCIFSRcvTransfer {rcvProgress :: Int, rcvTotal :: Int}
+ | JCIFSRcvTransfer {rcvProgress :: Int64, rcvTotal :: Int64}
| JCIFSRcvComplete
| JCIFSRcvCancelled
deriving (Generic)
diff --git a/stack.yaml b/stack.yaml
index 6e935ec9f..b19382c2a 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -49,7 +49,7 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
- commit: 0df7733125add475f9de88a362bcd526091f187c
+ commit: c5eb65fec873e0493c28af8b190c3458445d1811
- github: kazu-yamamoto/http2
commit: 78e18f52295a7f89e828539a03fbcb24931461a3
# - ../direct-sqlcipher
From ffea61917d0507b3ded5ff61ad71b369eab39337 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Mon, 27 Mar 2023 21:02:54 +0400
Subject: [PATCH 16/17] ios: display rcv & snd files progress (#2085)
* ios: display rcv & snd files progress
* remove animation
---
apps/ios/Shared/Model/SimpleXAPI.swift | 4 +++
.../Views/Chat/ChatItem/CIFileView.swift | 27 ++++++++++++++-----
apps/ios/SimpleXChat/APITypes.swift | 6 +++++
apps/ios/SimpleXChat/ChatTypes.swift | 4 +--
4 files changed, 32 insertions(+), 9 deletions(-)
diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift
index 9c23b01cf..7c22e69e1 100644
--- a/apps/ios/Shared/Model/SimpleXAPI.swift
+++ b/apps/ios/Shared/Model/SimpleXAPI.swift
@@ -1321,6 +1321,8 @@ func processReceivedMsg(_ res: ChatResponse) async {
chatItemSimpleUpdate(user, aChatItem)
case let .rcvFileComplete(user, aChatItem):
chatItemSimpleUpdate(user, aChatItem)
+ case let .rcvFileProgressXFTP(user, aChatItem, _, _):
+ chatItemSimpleUpdate(user, aChatItem)
case let .sndFileStart(user, aChatItem, _):
chatItemSimpleUpdate(user, aChatItem)
case let .sndFileComplete(user, aChatItem, _):
@@ -1332,6 +1334,8 @@ func processReceivedMsg(_ res: ChatResponse) async {
let fileName = cItem.file?.filePath {
removeFile(fileName)
}
+ case let .sndFileProgressXFTP(user, aChatItem, _, _, _):
+ chatItemSimpleUpdate(user, aChatItem)
case let .callInvitation(invitation):
m.callInvitations[invitation.contact.id] = invitation
activateCall(invitation)
diff --git a/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift b/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift
index 08170f825..1445ea3df 100644
--- a/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift
+++ b/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift
@@ -48,7 +48,7 @@ struct CIFileView: View {
.disabled(!itemInteractive)
}
- var itemInteractive: Bool {
+ private var itemInteractive: Bool {
if let file = file {
switch (file.fileStatus) {
case .sndStored: return false
@@ -65,14 +65,14 @@ struct CIFileView: View {
return false
}
- func fileSizeValid() -> Bool {
+ private func fileSizeValid() -> Bool {
if let file = file {
return file.fileSize <= MAX_FILE_SIZE
}
return false
}
- func fileAction() {
+ private func fileAction() {
logger.debug("CIFileView fileAction")
if let file = file {
switch (file.fileStatus) {
@@ -107,11 +107,12 @@ struct CIFileView: View {
}
}
- @ViewBuilder func fileIndicator() -> some View {
+ @ViewBuilder private func fileIndicator() -> some View {
if let file = file {
switch file.fileStatus {
case .sndStored: fileIcon("doc.fill")
- case .sndTransfer: ProgressView().frame(width: 30, height: 30)
+ // case .sndTransfer: ProgressView().frame(width: 30, height: 30) // TODO use for SMP files
+ case let .sndTransfer(sndProgress, sndTotal): progressCircle(sndProgress, sndTotal)
case .sndComplete: fileIcon("doc.fill", innerIcon: "checkmark", innerIconSize: 10)
case .sndCancelled: fileIcon("doc.fill", innerIcon: "xmark", innerIconSize: 10)
case .rcvInvitation:
@@ -121,7 +122,8 @@ struct CIFileView: View {
fileIcon("doc.fill", color: .orange, innerIcon: "exclamationmark", innerIconSize: 12)
}
case .rcvAccepted: fileIcon("doc.fill", innerIcon: "ellipsis", innerIconSize: 12)
- case .rcvTransfer: ProgressView().frame(width: 30, height: 30)
+ // case .rcvTransfer: ProgressView().frame(width: 30, height: 30) // TODO use for SMP files
+ case let .rcvTransfer(rcvProgress, rcvTotal): progressCircle(rcvProgress, rcvTotal)
case .rcvComplete: fileIcon("doc.fill")
case .rcvCancelled: fileIcon("doc.fill", innerIcon: "xmark", innerIconSize: 10)
}
@@ -130,7 +132,7 @@ struct CIFileView: View {
}
}
- func fileIcon(_ icon: String, color: Color = Color(uiColor: .tertiaryLabel), innerIcon: String? = nil, innerIconSize: CGFloat? = nil) -> some View {
+ private func fileIcon(_ icon: String, color: Color = Color(uiColor: .tertiaryLabel), innerIcon: String? = nil, innerIconSize: CGFloat? = nil) -> some View {
ZStack(alignment: .center) {
Image(systemName: icon)
.resizable()
@@ -149,6 +151,17 @@ struct CIFileView: View {
}
}
}
+
+ private func progressCircle(_ progress: Int64, _ total: Int64) -> some View {
+ Circle()
+ .trim(from: 0, to: Double(progress) / Double(total))
+ .stroke(
+ Color.accentColor,
+ style: StrokeStyle(lineWidth: 3)
+ )
+ .rotationEffect(.degrees(-90))
+ .frame(width: 30, height: 30)
+ }
}
struct CIFileView_Previews: PreviewProvider {
diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift
index defc069a7..0f9dffedb 100644
--- a/apps/ios/SimpleXChat/APITypes.swift
+++ b/apps/ios/SimpleXChat/APITypes.swift
@@ -451,6 +451,7 @@ public enum ChatResponse: Decodable, Error {
case rcvFileAccepted(user: User, chatItem: AChatItem)
case rcvFileAcceptedSndCancelled(user: User, rcvFileTransfer: RcvFileTransfer)
case rcvFileStart(user: User, chatItem: AChatItem)
+ case rcvFileProgressXFTP(user: User, chatItem: AChatItem, receivedSize: Int64, totalSize: Int64)
case rcvFileComplete(user: User, chatItem: AChatItem)
// sending file events
case sndFileStart(user: User, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
@@ -458,6 +459,7 @@ public enum ChatResponse: Decodable, Error {
case sndFileCancelled(chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
case sndFileRcvCancelled(user: User, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
case sndGroupFileCancelled(user: User, chatItem: AChatItem, fileTransferMeta: FileTransferMeta, sndFileTransfers: [SndFileTransfer])
+ case sndFileProgressXFTP(user: User, chatItem: AChatItem, fileTransferMeta: FileTransferMeta, sentSize: Int64, totalSize: Int64)
case callInvitation(callInvitation: RcvCallInvitation)
case callOffer(user: User, contact: Contact, callType: CallType, offer: WebRTCSession, sharedKey: String?, askConfirmation: Bool)
case callAnswer(user: User, contact: Contact, answer: WebRTCSession)
@@ -558,12 +560,14 @@ public enum ChatResponse: Decodable, Error {
case .rcvFileAccepted: return "rcvFileAccepted"
case .rcvFileAcceptedSndCancelled: return "rcvFileAcceptedSndCancelled"
case .rcvFileStart: return "rcvFileStart"
+ case .rcvFileProgressXFTP: return "rcvFileProgressXFTP"
case .rcvFileComplete: return "rcvFileComplete"
case .sndFileStart: return "sndFileStart"
case .sndFileComplete: return "sndFileComplete"
case .sndFileCancelled: return "sndFileCancelled"
case .sndFileRcvCancelled: return "sndFileRcvCancelled"
case .sndGroupFileCancelled: return "sndGroupFileCancelled"
+ case .sndFileProgressXFTP: return "sndFileProgressXFTP"
case .callInvitation: return "callInvitation"
case .callOffer: return "callOffer"
case .callAnswer: return "callAnswer"
@@ -667,12 +671,14 @@ public enum ChatResponse: Decodable, Error {
case let .rcvFileAccepted(u, chatItem): return withUser(u, String(describing: chatItem))
case .rcvFileAcceptedSndCancelled: return noDetails
case let .rcvFileStart(u, chatItem): return withUser(u, String(describing: chatItem))
+ case let .rcvFileProgressXFTP(u, chatItem, receivedSize, totalSize): return withUser(u, "chatItem: \(String(describing: chatItem))\nreceivedSize: \(receivedSize)\ntotalSize: \(totalSize)")
case let .rcvFileComplete(u, chatItem): return withUser(u, String(describing: chatItem))
case let .sndFileStart(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileComplete(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileCancelled(chatItem, _): return String(describing: chatItem)
case let .sndFileRcvCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndGroupFileCancelled(u, chatItem, _, _): return withUser(u, String(describing: chatItem))
+ case let .sndFileProgressXFTP(u, chatItem, _, sentSize, totalSize): return withUser(u, "chatItem: \(String(describing: chatItem))\nsentSize: \(sentSize)\ntotalSize: \(totalSize)")
case let .callInvitation(inv): return String(describing: inv)
case let .callOffer(u, contact, callType, offer, sharedKey, askConfirmation): return withUser(u, "contact: \(contact.id)\ncallType: \(String(describing: callType))\nsharedKey: \(sharedKey ?? "")\naskConfirmation: \(askConfirmation)\noffer: \(String(describing: offer))")
case let .callAnswer(u, contact, answer): return withUser(u, "contact: \(contact.id)\nanswer: \(String(describing: answer))")
diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift
index bcd033f67..d58347e31 100644
--- a/apps/ios/SimpleXChat/ChatTypes.swift
+++ b/apps/ios/SimpleXChat/ChatTypes.swift
@@ -2239,12 +2239,12 @@ public struct CIFile: Decodable {
public enum CIFileStatus: Decodable {
case sndStored
- case sndTransfer(sndProgress: Int, sndTotal: Int)
+ case sndTransfer(sndProgress: Int64, sndTotal: Int64)
case sndComplete
case sndCancelled
case rcvInvitation
case rcvAccepted
- case rcvTransfer(rcvProgress: Int, rcvTotal: Int)
+ case rcvTransfer(rcvProgress: Int64, rcvTotal: Int64)
case rcvComplete
case rcvCancelled
From 0c3dc8a6e9f558f6f21f0202f92727cb72c99e97 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 27 Mar 2023 19:39:22 +0100
Subject: [PATCH 17/17] core: add down migrations and fix test
---
.../Migrations/M20230318_file_description.hs | 17 +++++++++++++++++
.../Migrations/M20230321_agent_file_deleted.hs | 8 ++++++++
src/Simplex/Chat/Store.hs | 4 ++--
tests/SchemaDump.hs | 4 ++--
4 files changed, 29 insertions(+), 4 deletions(-)
diff --git a/src/Simplex/Chat/Migrations/M20230318_file_description.hs b/src/Simplex/Chat/Migrations/M20230318_file_description.hs
index 76d4ec979..39f56b2a4 100644
--- a/src/Simplex/Chat/Migrations/M20230318_file_description.hs
+++ b/src/Simplex/Chat/Migrations/M20230318_file_description.hs
@@ -37,3 +37,20 @@ CREATE INDEX idx_rcv_files_file_descr_id ON rcv_files(file_descr_id);
ALTER TABLE rcv_files ADD COLUMN agent_rcv_file_id BLOB NULL;
|]
+
+down_m20230318_file_description :: Query
+down_m20230318_file_description =
+ [sql|
+ALTER TABLE rcv_files DROP COLUMN agent_rcv_file_id;
+
+DROP INDEX idx_rcv_files_file_descr_id;
+ALTER TABLE rcv_files DROP COLUMN file_descr_id;
+
+DROP INDEX idx_snd_files_file_descr_id;
+ALTER TABLE snd_files DROP COLUMN file_descr_id;
+
+ALTER TABLE files DROP COLUMN private_snd_file_descr;
+ALTER TABLE files DROP COLUMN agent_snd_file_id;
+
+DROP TABLE xftp_file_descriptions;
+|]
diff --git a/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs b/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs
index 15a08febf..97c213ea4 100644
--- a/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs
+++ b/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs
@@ -18,3 +18,11 @@ UPDATE rcv_files SET agent_rcv_file_deleted = 0;
PRAGMA ignore_check_constraints=OFF;
|]
+
+down_m20230321_agent_file_deleted :: Query
+down_m20230321_agent_file_deleted =
+ [sql|
+ALTER TABLE rcv_files DROP COLUMN agent_rcv_file_deleted;
+
+ALTER TABLE files DROP COLUMN agent_snd_file_deleted;
+|]
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index aa3ff9833..1d45e2fe9 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -431,8 +431,8 @@ schemaMigrations =
("20230206_item_deleted_by_group_member_id", m20230206_item_deleted_by_group_member_id, Nothing),
("20230303_group_link_role", m20230303_group_link_role, Nothing),
("20230317_hidden_profiles", m20230317_hidden_profiles, Just down_m20230317_hidden_profiles),
- ("20230318_file_description", m20230318_file_description, Nothing),
- ("20230321_agent_file_deleted", m20230321_agent_file_deleted, Nothing)
+ ("20230318_file_description", m20230318_file_description, Just down_m20230318_file_description),
+ ("20230321_agent_file_deleted", m20230321_agent_file_deleted, Just down_m20230321_agent_file_deleted)
]
-- | The list of migrations in ascending order by date
diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs
index 96197f129..5a6b53156 100644
--- a/tests/SchemaDump.hs
+++ b/tests/SchemaDump.hs
@@ -13,7 +13,7 @@ import qualified Simplex.Chat.Store as Store
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), closeSQLiteStore, createSQLiteStore, withConnection)
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..), MigrationsToRun (..), toDownMigration)
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
-import Simplex.Messaging.Util (ifM)
+import Simplex.Messaging.Util (ifM, whenM)
import System.Directory (doesFileExist, removeFile)
import System.Process (readCreateProcess, shell)
import Test.Hspec
@@ -47,7 +47,7 @@ testSchemaMigrations = withTmpFiles $ do
mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations
closeSQLiteStore st
removeFile testDB
- removeFile testSchema
+ whenM (doesFileExist testSchema) $ removeFile testSchema
where
testDownMigration st m = do
putStrLn $ "down migration " <> name m