xftp: cli client draft (#635)

* xftp: cli client draft

* more stubs

* compiles

* hash, app

* options parsers, random

* tmp

* xftp CLI client agent, simplify CLI command syntax

* only allow argument as a second parameter

* pivot signature draft

* receive file

* pivot sent chunks to recipients

* encryptFile - temp, chunks, specs

* send (upload) file and save file descriptions

* refactor, remove encrypted file

* save file size in description as string

* include filename inside padded encrypted file

* call chunk uploads concurrently, using queueing in HTTP2 as library client does not support concurrent streaming uploads

* download file (does not work yet)

* add digests to sent chunks

* fix recv - save file using AppendMode

* encrypt/decrypt sent file with secretbox

* remove print

* fix file description parsing in tests

* fix test

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

src/Simplex/FileTransfer/Client.hs

@@ -65,6 +65,7 @@ data XFTPChunkSpec = XFTPChunkSpec
     chunkOffset :: Int64,
     chunkSize :: Int
   }
+  deriving (Show)
 
 defaultXFTPClientConfig :: XFTPClientConfig
 defaultXFTPClientConfig = XFTPClientConfig {networkConfig = defaultNetworkConfig}
@@ -100,7 +101,7 @@ sendXFTPCommand XFTPClient {http2Client = http2@HTTP2Client {sessionId}} pKey fI
     liftEither . first PCETransportError $
       xftpEncodeTransmission sessionId (Just pKey) ("", fId, FileCmd (sFileParty @p) cmd)
   let req = H.requestStreaming N.methodPost "/" [] $ streamBody t
-  HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- liftEitherError xftpClientError $ sendRequestDirect http2 req
+  HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- liftEitherError xftpClientError $ sendRequest http2 req
   when (B.length bodyHead /= xftpBlockSize) $ throwError $ PCEResponseError BLOCK
   -- TODO validate that the file ID is the same as in the request?
   (_, _, (_, _fId, respOrErr)) <- liftEither . first PCEResponseError $ xftpDecodeTransmission sessionId bodyHead
@@ -148,9 +149,9 @@ downloadXFTPChunk c rpKey fId rKey =
     (r, _) -> throwError . PCEUnexpectedResponse $ bshow r
 
 receiveXFTPChunk :: XFTPChunkBody -> XFTPChunkSpec -> ExceptT ProtocolClientError IO ()
-receiveXFTPChunk XFTPChunkBody {chunkPart} XFTPChunkSpec {filePath, chunkOffset, chunkSize} = liftIO $ do
-  withFile filePath WriteMode $ \h -> do
-    hSeek h AbsoluteSeek $ fromIntegral chunkOffset
+receiveXFTPChunk XFTPChunkBody {chunkPart} XFTPChunkSpec {filePath, chunkOffset} = liftIO $ do
+  withFile filePath AppendMode $ \h -> do
+    -- hSeek h AbsoluteSeek $ fromIntegral chunkOffset
     -- TODO chunk decryption
     void $ receiveFile h chunkPart 0
 

src/Simplex/FileTransfer/Client/Agent.hs

@@ -0,0 +1,116 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.FileTransfer.Client.Agent where
+
+import Control.Logger.Simple (logInfo)
+import Control.Monad.Except
+import Data.Bifunctor (first)
+import qualified Data.ByteString.Char8 as B
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8)
+import Simplex.FileTransfer.Client
+import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientError (..), temporaryClientError)
+import Simplex.Messaging.Client.Agent ()
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (ProtocolServer (..), XFTPServer)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (tryError)
+import UnliftIO
+
+type XFTPClientVar = TMVar (Either XFTPClientAgentError XFTPClient)
+
+data XFTPClientAgent = XFTPClientAgent
+  { xftpClients :: TMap XFTPServer XFTPClientVar,
+    config :: XFTPClientAgentConfig
+  }
+
+data XFTPClientAgentConfig = XFTPClientAgentConfig
+  { xftpConfig :: XFTPClientConfig,
+    reconnectInterval :: RetryInterval
+  }
+
+defaultXFTPClientAgentConfig :: XFTPClientAgentConfig
+defaultXFTPClientAgentConfig =
+  XFTPClientAgentConfig
+    { xftpConfig = defaultXFTPClientConfig,
+      reconnectInterval =
+        RetryInterval
+          { initialInterval = 5_000000,
+            increaseAfter = 10_000000,
+            maxInterval = 60_000000
+          }
+    }
+
+data XFTPClientAgentError = XFTPClientAgentError XFTPServer ProtocolClientError
+  deriving (Show, Exception)
+
+newXFTPAgent :: XFTPClientAgentConfig -> STM XFTPClientAgent
+newXFTPAgent config = do
+  xftpClients <- TM.empty
+  pure XFTPClientAgent {xftpClients, config}
+
+type ME a = ExceptT XFTPClientAgentError IO a
+
+getXFTPServerClient :: XFTPClientAgent -> XFTPServer -> ME XFTPClient
+getXFTPServerClient XFTPClientAgent {xftpClients, config} srv = do
+  atomically getClientVar >>= either newXFTPClient waitForXFTPClient
+  where
+    connectClient :: ME XFTPClient
+    connectClient =
+      ExceptT $
+        first (XFTPClientAgentError srv)
+          <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) clientDisconnected
+
+    clientDisconnected :: IO ()
+    clientDisconnected = do
+      atomically $ TM.delete srv xftpClients
+      logInfo $ "disconnected from " <> showServer srv
+
+    getClientVar :: STM (Either XFTPClientVar XFTPClientVar)
+    getClientVar = maybe (Left <$> newClientVar) (pure . Right) =<< TM.lookup srv xftpClients
+      where
+        newClientVar :: STM XFTPClientVar
+        newClientVar = do
+          var <- newEmptyTMVar
+          TM.insert srv var xftpClients
+          pure var
+
+    waitForXFTPClient :: XFTPClientVar -> ME XFTPClient
+    waitForXFTPClient clientVar = do
+      let XFTPClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = xftpConfig config
+      client_ <- tcpConnectTimeout `timeout` atomically (readTMVar clientVar)
+      liftEither $ case client_ of
+        Just (Right c) -> Right c
+        Just (Left e) -> Left e
+        Nothing -> Left $ XFTPClientAgentError srv PCEResponseTimeout
+
+    newXFTPClient :: XFTPClientVar -> ME XFTPClient
+    newXFTPClient clientVar = tryConnectClient tryConnectAsync
+      where
+        tryConnectClient :: ME () -> ME XFTPClient
+        tryConnectClient retryAction =
+          tryError connectClient >>= \r -> case r of
+            Right client -> do
+              logInfo $ "connected to " <> showServer srv
+              atomically $ putTMVar clientVar r
+              pure client
+            Left e@(XFTPClientAgentError _ e') -> do
+              if temporaryClientError e'
+                then retryAction
+                else atomically $ do
+                  putTMVar clientVar r
+                  TM.delete srv xftpClients
+              throwError e
+        tryConnectAsync :: ME ()
+        tryConnectAsync = void . async $ do
+          withRetryInterval (reconnectInterval config) $ void . tryConnectClient
+
+showServer :: XFTPServer -> Text
+showServer ProtocolServer {host, port} =
+  decodeUtf8 $ strEncode host <> B.pack (if null port then "" else ':' : port)

src/Simplex/FileTransfer/Client/Main.hs

@@ -1 +1,382 @@
-module Simplex.FileTransfer.Client.Main where
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.FileTransfer.Client.Main (xftpClientCLI) where
+
+import Control.Monad
+import Control.Monad.Except
+import Crypto.Random (getRandomBytes)
+import qualified Data.Attoparsec.ByteString.Char8 as A
+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.Int (Int64)
+import Data.List (foldl', sortOn)
+import qualified Data.List.NonEmpty as L
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.Word (Word32)
+import Options.Applicative
+import Simplex.FileTransfer.Client
+import Simplex.FileTransfer.Client.Agent
+import Simplex.FileTransfer.Description
+import Simplex.FileTransfer.Protocol (FileInfo (..))
+import Simplex.Messaging.Agent.Lock
+import qualified Simplex.Messaging.Crypto as C
+import qualified Simplex.Messaging.Crypto.Lazy as LC
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Protocol (SenderId, SndPrivateSignKey, SndPublicVerifyKey, XFTPServer)
+import Simplex.Messaging.Server.CLI (getCliCommand')
+import Simplex.Messaging.Util (ifM, whenM)
+import System.Exit (exitFailure)
+import System.FilePath (splitExtensions, splitFileName, (</>))
+import System.IO.Temp (getCanonicalTemporaryDirectory)
+import UnliftIO
+import UnliftIO.Directory
+
+xftpClientVersion :: String
+xftpClientVersion = "0.1.0"
+
+defaultChunkSize :: Word32
+defaultChunkSize = 8 * mb
+
+smallChunkSize :: Word32
+smallChunkSize = 1 * mb
+
+fileSizeLen :: Int64
+fileSizeLen = 8
+
+cbAuthTagLen :: Int64
+cbAuthTagLen = fromIntegral C.cbAuthTagSize
+
+mb :: Num a => a
+mb = 1024 * 1024
+
+newtype CLIError = CLIError String
+  deriving (Eq, Show, Exception)
+
+data CliCommand
+  = SendFile SendOptions
+  | ReceiveFile ReceiveOptions
+  | RandomFile RandomFileOptions
+
+data SendOptions = SendOptions
+  { filePath :: FilePath,
+    outputDir :: Maybe FilePath,
+    numRecipients :: Int,
+    retryCount :: Int,
+    tempPath :: Maybe FilePath
+  }
+  deriving (Show)
+
+data ReceiveOptions = ReceiveOptions
+  { fileDescription :: FilePath,
+    filePath :: Maybe FilePath,
+    retryCount :: Int,
+    tempPath :: Maybe FilePath
+  }
+  deriving (Show)
+
+data RandomFileOptions = RandomFileOptions
+  { filePath :: FilePath,
+    fileSize :: FileSize Int
+  }
+  deriving (Show)
+
+defaultRetryCount :: Int
+defaultRetryCount = 3
+
+xftpServer :: XFTPServer
+xftpServer = "xftp://vr0bXzm4iKkLvleRMxLznTS-lHjXEyXunxn_7VJckk4=@localhost:443"
+
+cliCommandP :: Parser CliCommand
+cliCommandP =
+  hsubparser
+    ( command "send" (info (SendFile <$> sendP) (progDesc "Send file"))
+        <> command "recv" (info (ReceiveFile <$> receiveP) (progDesc "Receive file"))
+        <> command "rand" (info (RandomFile <$> randomP) (progDesc "Generate a random file of a given size"))
+    )
+  where
+    sendP :: Parser SendOptions
+    sendP =
+      SendOptions
+        <$> argument str (metavar "FILE" <> help "File to send")
+        <*> optional (argument str $ metavar "DIR" <> help "Directory to save file descriptions (default: current directory)")
+        <*> option auto (short 'n' <> metavar "COUNT" <> help "Number of recipients" <> value 1 <> showDefault)
+        <*> retries
+        <*> temp
+    receiveP :: Parser ReceiveOptions
+    receiveP =
+      ReceiveOptions
+        <$> argument str (metavar "FILE" <> help "File description file")
+        <*> optional (argument str $ metavar "DIR" <> help "Directory to save file (default: system Downloads directory)")
+        <*> retries
+        <*> temp
+    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
+    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)")
+
+data SentFileChunk = SentFileChunk
+  { chunkNo :: Int,
+    sndId :: SenderId,
+    sndPrivateKey :: SndPrivateSignKey,
+    chunkSize :: FileSize Word32,
+    digest :: FileDigest,
+    replicas :: [SentFileChunkReplica]
+  }
+  deriving (Eq, Show)
+
+data SentFileChunkReplica = SentFileChunkReplica
+  { server :: XFTPServer,
+    recipients :: [(ChunkReplicaId, C.APrivateSignKey)]
+  }
+  deriving (Eq, Show)
+
+data SentRecipientReplica = SentRecipientReplica
+  { chunkNo :: Int,
+    server :: XFTPServer,
+    rcvNo :: Int,
+    rcvId :: ChunkReplicaId,
+    rcvKey :: C.APrivateSignKey,
+    digest :: FileDigest,
+    chunkSize :: FileSize Word32
+  }
+
+xftpClientCLI :: IO ()
+xftpClientCLI =
+  getCliCommand' cliCommandP clientVersion >>= \case
+    SendFile opts -> runE $ cliSendFile opts
+    ReceiveFile opts -> runE $ cliReceiveFile opts
+    RandomFile opts -> cliRandomFile opts
+  where
+    clientVersion = "SimpleX XFTP client v" <> xftpClientVersion
+
+runE :: ExceptT CLIError IO () -> IO ()
+runE a =
+  runExceptT a >>= \case
+    Left (CLIError e) -> putStrLn e >> exitFailure
+    _ -> pure ()
+
+-- fileExtra is added to allow header extension in future versions
+data FileHeader = FileHeader
+  { fileName :: String,
+    fileExtra :: Maybe String
+  }
+  deriving (Eq, Show)
+
+instance Encoding FileHeader where
+  smpEncode FileHeader {fileName, fileExtra} = smpEncode (fileName, fileExtra)
+  smpP = do
+    (fileName, fileExtra) <- smpP
+    pure FileHeader {fileName, fileExtra}
+
+cliSendFile :: SendOptions -> ExceptT CLIError IO ()
+cliSendFile SendOptions {filePath, outputDir, numRecipients, retryCount, tempPath} = do
+  let (_, fileName) = splitFileName filePath
+  (encPath, fd, chunkSpecs) <- encryptFile fileName
+  sentChunks <- uploadFile chunkSpecs
+  whenM (doesFileExist encPath) $ removeFile encPath
+  -- TODO if only small chunks, use different default size
+  liftIO $ writeFileDescriptions fileName $ createFileDescriptions fd sentChunks
+  where
+    encryptFile :: String -> ExceptT CLIError IO (FilePath, FileDescription, [XFTPChunkSpec])
+    encryptFile fileName = do
+      encPath <- getEncPath tempPath "xftp"
+      key <- liftIO C.randomSbKey
+      nonce <- liftIO C.randomCbNonce
+      fileSize <- fromInteger <$> getFileSize filePath
+      let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
+          fileSize' = fromIntegral (B.length fileHdr) + fileSize
+          chunkSizes = prepareChunkSizes $ fileSize' + fileSizeLen + cbAuthTagLen
+          paddedSize = fromIntegral $ sum chunkSizes
+      encrypt fileHdr key nonce fileSize' paddedSize encPath
+      digest <- liftIO $ LC.sha512Hash <$> LB.readFile encPath
+      let chunkSpecs = prepareChunkSpecs encPath chunkSizes
+          fd = FileDescription {size = FileSize paddedSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defaultChunkSize, chunks = []}
+      pure (encPath, fd, chunkSpecs)
+      where
+        encrypt :: ByteString -> C.SbKey -> C.CbNonce -> Int64 -> Int64 -> FilePath -> ExceptT CLIError IO ()
+        encrypt fileHdr key nonce fileSize' paddedSize encFile = do
+          f <- liftIO $ LB.readFile filePath
+          let f' = LB.fromStrict fileHdr <> f
+          c <- liftEither $ first (CLIError . show) $ LC.sbEncrypt key nonce f' fileSize' $ paddedSize - cbAuthTagLen
+          liftIO $ LB.writeFile encFile c
+    -- let padSize = paddedSize - fileSize - fromIntegral (B.length fileHdr)
+    -- when (padSize > 0) . LB.hPut h $ LB.replicate padSize '#'
+    uploadFile :: [XFTPChunkSpec] -> ExceptT CLIError IO [SentFileChunk]
+    uploadFile chunks = do
+      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
+      -- TODO shuffle chunks
+      sentChunks <- pooledForConcurrentlyN 32 (zip [1 ..] chunks) $ uploadFileChunk a
+      -- TODO unshuffle chunks
+      pure $ map snd sentChunks
+      where
+        retries = withRetry retryCount
+        uploadFileChunk :: XFTPClientAgent -> (Int, XFTPChunkSpec) -> ExceptT CLIError IO (Int, SentFileChunk)
+        uploadFileChunk a (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
+          -- TODO choose server randomly
+          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
+          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})
+        getChunkInfo :: SndPublicVerifyKey -> XFTPChunkSpec -> IO FileInfo
+        getChunkInfo sndKey XFTPChunkSpec {filePath = chunkPath, chunkOffset, chunkSize} =
+          withFile chunkPath ReadMode $ \h -> do
+            hSeek h AbsoluteSeek $ fromIntegral chunkOffset
+            digest <- LC.sha512Hash <$> LB.hGet h (fromIntegral chunkSize)
+            pure FileInfo {sndKey, size = fromIntegral chunkSize, digest}
+
+    -- M chunks, R replicas, N recipients
+    -- rcvReplicas: M[SentFileChunk] -> M * R * N [SentRecipientReplica]
+    -- rcvChunks: M * R * N [SentRecipientReplica] -> N[ M[FileChunk] ]
+    createFileDescriptions :: FileDescription -> [SentFileChunk] -> [FileDescription]
+    createFileDescriptions fd sentChunks = map (\chunks -> (fd :: FileDescription) {chunks}) rcvChunks
+      where
+        rcvReplicas :: [SentRecipientReplica]
+        rcvReplicas =
+          concatMap
+            ( \SentFileChunk {chunkNo, digest, chunkSize, replicas} ->
+                concatMap
+                  ( \SentFileChunkReplica {server, recipients} ->
+                      zipWith (\rcvNo (rcvId, rcvKey) -> SentRecipientReplica {chunkNo, server, rcvNo, rcvId, rcvKey, digest, chunkSize}) [1 ..] recipients
+                  )
+                  replicas
+            )
+            sentChunks
+        rcvChunks :: [[FileChunk]]
+        rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
+        sortChunks :: [FileChunk] -> [FileChunk]
+        sortChunks = map reverseReplicas . sortOn (chunkNo :: FileChunk -> Int)
+        reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
+        addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
+        addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, rcvId, rcvKey, digest, chunkSize} =
+          M.alter (Just . addOrChangeRecipient) rcvNo m
+          where
+            addOrChangeRecipient :: Maybe (Map Int FileChunk) -> Map Int FileChunk
+            addOrChangeRecipient = \case
+              Just m' -> M.alter (Just . addOrChangeChunk) chunkNo m'
+              _ -> M.singleton chunkNo $ FileChunk {chunkNo, digest, chunkSize, replicas = [replica]}
+            addOrChangeChunk :: Maybe FileChunk -> FileChunk
+            addOrChangeChunk = \case
+              Just ch@FileChunk {replicas} -> ch {replicas = replica : replicas}
+              _ -> FileChunk {chunkNo, digest, chunkSize, replicas = [replica]}
+            replica = FileChunkReplica {server, rcvId, rcvKey}
+    writeFileDescriptions :: String -> [FileDescription] -> IO ()
+    writeFileDescriptions fileName fds = do
+      outDir <- uniqueCombine (fromMaybe "." outputDir) (fileName <> ".xftp")
+      createDirectoryIfMissing True outDir
+      forM_ (zip [1 ..] fds) $ \(i, fd) -> do
+        let fdPath = outDir </> ("rcv" <> show i <> ".xftp")
+        B.writeFile fdPath $ strEncode fd
+
+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, key, nonce, chunks} <- liftEither . first CLIError $ validateFileDescription fd
+  encPath <- getEncPath tempPath "xftp"
+  -- withFile encPath WriteMode $ \h -> do
+  --   liftIO $ LB.hPut h $ LB.replicate (unFileSize size) '#'
+  a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
+  writeLock <- atomically createLock
+  let chunkSizes = prepareChunkSizes $ unFileSize size
+      chunkSpecs = prepareChunkSpecs encPath chunkSizes
+  -- chunks have to be ordered because of AppendMode
+  forM_ (zip chunkSpecs chunks) $ \(chunkSpec, chunk) -> do
+    downloadFileChunk a writeLock chunk chunkSpec
+  -- verify file digest
+  decryptFile encPath key nonce
+  whenM (doesFileExist encPath) $ removeFile encPath
+  where
+    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
+      (rKey, rpKey) <- liftIO C.generateKeyPair'
+      (sKey, body) <- withRetry retryCount $ withExceptT (CLIError . show) $ 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
+    downloadFileChunk _ _ _ _ = pure ()
+    decryptFile :: FilePath -> C.SbKey -> C.CbNonce -> ExceptT CLIError IO ()
+    decryptFile encPath key nonce = do
+      f <- liftIO $ LB.readFile encPath
+      f' <- liftEither $ first (CLIError . show) $ LC.sbDecrypt key nonce f
+      let (fileHdr, f'') = LB.splitAt 1024 f'
+      -- withFile encPath ReadMode $ \r -> do
+      --   fileHdr <- liftIO $ B.hGet r 1024
+      case A.parse smpP $ LB.toStrict fileHdr of
+        A.Fail _ _ e -> throwError $ CLIError $ "Invalid file header: " <> e
+        A.Partial _ -> throwError $ CLIError "Invalid file header"
+        A.Done rest FileHeader {fileName} -> do
+          path <- getFilePath fileName
+          liftIO $ LB.writeFile path $ LB.fromStrict rest <> f''
+    getFilePath :: String -> ExceptT CLIError IO FilePath
+    getFilePath name =
+      case filePath of
+        Just path ->
+          ifM (doesDirectoryExist path) (uniqueCombine path name) $
+            ifM (doesFileExist path) (throwError $ CLIError "File already exists") (pure path)
+        _ -> (`uniqueCombine` name) . (</> "Downloads") =<< getHomeDirectory
+
+prepareChunkSizes :: Int64 -> [Word32]
+prepareChunkSizes 0 = []
+prepareChunkSizes size
+  | size >= defSz = replicate (fromIntegral n1) defaultChunkSize <> prepareChunkSizes remSz
+  | size > defSz `div` 2 = [defaultChunkSize]
+  | otherwise = replicate (fromIntegral n2') smallChunkSize
+  where
+    (n1, remSz) = size `divMod` defSz
+    n2' = let (n2, remSz2) = (size `divMod` fromIntegral smallChunkSize) in if remSz2 == 0 then n2 else n2 + 1
+    defSz = fromIntegral defaultChunkSize :: Int64
+
+prepareChunkSpecs :: FilePath -> [Word32] -> [XFTPChunkSpec]
+prepareChunkSpecs filePath chunkSizes = reverse . snd $ foldl' addSpec (0, []) chunkSizes
+  where
+    addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec])
+    addSpec (chunkOffset, specs) sz =
+      let spec = XFTPChunkSpec {filePath, chunkOffset, chunkSize = fromIntegral sz}
+       in (chunkOffset + fromIntegral sz, spec : specs)
+
+getEncPath :: MonadIO m => Maybe FilePath -> String -> m FilePath
+getEncPath path name = (`uniqueCombine` (name <> ".encrypted")) =<< maybe (liftIO getCanonicalTemporaryDirectory) pure path
+
+uniqueCombine :: MonadIO m => FilePath -> String -> m FilePath
+uniqueCombine filePath fileName = tryCombine (0 :: Int)
+  where
+    tryCombine n =
+      let (name, ext) = splitExtensions fileName
+          suffix = if n == 0 then "" else "_" <> show n
+          f = filePath </> (name <> suffix <> ext)
+       in ifM (doesPathExist f) (tryCombine $ n + 1) (pure f)
+
+withRetry :: Int -> ExceptT CLIError IO a -> ExceptT CLIError IO a
+withRetry 0 _ = throwError $ CLIError "internal: no retry attempts"
+withRetry 1 a = a
+withRetry n a = a `catchError` \_ -> withRetry (n - 1) a
+
+cliRandomFile :: RandomFileOptions -> IO ()
+cliRandomFile RandomFileOptions {filePath, fileSize = FileSize size} =
+  withFile filePath WriteMode (`saveRandomFile` size)
+  where
+    saveRandomFile h sz = do
+      bytes <- getRandomBytes $ min mb sz
+      B.hPut h bytes
+      when (sz > mb) $ saveRandomFile h (sz - mb)

src/Simplex/FileTransfer/Description.hs

@@ -4,20 +4,25 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.FileTransfer.Description
   ( FileDescription (..),
+    ValidFileDescription,
+    pattern ValidFileDescription,
     FileDigest (..),
     FileChunk (..),
     FileChunkReplica (..),
+    FileSize (..),
     ChunkReplicaId (..),
     YAMLFileDescription (..), -- for tests
     YAMLServerReplicas (..), -- for tests
+    validateFileDescription,
   )
 where
 
-import Control.Applicative (Alternative ((<|>)), optional)
+import Control.Applicative (optional)
 import Control.Monad ((<=<))
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
@@ -42,16 +47,20 @@ import Simplex.Messaging.Protocol (XFTPServer)
 import Simplex.Messaging.Util (bshow, (<$?>))
 
 data FileDescription = FileDescription
-  { name :: String,
-    size :: Int64,
+  { size :: FileSize Int64,
     digest :: FileDigest,
-    key :: C.Key,
-    iv :: C.IV,
-    chunkSize :: Word32,
+    key :: C.SbKey,
+    nonce :: C.CbNonce,
+    chunkSize :: FileSize Word32,
     chunks :: [FileChunk]
   }
   deriving (Eq, Show)
 
+newtype ValidFileDescription = ValidFD FileDescription
+
+pattern ValidFileDescription :: FileDescription -> ValidFileDescription
+pattern ValidFileDescription fd = ValidFD fd
+
 newtype FileDigest = FileDigest {unFileDigest :: ByteString}
   deriving (Eq, Show)
 
@@ -69,7 +78,7 @@ instance ToJSON FileDigest where
 
 data FileChunk = FileChunk
   { chunkNo :: Int,
-    chunkSize :: Word32,
+    chunkSize :: FileSize Word32,
     digest :: FileDigest,
     replicas :: [FileChunkReplica]
   }
@@ -97,11 +106,10 @@ instance ToJSON ChunkReplicaId where
   toEncoding = strToJEncoding
 
 data YAMLFileDescription = YAMLFileDescription
-  { name :: String,
-    size :: Int64,
+  { size :: String,
     digest :: FileDigest,
-    key :: C.Key,
-    iv :: C.IV,
+    key :: C.SbKey,
+    nonce :: C.CbNonce,
     chunkSize :: String,
     replicas :: [YAMLServerReplicas]
   }
@@ -127,7 +135,7 @@ data FileServerReplica = FileServerReplica
     rcvId :: ChunkReplicaId,
     rcvKey :: C.APrivateSignKey,
     digest :: Maybe FileDigest,
-    chunkSize :: Maybe Word32
+    chunkSize :: Maybe (FileSize Word32)
   }
   deriving (Show)
 
@@ -136,37 +144,49 @@ instance StrEncoding FileDescription where
   strDecode = decodeFileDescription <=< first show . Y.decodeEither'
   strP = strDecode <$?> A.takeByteString
 
+validateFileDescription :: FileDescription -> Either String ValidFileDescription
+validateFileDescription fd@FileDescription {size, chunks}
+  | chunkNos /= [1 .. length chunks] = Left "chunk numbers are not sequential"
+  | chunksSize chunks /= unFileSize size = Left "chunks total size is different than file size"
+  | otherwise = Right $ ValidFD fd
+  where
+    chunkNos = map (chunkNo :: FileChunk -> Int) chunks
+    chunksSize = fromIntegral . foldl' (\s FileChunk {chunkSize} -> s + unFileSize chunkSize) 0
+
 encodeFileDescription :: FileDescription -> YAMLFileDescription
-encodeFileDescription FileDescription {name, size, digest, key, iv, chunkSize, chunks} =
+encodeFileDescription FileDescription {size, digest, key, nonce, chunkSize, chunks} =
   YAMLFileDescription
-    { name,
-      size,
+    { size = B.unpack $ strEncode size,
       digest,
       key,
-      iv,
-      chunkSize = B.unpack $ encodeChunkSize chunkSize,
+      nonce,
+      chunkSize = B.unpack $ strEncode chunkSize,
       replicas = encodeFileReplicas chunkSize chunks
     }
 
-encodeChunkSize :: Word32 -> ByteString
-encodeChunkSize b
-  | b' /= 0 = bshow b
-  | kb' /= 0 = bshow kb <> "kb"
-  | otherwise = bshow mb <> "mb"
-  where
-    (kb, b') = b `divMod` 1024
-    (mb, kb') = kb `divMod` 1024
+newtype FileSize a = FileSize {unFileSize :: a}
+  deriving (Eq, Show)
 
-chunkSizeP :: Parser Word32
-chunkSizeP =
-  ((mb *) <$> A.decimal <* "mb")
-    <|> ((kb *) <$> A.decimal <* "kb")
-    <|> A.decimal
-  where
-    kb = 1024
-    mb = 1024 * kb
+instance (Integral a, Show a) => StrEncoding (FileSize a) where
+  strEncode (FileSize b)
+    | b' /= 0 = bshow b
+    | kb' /= 0 = bshow kb <> "kb"
+    | otherwise = bshow mb <> "mb"
+    where
+      (kb, b') = b `divMod` 1024
+      (mb, kb') = kb `divMod` 1024
+  strP =
+    FileSize
+      <$> A.choice
+        [ (mb *) <$> A.decimal <* "mb",
+          (kb *) <$> A.decimal <* "kb",
+          A.decimal
+        ]
+    where
+      kb = 1024
+      mb = 1024 * kb
 
-encodeFileReplicas :: Word32 -> [FileChunk] -> [YAMLServerReplicas]
+encodeFileReplicas :: FileSize Word32 -> [FileChunk] -> [YAMLServerReplicas]
 encodeFileReplicas defChunkSize =
   map encodeServerReplicas
     . groupBy ((==) `on` server')
@@ -188,7 +208,7 @@ encodeServerReplica FileServerReplica {chunkNo, rcvId, rcvKey, digest, chunkSize
     <> ":"
     <> strEncode rcvKey
     <> maybe "" ((":" <>) . strEncode) digest
-    <> maybe "" ((":" <>) . encodeChunkSize) chunkSize
+    <> maybe "" ((":" <>) . strEncode) chunkSize
 
 serverReplicaP :: XFTPServer -> Parser FileServerReplica
 serverReplicaP server = do
@@ -196,10 +216,10 @@ serverReplicaP server = do
   rcvId <- A.char ':' *> strP
   rcvKey <- A.char ':' *> strP
   digest <- optional (A.char ':' *> strP)
-  chunkSize <- optional (A.char ':' *> chunkSizeP)
+  chunkSize <- optional (A.char ':' *> strP)
   pure FileServerReplica {chunkNo, server, rcvId, rcvKey, digest, chunkSize}
 
-unfoldChunksToReplicas :: Word32 -> [FileChunk] -> [FileServerReplica]
+unfoldChunksToReplicas :: FileSize Word32 -> [FileChunk] -> [FileServerReplica]
 unfoldChunksToReplicas defChunkSize = concatMap chunkReplicas
   where
     chunkReplicas c@FileChunk {replicas} = zipWith (replicaToServerReplica c) [1 ..] replicas
@@ -210,11 +230,12 @@ unfoldChunksToReplicas defChunkSize = concatMap chunkReplicas
        in FileServerReplica {chunkNo, server, rcvId, rcvKey, digest = digest', chunkSize = chunkSize'}
 
 decodeFileDescription :: YAMLFileDescription -> Either String FileDescription
-decodeFileDescription YAMLFileDescription {name, size, digest, key, iv, chunkSize, replicas} = do
-  chunkSize' <- parseAll chunkSizeP $ B.pack chunkSize
+decodeFileDescription YAMLFileDescription {size, digest, key, nonce, chunkSize, replicas} = do
+  size' <- strDecode $ B.pack size
+  chunkSize' <- strDecode $ B.pack chunkSize
   replicas' <- decodeFileParts replicas
   chunks <- foldReplicasToChunks chunkSize' replicas'
-  pure FileDescription {name, size, digest, key, iv, chunkSize = chunkSize', chunks}
+  pure FileDescription {size = size', digest, key, nonce, chunkSize = chunkSize', chunks}
   where
     decodeFileParts = fmap concat . mapM decodeYAMLServerReplicas
 
@@ -225,15 +246,15 @@ decodeYAMLServerReplicas YAMLServerReplicas {server, chunks} =
 -- this function should fail if:
 -- 1. no replica has digest or two replicas have different digests
 -- 2. two replicas have different chunk sizes
-foldReplicasToChunks :: Word32 -> [FileServerReplica] -> Either String [FileChunk]
+foldReplicasToChunks :: FileSize Word32 -> [FileServerReplica] -> Either String [FileChunk]
 foldReplicasToChunks defChunkSize fs = do
   sd <- foldSizesDigests fs
   -- TODO validate (check that chunks match) or in separate function
   sortOn (chunkNo :: FileChunk -> Int) . map reverseReplicas . M.elems <$> foldChunks sd fs
   where
-    foldSizesDigests :: [FileServerReplica] -> Either String (Map Int Word32, Map Int FileDigest)
+    foldSizesDigests :: [FileServerReplica] -> Either String (Map Int (FileSize Word32), Map Int FileDigest)
     foldSizesDigests = foldl' addSizeDigest $ Right (M.empty, M.empty)
-    addSizeDigest :: Either String (Map Int Word32, Map Int FileDigest) -> FileServerReplica -> Either String (Map Int Word32, Map Int FileDigest)
+    addSizeDigest :: Either String (Map Int (FileSize Word32), Map Int FileDigest) -> FileServerReplica -> Either String (Map Int (FileSize Word32), Map Int FileDigest)
     addSizeDigest (Left e) _ = Left e
     addSizeDigest (Right (ms, md)) FileServerReplica {chunkNo, chunkSize, digest} =
       (,) <$> combineChunk ms chunkNo chunkSize <*> combineChunk md chunkNo digest
@@ -242,9 +263,9 @@ foldReplicasToChunks defChunkSize fs = do
     combineChunk m chunkNo (Just value) = case M.lookup chunkNo m of
       Nothing -> Right $ M.insert chunkNo value m
       Just v -> if v == value then Right m else Left "different size or digest in chunk replicas"
-    foldChunks :: (Map Int Word32, Map Int FileDigest) -> [FileServerReplica] -> Either String (Map Int FileChunk)
+    foldChunks :: (Map Int (FileSize Word32), Map Int FileDigest) -> [FileServerReplica] -> Either String (Map Int FileChunk)
     foldChunks sd = foldl' (addReplica sd) (Right M.empty)
-    addReplica :: (Map Int Word32, Map Int FileDigest) -> Either String (Map Int FileChunk) -> FileServerReplica -> Either String (Map Int FileChunk)
+    addReplica :: (Map Int (FileSize Word32), Map Int FileDigest) -> Either String (Map Int FileChunk) -> FileServerReplica -> Either String (Map Int FileChunk)
     addReplica _ (Left e) _ = Left e
     addReplica (ms, md) (Right cs) FileServerReplica {chunkNo, server, rcvId, rcvKey} = do
       case M.lookup chunkNo cs of

src/Simplex/Messaging/Agent/Client.hs

@@ -691,13 +691,6 @@ processSubResult c rq r = do
     _ -> addSubscription c rq
   pure r
 
-temporaryClientError :: ProtocolClientError -> Bool
-temporaryClientError = \case
-  PCENetworkError -> True
-  PCEResponseTimeout -> True
-  PCEIOError _ -> True
-  _ -> False
-
 temporaryAgentError :: AgentErrorType -> Bool
 temporaryAgentError = \case
   BROKER _ NETWORK -> True

src/Simplex/Messaging/Client.hs

@@ -63,6 +63,7 @@ module Simplex.Messaging.Client
     transportClientConfig,
     chooseTransportHost,
     proxyUsername,
+    temporaryClientError,
     ServerTransmission,
     ClientCommand,
   )
@@ -418,6 +419,13 @@ data ProtocolClientError
     PCEIOError IOException
   deriving (Eq, Show, Exception)
 
+temporaryClientError :: ProtocolClientError -> Bool
+temporaryClientError = \case
+  PCENetworkError -> True
+  PCEResponseTimeout -> True
+  PCEIOError _ -> True
+  _ -> False
+
 -- | Create a new SMP queue.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#create-queue-command

src/Simplex/Messaging/Crypto.hs

@@ -117,12 +117,14 @@ module Simplex.Messaging.Crypto
     sbEncrypt,
     sbDecrypt,
     sbKey,
+    unsafeSbKey,
     randomSbKey,
+    cbAuthTagSize,
 
     -- * pseudo-random bytes
     pseudoRandomBytes,
 
-    -- * SHA256 hash
+    -- * hash
     sha256Hash,
 
     -- * Message padding / un-padding
@@ -149,7 +151,7 @@ import Crypto.Cipher.AES (AES256)
 import qualified Crypto.Cipher.Types as AES
 import qualified Crypto.Cipher.XSalsa as XSalsa
 import qualified Crypto.Error as CE
-import Crypto.Hash (Digest, SHA256 (..), hash)
+import Crypto.Hash (Digest, SHA256, hash)
 import qualified Crypto.MAC.Poly1305 as Poly1305
 import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
@@ -973,6 +975,9 @@ sbDecrypt_ secret (CbNonce nonce) packet
     (rs, msg) = xSalsa20 secret nonce c
     tag = Poly1305.auth rs c
 
+cbAuthTagSize :: Int
+cbAuthTagSize = 16
+
 newtype CbNonce = CryptoBoxNonce {unCbNonce :: ByteString}
   deriving (Eq, Show)
 
@@ -989,6 +994,9 @@ instance ToJSON CbNonce where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
+instance FromJSON CbNonce where
+  parseJSON = strParseJSON "CbNonce"
+
 cbNonce :: ByteString -> CbNonce
 cbNonce s
   | len == 24 = CryptoBoxNonce s
@@ -1020,19 +1028,22 @@ pattern SbKey s <- SecretBoxKey s
 
 instance StrEncoding SbKey where
   strEncode (SbKey s) = strEncode s
-  strP = sbKey <$> strP
+  strP = sbKey <$?> strP
 
 instance ToJSON SbKey where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
-sbKey :: ByteString -> SbKey
+instance FromJSON SbKey where
+  parseJSON = strParseJSON "SbKey"
+
+sbKey :: ByteString -> Either String SbKey
 sbKey s
-  | len == 32 = SecretBoxKey s
-  | len > 32 = SecretBoxKey . fst $ B.splitAt 32 s
-  | otherwise = SecretBoxKey $ s <> B.replicate (32 - len) (toEnum 0)
-  where
-    len = B.length s
+  | B.length s == 32 = Right $ SecretBoxKey s
+  | otherwise = Left "SbKey: invalid length"
+
+unsafeSbKey :: ByteString -> SbKey
+unsafeSbKey s = either error id $ sbKey s
 
 randomSbKey :: IO SbKey
 randomSbKey = SecretBoxKey <$> getRandomBytes 32