diff --git a/cabal.project b/cabal.project index 354d04277c..b3943d9906 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 974347c1fc..1bf57f9bab 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 f25ff03e65..782dfc74f2 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 d3044b267a..7464c1f3aa 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 0000000000..15a08febfe --- /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 1e36360b4c..68ebe73e2d 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 492dc0ad1c..be444e545a 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 5140ca7f70..d0fc6acf1f 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 c4fbfa1300..4bca20bc3b 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 0cbf147968..4ea3e9ef5a 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}