diff --git a/cabal.project b/cabal.project index b9ddbd34d4..5da331e775 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 bb3d718135..6e1fc47a8c 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 f504230692..4c94150fb4 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 cbf66ef4c0..bf381218f6 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 d80afae622..1e60ead212 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 7f73be9dd4..8cfbe66cd6 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 f3e19e6c53..a6063f8e02 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