diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs index 4b92a90c1..e1f07ceb5 100644 --- a/src/Simplex/FileTransfer/Client/Main.hs +++ b/src/Simplex/FileTransfer/Client/Main.hs @@ -25,6 +25,7 @@ import Data.Bifunctor (first) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB +import Data.Char (toLower) import Data.Function (on) import Data.Int (Int64) import Data.List (foldl', groupBy, sortOn) @@ -101,14 +102,16 @@ data ReceiveOptions = ReceiveOptions filePath :: Maybe FilePath, retryCount :: Int, tempPath :: Maybe FilePath, - verbose :: Bool + verbose :: Bool, + yes :: Bool } deriving (Show) data DeleteOptions = DeleteOptions { fileDescription :: FilePath, retryCount :: Int, - verbose :: Bool + verbose :: Bool, + yes :: Bool } deriving (Show) @@ -165,12 +168,14 @@ cliCommandP = <*> retryCountP <*> temp <*> verboseP + <*> yesP deleteP :: Parser DeleteOptions deleteP = DeleteOptions <$> fileDescrArg <*> retryCountP <*> verboseP + <*> yesP infoP :: Parser InfoOptions infoP = InfoOptions <$> fileDescrArg randomP :: Parser RandomFileOptions @@ -182,6 +187,7 @@ cliCommandP = retryCountP = option auto (long "retry" <> short 'r' <> metavar "RETRY" <> help "Number of network retries" <> value defaultRetryCount <> showDefault) temp = optional (strOption $ long "tmp" <> metavar "TMP" <> help "Directory for temporary encrypted file (default: system temp directory)") verboseP = switch (long "verbose" <> short 'v' <> help "Verbose output") + yesP = switch (long "yes" <> short 'y' <> help "Yes to questions") xftpServers = option parseXFTPServers @@ -272,10 +278,9 @@ cliSendFile SendOptions {filePath, outputDir, numRecipients, xftpServers, retryC fdSnd' = createSndFileDescription fdSnd sentChunks (fdRcvPaths, fdSndPath) <- writeFileDescriptions fileName fdRcvs fdSnd' printNoNewLine "File uploaded!" - putStrLn "\nPass file descriptions to the recipient(s):" + putStrLn $ "\nSender file description: " <> fdSndPath + putStrLn "Pass file descriptions to the recipient(s):" forM_ fdRcvPaths putStrLn - putStrLn "Sender file description:" - putStrLn fdSndPath where encryptFile :: String -> ExceptT CLIError IO (FilePath, FileDescription 'FPRecipient, FileDescription 'FPSender, [XFTPChunkSpec], Int64) encryptFile fileName = do @@ -410,7 +415,7 @@ cliSendFile SendOptions {filePath, outputDir, numRecipients, xftpServers, retryC pure (fdRcvPaths, fdSndPath) cliReceiveFile :: ReceiveOptions -> ExceptT CLIError IO () -cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath, verbose} = +cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath, verbose, yes} = getFileDescription' fileDescription >>= receiveFile where receiveFile :: ValidFileDescription 'FPRecipient -> ExceptT CLIError IO () @@ -430,8 +435,9 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath, path <- decryptFile encSize chunkPaths key nonce forM_ chunks $ acknowledgeFileChunk a whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath - liftIO $ printNoNewLine $ "File downloaded: " <> path - liftIO $ putStrLn "\nFile description can't be used again" + liftIO $ do + printNoNewLine $ "File downloaded: " <> path + removeFD yes fileDescription downloadFileChunk :: XFTPClientAgent -> FilePath -> FileSize Int64 -> TVar [Int64] -> FileChunk -> ExceptT CLIError IO (Int, FilePath) downloadFileChunk a encPath (FileSize encSize) downloadedChunks FileChunk {chunkNo, chunkSize, digest, replicas = replica : _} = do let FileChunkReplica {server, replicaId, replicaKey} = replica @@ -489,14 +495,16 @@ printNoNewLine s = do hFlush stdout cliDeleteFile :: DeleteOptions -> ExceptT CLIError IO () -cliDeleteFile DeleteOptions {fileDescription, retryCount} = do +cliDeleteFile DeleteOptions {fileDescription, retryCount, yes} = do getFileDescription' fileDescription >>= deleteFile where deleteFile :: ValidFileDescription 'FPSender -> ExceptT CLIError IO () deleteFile (ValidFileDescription FileDescription {chunks}) = do a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig forM_ chunks $ deleteFileChunk a - liftIO $ putStrLn "File deleted" + liftIO $ do + printNoNewLine "File deleted!" + removeFD yes fileDescription deleteFileChunk :: XFTPClientAgent -> FileChunk -> ExceptT CLIError IO () deleteFileChunk a FileChunk {chunkNo, replicas = replica : _} = do let FileChunkReplica {server, replicaId, replicaKey} = replica @@ -588,6 +596,26 @@ withRetry retryCount = withRetry' retryCount . withExceptT (CLIError . show) logWarn ("retrying: " <> tshow e) withRetry' (n - 1) a +removeFD :: Bool -> FilePath -> IO () +removeFD yes fd + | yes = do + removeFile fd + putStrLn $ "\nFile description " <> fd <> " is deleted." + | otherwise = do + y <- liftIO . getConfirmation $ "\nFile description " <> fd <> " can't be used again. Delete it" + when y $ removeFile fd + +getConfirmation :: String -> IO Bool +getConfirmation prompt = do + putStr $ prompt <> " (Y/n): " + hFlush stdout + s <- getLine + case map toLower s of + "y" -> pure True + "" -> pure True + "n" -> pure False + _ -> getConfirmation prompt + cliRandomFile :: RandomFileOptions -> IO () cliRandomFile RandomFileOptions {filePath, fileSize = FileSize size} = do withFile filePath WriteMode (`saveRandomFile` size) diff --git a/tests/XFTPCLI.hs b/tests/XFTPCLI.hs index 535b3ebb9..2789bbcc5 100644 --- a/tests/XFTPCLI.hs +++ b/tests/XFTPCLI.hs @@ -45,11 +45,10 @@ testXFTPCLISendReceive = withXFTPServer $ do progress : sendResult <- xftp ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr, "--tmp=tests/tmp"] progress `shouldSatisfy` uploadProgress sendResult - `shouldBe` [ "Pass file descriptions to the recipient(s):", + `shouldBe` [ "Sender file description: " <> fdSnd, + "Pass file descriptions to the recipient(s):", fdRcv1, - fdRcv2, - "Sender file description:", - fdSnd + fdRcv2 ] testInfoFile fdRcv1 "Recipient" testReceiveFile fdRcv1 "testfile" file @@ -64,9 +63,9 @@ testXFTPCLISendReceive = withXFTPServer $ do xftp ["info", fd] `shouldReturn` [party <> " file description", "File download size: 18mb", "File server(s):", testXFTPServerStr <> ": 18mb"] testReceiveFile fd fileName file = do - progress : recvResult <- xftp ["recv", fd, recipientFiles, "--tmp=tests/tmp"] + progress : recvResult <- xftp ["recv", fd, recipientFiles, "--tmp=tests/tmp", "-y"] progress `shouldSatisfy` downloadProgress fileName - recvResult `shouldBe` ["File description can't be used again"] + recvResult `shouldBe` ["File description " <> fd <> " is deleted."] LB.readFile (recipientFiles fileName) `shouldReturn` file testXFTPCLISendReceive2servers :: IO () @@ -81,11 +80,10 @@ testXFTPCLISendReceive2servers = withXFTPServer . withXFTPServer2 $ do progress : sendResult <- xftp ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=tests/tmp"] progress `shouldSatisfy` uploadProgress sendResult - `shouldBe` [ "Pass file descriptions to the recipient(s):", + `shouldBe` [ "Sender file description: " <> fdSnd, + "Pass file descriptions to the recipient(s):", fdRcv1, - fdRcv2, - "Sender file description:", - fdSnd + fdRcv2 ] testReceiveFile fdRcv1 "testfile" file testReceiveFile fdRcv2 "testfile_1" file @@ -102,9 +100,9 @@ testXFTPCLISendReceive2servers = withXFTPServer . withXFTPServer2 $ do srv1 `shouldContain` testXFTPServerStr srv2 `shouldContain` testXFTPServerStr2 _ -> print srvs >> error "more than 2 servers returned" - progress : recvResult <- xftp ["recv", fd, recipientFiles, "--tmp=tests/tmp"] + progress : recvResult <- xftp ["recv", fd, recipientFiles, "--tmp=tests/tmp", "-y"] progress `shouldSatisfy` downloadProgress fileName - recvResult `shouldBe` ["File description can't be used again"] + recvResult `shouldBe` ["File description " <> fd <> " is deleted."] LB.readFile (recipientFiles fileName) `shouldReturn` file testXFTPCLIDelete :: IO () @@ -119,23 +117,22 @@ testXFTPCLIDelete = withXFTPServer . withXFTPServer2 $ do progress : sendResult <- xftp ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=tests/tmp"] progress `shouldSatisfy` uploadProgress sendResult - `shouldBe` [ "Pass file descriptions to the recipient(s):", + `shouldBe` [ "Sender file description: " <> fdSnd, + "Pass file descriptions to the recipient(s):", fdRcv1, - fdRcv2, - "Sender file description:", - fdSnd + fdRcv2 ] xftp ["del", fdRcv1] `shouldThrow` anyException - progress1 : recvResult <- xftp ["recv", fdRcv1, recipientFiles, "--tmp=tests/tmp"] + progress1 : recvResult <- xftp ["recv", fdRcv1, recipientFiles, "--tmp=tests/tmp", "-y"] progress1 `shouldSatisfy` downloadProgress "testfile" - recvResult `shouldBe` ["File description can't be used again"] + 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 - xftp ["del", fdSnd] - `shouldReturn` ["File deleted"] + xftp ["del", fdSnd, "-y"] + `shouldReturn` ["File deleted! \r", "File description " <> fdSnd <> " is deleted."] listDirectory xftpServerFiles >>= (`shouldBe` []) listDirectory xftpServerFiles2 >>= (`shouldBe` []) xftp ["recv", fdRcv2, recipientFiles, "--tmp=tests/tmp"]