mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-30 16:26:02 +00:00
xftp: test file deletion restores after restart (#727)
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user