diff --git a/simplexmq.cabal b/simplexmq.cabal index 9ff4070e9..96c8a5e7f 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -516,6 +516,7 @@ test-suite simplexmq-test ServerTests SMPAgentClient SMPClient + XFTPCLI XFTPClient XFTPServerTests Paths_simplexmq diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs index 3bd5991fe..586c8290c 100644 --- a/src/Simplex/FileTransfer/Client/Main.hs +++ b/src/Simplex/FileTransfer/Client/Main.hs @@ -28,6 +28,7 @@ import Options.Applicative import Simplex.FileTransfer.Client import Simplex.FileTransfer.Client.Agent import Simplex.FileTransfer.Description +import Simplex.FileTransfer.Description (FileSize (unFileSize)) import Simplex.FileTransfer.Protocol (FileInfo (..)) import Simplex.Messaging.Agent.Lock import qualified Simplex.Messaging.Crypto as C @@ -70,6 +71,7 @@ data CliCommand = SendFile SendOptions | ReceiveFile ReceiveOptions | RandomFile RandomFileOptions + | FileDescrInfo InfoOptions data SendOptions = SendOptions { filePath :: FilePath, @@ -89,6 +91,11 @@ data ReceiveOptions = ReceiveOptions } deriving (Show) +newtype InfoOptions = InfoOptions + { fileDescription :: FilePath + } + deriving (Show) + data RandomFileOptions = RandomFileOptions { filePath :: FilePath, fileSize :: FileSize Int @@ -106,6 +113,7 @@ cliCommandP = hsubparser ( command "send" (info (SendFile <$> sendP) (progDesc "Send file")) <> command "recv" (info (ReceiveFile <$> receiveP) (progDesc "Receive file")) + <> command "info" (info (FileDescrInfo <$> infoP) (progDesc "Show file description")) <> command "rand" (info (RandomFile <$> randomP) (progDesc "Generate a random file of a given size")) ) where @@ -121,18 +129,21 @@ cliCommandP = receiveP :: Parser ReceiveOptions receiveP = ReceiveOptions - <$> argument str (metavar "FILE" <> help "File description file") + <$> fileDescrArg <*> optional (argument str $ metavar "DIR" <> help "Directory to save file (default: system Downloads directory)") <*> retries <*> temp + infoP :: Parser InfoOptions + infoP = InfoOptions <$> fileDescrArg randomP :: Parser RandomFileOptions randomP = RandomFileOptions <$> argument str (metavar "FILE" <> help "Path to save file") <*> argument strDec (metavar "SIZE" <> help "File size (bytes/kb/mb)") strDec = eitherReader $ strDecode . B.pack + fileDescrArg = argument str (metavar "FILE" <> help "File description file") retries = option auto (long "retry" <> short 'r' <> metavar "RETRY" <> help "Number of network retries" <> value defaultRetryCount <> showDefault) - temp = optional (strOption $ long "temp" <> metavar "TEMP" <> help "Directory for temporary encrypted file (default: system temp directory)") + temp = optional (strOption $ long "tmp" <> metavar "TMP" <> help "Directory for temporary encrypted file (default: system temp directory)") xftpServers = option parseXFTPServers @@ -176,6 +187,7 @@ xftpClientCLI = getCliCommand' cliCommandP clientVersion >>= \case SendFile opts -> runE $ cliSendFile opts ReceiveFile opts -> runE $ cliReceiveFile opts + FileDescrInfo opts -> runE $ cliFileDescrInfo opts RandomFile opts -> cliRandomFile opts where clientVersion = "SimpleX XFTP client v" <> xftpClientVersion @@ -206,7 +218,10 @@ cliSendFile SendOptions {filePath, outputDir, numRecipients, xftpServers, retryC sentChunks <- uploadFile chunkSpecs whenM (doesFileExist encPath) $ removeFile encPath -- TODO if only small chunks, use different default size - liftIO $ writeFileDescriptions fileName $ createFileDescriptions fd sentChunks + liftIO $ do + fds <- writeFileDescriptions fileName $ createFileDescriptions fd sentChunks + putStrLn "File uploaded!\nPass file descriptions to the recipient(s):" + forM_ fds putStrLn where encryptFile :: String -> ExceptT CLIError IO (FilePath, FileDescription, [XFTPChunkSpec]) encryptFile fileName = do @@ -242,16 +257,17 @@ cliSendFile SendOptions {filePath, outputDir, numRecipients, xftpServers, retryC -- TODO unshuffle chunks pure $ map snd sentChunks where - retries = withRetry retryCount + retries :: Show e => ExceptT e IO a -> ExceptT CLIError IO a + retries = withRetry retryCount . withExceptT (CLIError . show) uploadFileChunk :: XFTPClientAgent -> TVar StdGen -> NonEmpty XFTPServer -> (Int, XFTPChunkSpec) -> ExceptT CLIError IO (Int, SentFileChunk) uploadFileChunk a gen srvs (chunkNo, chunkSpec@XFTPChunkSpec {chunkSize}) = do (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 rKeys <- liftIO $ L.fromList <$> replicateM numRecipients (C.generateSignatureKeyPair C.SEd25519) chInfo@FileInfo {digest} <- liftIO $ getChunkInfo sndKey chunkSpec xftpServer <- liftIO $ getXFTPServer gen srvs - c <- retries $ withExceptT (CLIError . show) $ getXFTPServerClient a xftpServer - (sndId, rIds) <- retries $ withExceptT (CLIError . show) $ createXFTPChunk c spKey chInfo $ L.map fst rKeys - retries $ withExceptT (CLIError . show) $ uploadXFTPChunk c spKey sndId chunkSpec + c <- retries $ getXFTPServerClient a xftpServer + (sndId, rIds) <- retries $ createXFTPChunk c spKey chInfo $ L.map fst rKeys + retries $ uploadXFTPChunk c spKey sndId chunkSpec let recipients = L.toList $ L.map ChunkReplicaId rIds `L.zip` L.map snd rKeys replicas = [SentFileChunkReplica {server = xftpServer, recipients}] pure (chunkNo, SentFileChunk {chunkNo, sndId, sndPrivateKey = spKey, chunkSize = FileSize $ fromIntegral chunkSize, digest = FileDigest digest, replicas}) @@ -302,18 +318,18 @@ cliSendFile SendOptions {filePath, outputDir, numRecipients, xftpServers, retryC Just ch@FileChunk {replicas} -> ch {replicas = replica : replicas} _ -> FileChunk {chunkNo, digest, chunkSize, replicas = [replica]} replica = FileChunkReplica {server, rcvId, rcvKey} - writeFileDescriptions :: String -> [FileDescription] -> IO () + writeFileDescriptions :: String -> [FileDescription] -> IO [FilePath] writeFileDescriptions fileName fds = do outDir <- uniqueCombine (fromMaybe "." outputDir) (fileName <> ".xftp") createDirectoryIfMissing True outDir - forM_ (zip [1 ..] fds) $ \(i, fd) -> do + forM (zip [1 ..] fds) $ \(i :: Int, fd) -> do let fdPath = outDir ("rcv" <> show i <> ".xftp") B.writeFile fdPath $ strEncode fd + pure fdPath cliReceiveFile :: ReceiveOptions -> ExceptT CLIError IO () cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath} = do - fd <- ExceptT $ first (CLIError . ("Failed to parse file description: " <>)) . strDecode <$> B.readFile fileDescription - ValidFileDescription FileDescription {size, digest, key, nonce, chunks} <- liftEither . first CLIError $ validateFileDescription fd + ValidFileDescription FileDescription {size, digest, key, nonce, chunks} <- getFileDescription fileDescription encPath <- getEncPath tempPath "xftp" -- withFile encPath WriteMode $ \h -> do -- liftIO $ LB.hPut h $ LB.replicate (unFileSize size) '#' @@ -326,21 +342,24 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath} downloadFileChunk a writeLock chunk chunkSpec encDigest <- liftIO $ LC.sha512Hash <$> LB.readFile encPath when (encDigest /= unFileDigest digest) $ throwError $ CLIError "File digest mismatch" - decryptFile encPath key nonce + path <- decryptFile encPath key nonce whenM (doesFileExist encPath) $ removeFile encPath + liftIO $ putStrLn $ "File received: " <> path where + retries :: Show e => ExceptT e IO a -> ExceptT CLIError IO a + retries = withRetry retryCount . withExceptT (CLIError . show) downloadFileChunk :: XFTPClientAgent -> Lock -> FileChunk -> XFTPChunkSpec -> ExceptT CLIError IO () downloadFileChunk a writeLock FileChunk {replicas = replica : _} chunkSpec = do let FileChunkReplica {server, rcvId, rcvKey} = replica - c <- withRetry retryCount $ withExceptT (CLIError . show) $ getXFTPServerClient a server + c <- retries $ getXFTPServerClient a server (rKey, rpKey) <- liftIO C.generateKeyPair' - (sKey, body) <- withRetry retryCount $ withExceptT (CLIError . show) $ downloadXFTPChunk c rcvKey (unChunkReplicaId rcvId) rKey + (sKey, body) <- retries $ downloadXFTPChunk c rcvKey (unChunkReplicaId rcvId) rKey -- download and decrypt (DH) chunk from server using XFTPClient -- verify chunk digest - in the client -- save to correct location in file - also in the client - withRetry retryCount $ withExceptT (CLIError . show) $ withLock writeLock "save" $ receiveXFTPChunk body chunkSpec + retries $ withLock writeLock "save" $ receiveXFTPChunk body chunkSpec downloadFileChunk _ _ _ _ = pure () - decryptFile :: FilePath -> C.SbKey -> C.CbNonce -> ExceptT CLIError IO () + decryptFile :: FilePath -> C.SbKey -> C.CbNonce -> ExceptT CLIError IO FilePath decryptFile encPath key nonce = do f <- liftIO $ LB.readFile encPath f' <- liftEither $ first (CLIError . show) $ LC.sbDecrypt key nonce f @@ -353,6 +372,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath} A.Done rest FileHeader {fileName} -> do path <- getFilePath fileName liftIO $ LB.writeFile path $ LB.fromStrict rest <> f'' + pure path getFilePath :: String -> ExceptT CLIError IO FilePath getFilePath name = case filePath of @@ -361,6 +381,26 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath} ifM (doesFileExist path) (throwError $ CLIError "File already exists") (pure path) _ -> (`uniqueCombine` name) . ( "Downloads") =<< getHomeDirectory +cliFileDescrInfo :: InfoOptions -> ExceptT CLIError IO () +cliFileDescrInfo InfoOptions {fileDescription} = do + ValidFileDescription FileDescription {size, chunkSize, chunks} <- getFileDescription fileDescription + let replicas = groupReplicasByServer chunkSize chunks + liftIO $ do + putStrLn $ "File download size: " <> strEnc size + putStrLn "File server(s):" + forM_ replicas $ \srvReplicas -> do + let srv = replicaServer $ head srvReplicas + chSizes = map (\FileServerReplica {chunkSize = chSize_} -> unFileSize $ fromMaybe chunkSize chSize_) srvReplicas + putStrLn $ strEnc srv <> ": " <> strEnc (FileSize $ sum chSizes) + +strEnc :: StrEncoding a => a -> String +strEnc = B.unpack . strEncode + +getFileDescription :: FilePath -> ExceptT CLIError IO ValidFileDescription +getFileDescription path = do + fd <- ExceptT $ first (CLIError . ("Failed to parse file description: " <>)) . strDecode <$> B.readFile path + liftEither . first CLIError $ validateFileDescription fd + prepareChunkSizes :: Int64 -> [Word32] prepareChunkSizes 0 = [] prepareChunkSizes size @@ -398,8 +438,9 @@ withRetry 1 a = a withRetry n a = a `catchError` \_ -> withRetry (n - 1) a cliRandomFile :: RandomFileOptions -> IO () -cliRandomFile RandomFileOptions {filePath, fileSize = FileSize size} = +cliRandomFile RandomFileOptions {filePath, fileSize = FileSize size} = do withFile filePath WriteMode (`saveRandomFile` size) + putStrLn $ "File created: " <> filePath where saveRandomFile h sz = do bytes <- getRandomBytes $ min mb sz diff --git a/src/Simplex/FileTransfer/Description.hs b/src/Simplex/FileTransfer/Description.hs index 8bdc4f300..c4cdc5d6e 100644 --- a/src/Simplex/FileTransfer/Description.hs +++ b/src/Simplex/FileTransfer/Description.hs @@ -14,11 +14,14 @@ module Simplex.FileTransfer.Description FileDigest (..), FileChunk (..), FileChunkReplica (..), + FileServerReplica (..), FileSize (..), ChunkReplicaId (..), YAMLFileDescription (..), -- for tests YAMLServerReplicas (..), -- for tests validateFileDescription, + groupReplicasByServer, + replicaServer, ) where @@ -186,20 +189,25 @@ instance (Integral a, Show a) => StrEncoding (FileSize a) where kb = 1024 mb = 1024 * kb +groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [[FileServerReplica]] +groupReplicasByServer defChunkSize = + groupBy ((==) `on` replicaServer) + . sortOn replicaServer + . unfoldChunksToReplicas defChunkSize + encodeFileReplicas :: FileSize Word32 -> [FileChunk] -> [YAMLServerReplicas] encodeFileReplicas defChunkSize = - map encodeServerReplicas - . groupBy ((==) `on` server') - . sortOn server' - . unfoldChunksToReplicas defChunkSize + map encodeServerReplicas . groupReplicasByServer defChunkSize where - server' = server :: FileServerReplica -> XFTPServer encodeServerReplicas fs = YAMLServerReplicas - { server = server' $ head fs, -- groupBy guarantees that fs is not empty + { server = replicaServer $ head fs, -- groupBy guarantees that fs is not empty chunks = map (B.unpack . encodeServerReplica) fs } +replicaServer :: FileServerReplica -> XFTPServer +replicaServer = server + encodeServerReplica :: FileServerReplica -> ByteString encodeServerReplica FileServerReplica {chunkNo, rcvId, rcvKey, digest, chunkSize} = bshow chunkNo diff --git a/tests/Test.hs b/tests/Test.hs index 45d3afbb0..2643674f6 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -16,6 +16,7 @@ import Simplex.Messaging.Transport.WebSockets (WS) import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive) import System.Environment (setEnv) import Test.Hspec +import XFTPCLI import XFTPServerTests (xftpServerTests) logCfg :: LogConfig @@ -44,4 +45,5 @@ main = do describe "XFTP" $ do describe "XFTP server" xftpServerTests describe "XFTP file description" fileDescriptionTests + describe "XFTP CLI" xftpCLITests describe "Server CLIs" cliTests diff --git a/tests/XFTPCLI.hs b/tests/XFTPCLI.hs new file mode 100644 index 000000000..dd7897d67 --- /dev/null +++ b/tests/XFTPCLI.hs @@ -0,0 +1,53 @@ +module XFTPCLI where + +import Control.Exception (bracket_) +import qualified Data.ByteString as LB +import Simplex.FileTransfer.Client.Main (xftpClientCLI) +import System.Directory (createDirectoryIfMissing, getFileSize, removeDirectoryRecursive) +import System.Environment (withArgs) +import System.FilePath (()) +import System.IO.Silently (capture_) +import Test.Hspec +import XFTPClient (testXFTPServerStr, withXFTPServer, xftpServerFiles, xftpServerFiles2) + +xftpCLITests :: Spec +xftpCLITests = around_ testBracket . describe "XFTP CLI" $ do + it "should send and receive file" testXFTPCLISendReceive + +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" + +mb :: Num a => a +mb = 1024 * 1024 + +testXFTPCLISendReceive :: IO () +testXFTPCLISendReceive = withXFTPServer $ do + let filePath = senderFiles "testfile" + xftp ["rand", filePath, "19mb"] `shouldReturn` ["File created: " <> filePath] + file <- LB.readFile filePath + getFileSize filePath `shouldReturn` 19 * mb + let fd1 = filePath <> ".xftp" "rcv1.xftp" + fd2 = filePath <> ".xftp" "rcv2.xftp" + xftp ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr, "--tmp=tests/tmp"] + `shouldReturn` ["File uploaded!", "Pass file descriptions to the recipient(s):", fd1, fd2] + testReceiveFile fd1 "testfile" file + testReceiveFile fd2 "testfile_1" file + where + xftp params = lines <$> capture_ (withArgs params xftpClientCLI) + testReceiveFile fd fileName file = do + xftp ["info", fd] + `shouldReturn` ["File download size: 20mb", "File server(s):", testXFTPServerStr <> ": 20mb"] + xftp ["recv", fd, recipientFiles, "--tmp=tests/tmp"] + `shouldReturn` ["File received: " <> recipientFiles fileName] + LB.readFile (recipientFiles fileName) `shouldReturn` file diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs index c41a20e1c..6f7242126 100644 --- a/tests/XFTPClient.hs +++ b/tests/XFTPClient.hs @@ -1,10 +1,12 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module XFTPClient where import Control.Concurrent (ThreadId) +import Data.String (fromString) import Network.Socket (ServiceName) import SMPClient (serverBracket) import Simplex.FileTransfer.Client @@ -16,9 +18,25 @@ import Test.Hspec xftpTest :: HasCallStack => (HasCallStack => XFTPClient -> IO ()) -> Expectation xftpTest test = runXFTPTest test `shouldReturn` () +xftpTestN :: HasCallStack => Int -> (HasCallStack => [XFTPClient] -> IO ()) -> Expectation +xftpTestN n test = runXFTPTestN n test `shouldReturn` () + +xftpTest2 :: HasCallStack => (HasCallStack => XFTPClient -> XFTPClient -> IO ()) -> Expectation +xftpTest2 test = xftpTestN 2 _test + where + _test [h1, h2] = test h1 h2 + _test _ = error "expected 2 handles" + runXFTPTest :: HasCallStack => (HasCallStack => XFTPClient -> IO a) -> IO a runXFTPTest test = withXFTPServer $ testXFTPClient test +runXFTPTestN :: forall a. HasCallStack => Int -> (HasCallStack => [XFTPClient] -> IO a) -> IO a +runXFTPTestN nClients test = withXFTPServer $ run nClients [] + where + run :: Int -> [XFTPClient] -> IO a + run 0 hs = test hs + run n hs = testXFTPClient $ \h -> run (n - 1) (h : hs) + withXFTPServerCfg :: HasCallStack => XFTPServerConfig -> (HasCallStack => ThreadId -> IO a) -> IO a withXFTPServerCfg cfg = serverBracket @@ -28,11 +46,29 @@ withXFTPServerCfg cfg = withXFTPServer :: IO a -> IO a withXFTPServer = withXFTPServerCfg testXFTPServerConfig . const +withXFTPServer2 :: IO a -> IO a +withXFTPServer2 = withXFTPServerCfg testXFTPServerConfig {xftpPort = xftpTestPort2, filesPath = xftpServerFiles2} . const + xftpTestPort :: ServiceName xftpTestPort = "7000" +xftpTestPort2 :: ServiceName +xftpTestPort2 = "7001" + testXFTPServer :: XFTPServer -testXFTPServer = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" +testXFTPServer = fromString testXFTPServerStr + +testXFTPServerStr :: String +testXFTPServerStr = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7000" + +testXFTPServerStr2 :: String +testXFTPServerStr2 = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7001" + +xftpServerFiles :: FilePath +xftpServerFiles = "tests/tmp/xftp-server-files" + +xftpServerFiles2 :: FilePath +xftpServerFiles2 = "tests/tmp/xftp-server-files2" testXFTPServerConfig :: XFTPServerConfig testXFTPServerConfig = @@ -40,7 +76,7 @@ testXFTPServerConfig = { xftpPort = xftpTestPort, fileIdSize = 16, storeLogFile = Nothing, - filesPath = "tests/xftp-files", + filesPath = xftpServerFiles, caCertificateFile = "tests/fixtures/ca.crt", privateKeyFile = "tests/fixtures/server.key", certificateFile = "tests/fixtures/server.crt", diff --git a/tests/XFTPServerTests.hs b/tests/XFTPServerTests.hs index 9ba61c51a..7ea5719b5 100644 --- a/tests/XFTPServerTests.hs +++ b/tests/XFTPServerTests.hs @@ -16,14 +16,14 @@ import Simplex.FileTransfer.Protocol (FileInfo (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Protocol (SenderId) import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive) -import System.IO (IOMode (..), withFile) +import System.FilePath (()) import Test.Hspec import XFTPClient xftpServerTests :: Spec xftpServerTests = - before_ (createDirectoryIfMissing False "tests/xftp-files") - . after_ (removeDirectoryRecursive "tests/xftp-files") + before_ (createDirectoryIfMissing False xftpServerFiles) + . after_ (removeDirectoryRecursive xftpServerFiles) $ do describe "XFTP file chunk delivery" testFileChunkDelivery @@ -33,11 +33,11 @@ chSize = 256 * 1024 createTestChunk :: FilePath -> IO ByteString createTestChunk fp = do bytes <- getRandomBytes chSize - withFile fp WriteMode $ \h -> B.hPut h bytes + B.writeFile fp bytes pure bytes readChunk :: SenderId -> IO ByteString -readChunk sId = B.readFile ("tests/xftp-files/" <> B.unpack (B64.encode sId)) +readChunk sId = B.readFile (xftpServerFiles B.unpack (B64.encode sId)) testFileChunkDelivery :: Spec testFileChunkDelivery =