XFTP: CLI tests, output command results, info command (#642)

* XFTP: CLI tests, output command results

* info command, test

* fix test

simplexmq.cabal

@@ -516,6 +516,7 @@ test-suite simplexmq-test
       ServerTests
       SMPAgentClient
       SMPClient
+      XFTPCLI
       XFTPClient
       XFTPServerTests
       Paths_simplexmq

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

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

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

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

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",

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 =