From 23cecc7b680f64f67ee82f08fd9f9e2d36bd0015 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Mon, 17 Apr 2023 13:34:58 +0400
Subject: [PATCH] xftp: test file deletion restores after restart (#727)

---
 tests/XFTPAgent.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)

diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index 6de4b85cc..44e7b0860 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -40,6 +40,7 @@ xftpAgentTests = around_ testBracket . describe "Functional API" $ do
   xit'' "should resume sending file after restart" testXFTPAgentSendRestore
   it "should cleanup snd prefix path after permanent error" testXFTPAgentSendCleanup
   it "should delete sent file on server" testXFTPAgentDelete
+  it "should resume deleting file after restart" testXFTPAgentDeleteRestore
   it "should request additional recipient IDs when number of recipients exceeds maximum per request" testXFTPAgentRequestAdditionalRecipientIDs
   describe "XFTP server test via agent API" $ do
     it "should pass without basic auth" $ testXFTPServerTest Nothing (noAuthSrv testXFTPServer2) `shouldReturn` Nothing
@@ -332,6 +333,49 @@ testXFTPAgentDelete = withGlobalLogging logCfgNoLogs $
       ("", rfId', RFERR (INTERNAL "XFTP {xftpErr = AUTH}")) <- rfGet rcp2
       liftIO $ rfId' `shouldBe` rfId
 
+testXFTPAgentDeleteRestore :: IO ()
+testXFTPAgentDeleteRestore = withGlobalLogging logCfgNoLogs $ do
+  filePath <- createRandomFile
+
+  (sfId, sndDescr, rfd2) <- withXFTPServerStoreLogOn $ \_ -> do
+    -- send file
+    sndr <- getSMPAgentClient' agentCfg initAgentServers testDB
+    (sfId, sndDescr, rfd1, rfd2) <- runRight $ testSend sndr filePath
+
+    -- receive file
+    rcp1 <- getSMPAgentClient' agentCfg initAgentServers testDB
+    runRight_ $
+      void $ testReceive rcp1 rfd1 filePath
+
+    pure (sfId, sndDescr, rfd2)
+
+  -- delete file - should not succeed with server down
+  sndr <- getSMPAgentClient' agentCfg initAgentServers testDB
+  runRight $ do
+    xftpStartWorkers sndr (Just senderFiles)
+    xftpDeleteSndFileRemote sndr 1 sfId sndDescr
+    liftIO $ timeout 300000 (get sndr) `shouldReturn` Nothing -- wait for worker attempt
+  disconnectAgentClient sndr
+
+  threadDelay 300000
+  length <$> listDirectory xftpServerFiles `shouldReturn` 6
+
+  withXFTPServerStoreLogOn $ \_ -> do
+    -- delete file - should succeed with server up
+    sndr' <- getSMPAgentClient' agentCfg initAgentServers testDB
+    runRight_ $ xftpStartWorkers sndr' (Just senderFiles)
+
+    threadDelay 1000000
+    length <$> listDirectory xftpServerFiles `shouldReturn` 0
+
+    -- receive file - should fail with AUTH error
+    rcp2 <- getSMPAgentClient' agentCfg initAgentServers testDB
+    runRight $ do
+      xftpStartWorkers rcp2 (Just recipientFiles)
+      rfId <- xftpReceiveFile rcp2 1 rfd2
+      ("", rfId', RFERR (INTERNAL "XFTP {xftpErr = AUTH}")) <- rfGet rcp2
+      liftIO $ rfId' `shouldBe` rfId
+
 testXFTPAgentRequestAdditionalRecipientIDs :: IO ()
 testXFTPAgentRequestAdditionalRecipientIDs = withXFTPServer $ do
   filePath <- createRandomFile