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

* XFTP: CLI tests, output command results

* info command, test

* fix test

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