module XFTPCLI (xftpCLIFileTests, xftpCLI, senderFiles, recipientFiles, testBracket) where import Control.Exception (bracket_, try) import qualified Data.ByteString as LB import Data.List (isInfixOf, isPrefixOf, isSuffixOf) import Simplex.FileTransfer.Client.Main ( prepareChunkSizes, xftpClientCLI, xftpClientDeprecationNotice, ) import Simplex.FileTransfer.Description (kb, mb) import System.Directory (createDirectoryIfMissing, getFileSize, listDirectory, removeDirectoryRecursive) import System.Environment (withArgs) import System.Exit (ExitCode (ExitSuccess)) import System.FilePath (()) import System.IO.Silently (capture, capture_) import Test.Hspec hiding (fit, it) import Util import Simplex.FileTransfer.Server.Env (AFStoreType) import XFTPClient (cfgFS, cfgFS2, withXFTPServer, withXFTPServerConfigOn, testXFTPServerStr, testXFTPServerStr2, xftpServerFiles, xftpServerFiles2) xftpCLIFileTests :: SpecWith AFStoreType xftpCLIFileTests = around_ testBracket $ do it "shows experimental deprecation notice in help" $ \_ -> testXFTPCLIHelpDeprecationNotice it "should send and receive file" $ withXFTPServer testXFTPCLISendReceive_ it "should send and receive file with 2 servers" $ \fsType -> withXFTPServerConfigOn (cfgFS fsType) $ \_ -> withXFTPServerConfigOn (cfgFS2 fsType) $ \_ -> testXFTPCLISendReceive2servers_ it "should delete file from 2 servers" $ \fsType -> withXFTPServerConfigOn (cfgFS fsType) $ \_ -> withXFTPServerConfigOn (cfgFS2 fsType) $ \_ -> testXFTPCLIDelete_ it "prepareChunkSizes should use 2 chunk sizes" $ \_ -> testPrepareChunkSizes testBracket :: IO () -> IO () testBracket = bracket_ (mapM_ (createDirectoryIfMissing False) testDirs) (mapM_ removeDirectoryRecursive testDirs) where testDirs = [xftpServerFiles, xftpServerFiles2, senderFiles, recipientFiles] senderFiles :: FilePath senderFiles = "tests/tmp/xftp-sender-files" recipientFiles :: FilePath recipientFiles = "tests/tmp/xftp-recipient-files" xftpCLI :: [String] -> IO [String] xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI) testXFTPCLIHelpDeprecationNotice :: IO () testXFTPCLIHelpDeprecationNotice = do (output, result) <- capture $ try $ withArgs ["--help"] xftpClientCLI result `shouldBe` (Left ExitSuccess :: Either ExitCode ()) unwords (words output) `shouldSatisfy` (xftpClientDeprecationNotice `isInfixOf`) testXFTPCLISendReceive_ :: IO () testXFTPCLISendReceive_ = do let filePath = senderFiles "testfile" xftpCLI ["rand", filePath, "17mb"] `shouldReturn` ["File created: " <> filePath] file <- LB.readFile filePath getFileSize filePath `shouldReturn` mb 17 let fdRcv1 = filePath <> ".xftp" "rcv1.xftp" fdRcv2 = filePath <> ".xftp" "rcv2.xftp" fdSnd = filePath <> ".xftp" "snd.xftp.private" progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr, "--tmp=tests/tmp"] progress `shouldSatisfy` uploadProgress let (sendInfo, sendRest) = splitAt 4 sendResult sendInfo `shouldBe` [ "Sender file description: " <> fdSnd, "Pass file descriptions to the recipient(s):", fdRcv1, fdRcv2 ] sendRest `shouldSatisfy` any ("https://" `isPrefixOf`) testInfoFile fdRcv1 "Recipient" testReceiveFile fdRcv1 "testfile" file testInfoFile fdRcv2 "Recipient" testReceiveFile fdRcv2 "testfile_1" file testInfoFile fdSnd "Sender" xftpCLI ["recv", fdSnd, recipientFiles, "--tmp=tests/tmp"] `shouldThrow` anyException where testInfoFile fd party = do xftpCLI ["info", fd] `shouldReturn` [party <> " file description", "File download size: 18mb", "File server(s):", testXFTPServerStr <> ": 18mb"] testReceiveFile fd fileName file = do progress : recvResult <- xftpCLI ["recv", fd, recipientFiles, "--tmp=tests/tmp", "-y"] progress `shouldSatisfy` downloadProgress fileName recvResult `shouldBe` ["File description " <> fd <> " is deleted."] LB.readFile (recipientFiles fileName) `shouldReturn` file testXFTPCLISendReceive2servers_ :: IO () testXFTPCLISendReceive2servers_ = do let filePath = senderFiles "testfile" xftpCLI ["rand", filePath, "17mb"] `shouldReturn` ["File created: " <> filePath] file <- LB.readFile filePath getFileSize filePath `shouldReturn` mb 17 let fdRcv1 = filePath <> ".xftp" "rcv1.xftp" fdRcv2 = filePath <> ".xftp" "rcv2.xftp" fdSnd = filePath <> ".xftp" "snd.xftp.private" progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=tests/tmp"] progress `shouldSatisfy` uploadProgress let (sendInfo, sendRest) = splitAt 4 sendResult sendInfo `shouldBe` [ "Sender file description: " <> fdSnd, "Pass file descriptions to the recipient(s):", fdRcv1, fdRcv2 ] sendRest `shouldSatisfy` any ("https://" `isPrefixOf`) testReceiveFile fdRcv1 "testfile" file testReceiveFile fdRcv2 "testfile_1" file where testReceiveFile fd fileName file = do partyStr : sizeStr : srvStr : srvs <- xftpCLI ["info", fd] partyStr `shouldContain` "Recipient file description" sizeStr `shouldBe` "File download size: 18mb" srvStr `shouldBe` "File server(s):" case srvs of [srv1] -> any (`isInfixOf` srv1) [testXFTPServerStr, testXFTPServerStr2] `shouldBe` True [srv1, srv2] -> do srv1 `shouldContain` testXFTPServerStr srv2 `shouldContain` testXFTPServerStr2 _ -> print srvs >> error "more than 2 servers returned" progress : recvResult <- xftpCLI ["recv", fd, recipientFiles, "--tmp=tests/tmp", "-y"] progress `shouldSatisfy` downloadProgress fileName recvResult `shouldBe` ["File description " <> fd <> " is deleted."] LB.readFile (recipientFiles fileName) `shouldReturn` file testXFTPCLIDelete_ :: IO () testXFTPCLIDelete_ = do let filePath = senderFiles "testfile" xftpCLI ["rand", filePath, "17mb"] `shouldReturn` ["File created: " <> filePath] file <- LB.readFile filePath getFileSize filePath `shouldReturn` mb 17 let fdRcv1 = filePath <> ".xftp" "rcv1.xftp" fdRcv2 = filePath <> ".xftp" "rcv2.xftp" fdSnd = filePath <> ".xftp" "snd.xftp.private" progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=tests/tmp"] progress `shouldSatisfy` uploadProgress let (sendInfo, sendRest) = splitAt 4 sendResult sendInfo `shouldBe` [ "Sender file description: " <> fdSnd, "Pass file descriptions to the recipient(s):", fdRcv1, fdRcv2 ] sendRest `shouldSatisfy` any ("https://" `isPrefixOf`) xftpCLI ["del", fdRcv1] `shouldThrow` anyException progress1 : recvResult <- xftpCLI ["recv", fdRcv1, recipientFiles, "--tmp=tests/tmp", "-y"] progress1 `shouldSatisfy` downloadProgress "testfile" recvResult `shouldBe` ["File description " <> fdRcv1 <> " is deleted."] LB.readFile (recipientFiles "testfile") `shouldReturn` file fs1 <- listDirectory xftpServerFiles fs2 <- listDirectory xftpServerFiles2 length fs1 + length fs2 `shouldBe` 6 xftpCLI ["del", fdSnd, "-y"] `shouldReturn` ["File deleted! \r", "File description " <> fdSnd <> " is deleted."] listDirectory xftpServerFiles >>= (`shouldBe` []) listDirectory xftpServerFiles2 >>= (`shouldBe` []) xftpCLI ["recv", fdRcv2, recipientFiles, "--tmp=tests/tmp"] `shouldThrow` anyException testPrepareChunkSizes :: IO () testPrepareChunkSizes = do prepareChunkSizes (mb 9 + kb 256) `shouldBe` [mb 4, mb 4, mb 1, mb 1] prepareChunkSizes (mb 9) `shouldBe` [mb 4, mb 4, mb 1] prepareChunkSizes (mb 7 + 1) `shouldBe` [mb 4, mb 4] prepareChunkSizes (mb 7) `shouldBe` [mb 4] <> r3 (mb 1) prepareChunkSizes (mb 3 + 1) `shouldBe` [mb 4] prepareChunkSizes (mb 3) `shouldBe` r3 (mb 1) prepareChunkSizes (mb 2 + 3 * kb 256 + 1) `shouldBe` r3 (mb 1) prepareChunkSizes (mb 2 + 3 * kb 256) `shouldBe` [mb 1, mb 1] <> r3 (kb 256) prepareChunkSizes (mb 2 + 1) `shouldBe` [mb 1, mb 1, kb 256] prepareChunkSizes (3 * kb 256 + 1) `shouldBe` [mb 1] prepareChunkSizes (3 * kb 256) `shouldBe` r3 (kb 256) prepareChunkSizes 1 `shouldBe` [kb 64] where r3 = replicate 3 uploadProgress :: String -> Bool uploadProgress s = "Encrypting file..." `isPrefixOf` s && "Uploading file..." `isInfixOf` s && "File uploaded!" `isInfixOf` s downloadProgress :: FilePath -> String -> Bool downloadProgress fileName s = "Downloading file..." `isPrefixOf` s && "Decrypting file..." `isInfixOf` s && ("File downloaded: " <> recipientFiles fileName <> "\r") `isSuffixOf` s