dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-04-26 10:58:02 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: delete xftp file when user is not found by file id (#2234)

Browse Source
This commit is contained in:
spaced4ndy
2023-04-25 15:46:00 +04:00
committed by GitHub
parent f5c87fdd4c
commit a9957fb46d
4 changed files with 19 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
src/Simplex/Chat.hs
View File

@@ -1446,7 +1446,7 @@ processChatCommand = \case
fsFilePath <- toFSFilePath filePath
removeFile fsFilePath `E.catch` \(_ :: E.SomeException) -> pure ()
forM_ agentRcvFileId $ \(AgentRcvFileId aFileId) ->
withAgent $ \a -> xftpDeleteRcvFile a (aUserId user) aFileId
withAgent (`xftpDeleteRcvFile` aFileId)
ci <- withStore $ \db -> do
liftIO $ do
updateCIFileStatus db user fileId CIFSRcvInvitation
@@ -2362,7 +2362,9 @@ processAgentMsgSndFile :: forall m. ChatMonad m => ACorrId -> SndFileId -> AComm
processAgentMsgSndFile _corrId aFileId msg =
withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case
Just user -> process user `catchError` (toView . CRChatError (Just user))
_ -> throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId
_ -> do
withAgent (`xftpDeleteSndFileInternal` aFileId)
throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId
where
process :: User -> m ()
process user = do
@@ -2390,7 +2392,7 @@ processAgentMsgSndFile _corrId aFileId msg =
withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
agentXFTPDeleteSndFileInternal user aFileId
withAgent (`xftpDeleteSndFileInternal` aFileId)
(_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
ms <- withStore' $ \db -> getGroupMembers db user g
let rfdsMemberFTs = zip rfds $ memberFTs ms
@@ -2400,7 +2402,7 @@ processAgentMsgSndFile _corrId aFileId msg =
ci' <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId CIFSSndComplete
getChatItemByFileId db user fileId
agentXFTPDeleteSndFileInternal user aFileId
withAgent (`xftpDeleteSndFileInternal` aFileId)
toView $ CRSndFileCompleteXFTP user ci' ft
where
memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
@@ -2424,7 +2426,7 @@ processAgentMsgSndFile _corrId aFileId msg =
ci <- withStore $ \db -> do
liftIO $ updateFileCancelled db user fileId CIFSSndError
getChatItemByFileId db user fileId
agentXFTPDeleteSndFileInternal user aFileId
withAgent (`xftpDeleteSndFileInternal` aFileId)
toView $ CRSndFileError user ci
where
fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text
@@ -2449,7 +2451,9 @@ processAgentMsgRcvFile :: forall m. ChatMonad m => ACorrId -> RcvFileId -> AComm
processAgentMsgRcvFile _corrId aFileId msg =
withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case
Just user -> process user `catchError` (toView . CRChatError (Just user))
_ -> throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId
_ -> do
withAgent (`xftpDeleteRcvFile` aFileId)
throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId
where
process :: User -> m ()
process user = do
@@ -2474,7 +2478,7 @@ processAgentMsgRcvFile _corrId aFileId msg =
updateRcvFileStatus db fileId FSComplete
updateCIFileStatus db user fileId CIFSRcvComplete
getChatItemByFileId db user fileId
agentXFTPDeleteRcvFile user aFileId fileId
agentXFTPDeleteRcvFile aFileId fileId
toView $ CRRcvFileComplete user ci
RFERR e
| temporaryAgentError e ->
@@ -2483,7 +2487,7 @@ processAgentMsgRcvFile _corrId aFileId msg =
ci <- withStore $ \db -> do
liftIO $ updateFileCancelled db user fileId CIFSRcvError
getChatItemByFileId db user fileId
agentXFTPDeleteRcvFile user aFileId fileId
agentXFTPDeleteRcvFile aFileId fileId
toView $ CRRcvFileError user ci
processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
@@ -4039,7 +4043,7 @@ cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInlin
deleteRcvFileChunks db ft
case xftpRcvFile of
Just XFTPRcvFile {agentRcvFileId = Just (AgentRcvFileId aFileId), agentRcvFileDeleted} ->
unless agentRcvFileDeleted $ agentXFTPDeleteRcvFile user aFileId fileId
unless agentRcvFileDeleted $ agentXFTPDeleteRcvFile aFileId fileId
_ -> pure ()
pure fileConnId
fileConnId = if isNothing xftpRcvFile && isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing
@@ -4297,15 +4301,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
agentXFTPDeleteRcvFile :: ChatMonad m => RcvFileId -> FileTransferId -> m ()
agentXFTPDeleteRcvFile aFileId fileId = do
withAgent (`xftpDeleteRcvFile` aFileId)
withStore' $ \db -> setRcvFTAgentDeleted db fileId
agentXFTPDeleteSndFileInternal :: ChatMonad m => User -> SndFileId -> m ()
agentXFTPDeleteSndFileInternal user aFileId = do
withAgent (\a -> xftpDeleteSndFileInternal a (aUserId user) aFileId) `catchError` (toView . CRChatError (Just user))
agentXFTPDeleteSndFileRemote :: ChatMonad m => User -> XFTPSndFile -> FileTransferId -> m ()
agentXFTPDeleteSndFileRemote user XFTPSndFile {agentSndFileId = AgentSndFileId aFileId, privateSndFileDescr, agentSndFileDeleted} fileId =
unless agentSndFileDeleted $