From 29eb9e4e27e09a358da8092b652192277e4fd02e Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 13 Apr 2023 20:04:23 +0400
Subject: [PATCH] xftp: test additional recipient IDs are requested when number
 of recipients exceeds maximum per request (#723)

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

diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index aacd4656d..f57c88413 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -39,6 +39,7 @@ xftpAgentTests = around_ testBracket . describe "Functional API" $ do
   it "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 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
     let srv1 = testXFTPServer2 {keyHash = "1234"}
@@ -330,6 +331,34 @@ testXFTPAgentDelete = withGlobalLogging logCfgNoLogs $
       ("", rfId', RFERR (INTERNAL "XFTP {xftpErr = AUTH}")) <- rfGet rcp2
       liftIO $ rfId' `shouldBe` rfId
 
+testXFTPAgentRequestAdditionalRecipientIDs :: IO ()
+testXFTPAgentRequestAdditionalRecipientIDs = withXFTPServer $ do
+  filePath <- createRandomFile
+
+  -- send file
+  sndr <- getSMPAgentClient' agentCfg initAgentServers testDB
+  rfds <- runRight $ do
+    xftpStartWorkers sndr (Just senderFiles)
+    sfId <- xftpSendFile sndr 1 filePath 500
+    sfProgress sndr $ mb 18
+    ("", sfId', SFDONE _sndDescr rfds) <- sfGet sndr
+    liftIO $ do
+      sfId' `shouldBe` sfId
+      length rfds `shouldBe` 500
+    pure rfds
+
+  -- receive file using different descriptions
+  -- ! revise number of recipients and indexes if xftpMaxRecipientsPerRequest is changed
+  testReceive' (head rfds) filePath
+  testReceive' (rfds !! 99) filePath
+  testReceive' (rfds !! 299) filePath
+  testReceive' (rfds !! 499) filePath
+  where
+    testReceive' rfd originalFilePath = do
+      rcp <- getSMPAgentClient' agentCfg initAgentServers testDB
+      runRight_ $
+        void $ testReceive rcp rfd originalFilePath
+
 testXFTPServerTest :: Maybe BasicAuth -> XFTPServerWithAuth -> IO (Maybe ProtocolTestFailure)
 testXFTPServerTest newFileBasicAuth srv =
   withXFTPServerCfg testXFTPServerConfig {newFileBasicAuth, xftpPort = xftpTestPort2} $ \_ -> do