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

2025-06-29 04:39:53 +00:00 · 2023-04-25 15:46:00 +04:00 · 2023-04-25 15:46:00 +04:00 · a9957fb46d
commit a9957fb46d
parent f5c87fdd4c
4 changed files with 19 additions and 19 deletions
--- 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: 4da637a565bb8eff3e4e0fd940f9fdd34ce981e7
+    tag: af3f70829dca2483425eb8702cd9aeac2c026e14

 source-repository-package
    type: git
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."4da637a565bb8eff3e4e0fd940f9fdd34ce981e7" = "1z8vrd91mm9p6hswvihn16xkn45ph6ndmbpq787hzld8kqicaddx";
+  "https://github.com/simplex-chat/simplexmq.git"."af3f70829dca2483425eb8702cd9aeac2c026e14" = "1ngngzqz6fjr11dk2v3d1wrfkyyac954a0fswhq27pfhapqdhlw0";
  "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
  "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
  "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@ -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 $
--- 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: 4da637a565bb8eff3e4e0fd940f9fdd34ce981e7
+    commit: af3f70829dca2483425eb8702cd9aeac2c026e14
  - github: kazu-yamamoto/http2
    commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
  # - ../direct-sqlcipher