From fbc25b171e7f59ba25981cc6a04bcec219534f43 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 10 Apr 2024 23:02:48 +0100
Subject: [PATCH] xftp: reply ERR AUTH when file is removed from server storage
 (#1091)

---
 src/Simplex/FileTransfer/Server.hs | 26 ++++++++++++++------------
 tests/XFTPAgent.hs                 |  5 +++--
 2 files changed, 17 insertions(+), 14 deletions(-)

diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs
index 7ea96cabc..b426360ea 100644
--- a/src/Simplex/FileTransfer/Server.hs
+++ b/src/Simplex/FileTransfer/Server.hs
@@ -456,18 +456,20 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
     sendServerFile :: FileRec -> RcvPublicDhKey -> M (FileResponse, Maybe ServerFile)
     sendServerFile FileRec {senderId, filePath, fileInfo = FileInfo {size}} rDhKey = do
       readTVarIO filePath >>= \case
-        Just path -> do
-          g <- asks random
-          (sDhKey, spDhKey) <- atomically $ C.generateKeyPair g
-          let dhSecret = C.dh' rDhKey spDhKey
-          cbNonce <- atomically $ C.randomCbNonce g
-          case LC.cbInit dhSecret cbNonce of
-            Right sbState -> do
-              stats <- asks serverStats
-              atomically $ modifyTVar' (fileDownloads stats) (+ 1)
-              atomically $ updatePeriodStats (filesDownloaded stats) senderId
-              pure (FRFile sDhKey cbNonce, Just ServerFile {filePath = path, fileSize = size, sbState})
-            _ -> pure (FRErr INTERNAL, Nothing)
+        Just path -> ifM (doesFileExist path) sendFile (pure (FRErr AUTH, Nothing))
+          where
+            sendFile = do
+              g <- asks random
+              (sDhKey, spDhKey) <- atomically $ C.generateKeyPair g
+              let dhSecret = C.dh' rDhKey spDhKey
+              cbNonce <- atomically $ C.randomCbNonce g
+              case LC.cbInit dhSecret cbNonce of
+                Right sbState -> do
+                  stats <- asks serverStats
+                  atomically $ modifyTVar' (fileDownloads stats) (+ 1)
+                  atomically $ updatePeriodStats (filesDownloaded stats) senderId
+                  pure (FRFile sDhKey cbNonce, Just ServerFile {filePath = path, fileSize = size, sbState})
+                _ -> pure (FRErr INTERNAL, Nothing)
         _ -> pure (FRErr NO_FILE, Nothing)
 
     deleteServerFile :: FileRec -> M FileResponse
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index a4e6c8d48..2d865f140 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -543,8 +543,9 @@ testXFTPAgentDeleteOnServer = withGlobalLogging logCfgNoLogs $
 
         runRight_ . void $ do
           -- receive file 1 again
-          -- TODO should fail with AUTH error
-          _rfId1 <- xftpReceiveFile rcp 1 rfd1_2 Nothing
+          rfId1 <- xftpReceiveFile rcp 1 rfd1_2 Nothing
+          ("", rfId1', RFERR (INTERNAL "XFTP {xftpErr = AUTH}")) <- rfGet rcp
+          liftIO $ rfId1 `shouldBe`  rfId1'
 
           -- receive file 2
           testReceive' rcp rfd2 filePath2