From 4e8657097c436213301bb29d34b52ebc311eab61 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 16 Feb 2023 14:06:03 +0400 Subject: [PATCH] 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> --- apps/xftp/Main.hs | 6 + package.yaml | 9 + simplexmq.cabal | 67 ++++ src/Simplex/FileTransfer/Client.hs | 9 +- src/Simplex/FileTransfer/Client/Agent.hs | 116 +++++++ src/Simplex/FileTransfer/Client/Main.hs | 383 ++++++++++++++++++++++- src/Simplex/FileTransfer/Description.hs | 111 ++++--- src/Simplex/Messaging/Agent/Client.hs | 7 - src/Simplex/Messaging/Client.hs | 8 + src/Simplex/Messaging/Crypto.hs | 29 +- tests/FileDescriptionTests.hs | 50 +-- tests/fixtures/file_description.yaml | 7 +- 12 files changed, 711 insertions(+), 91 deletions(-) create mode 100644 apps/xftp/Main.hs create mode 100644 src/Simplex/FileTransfer/Client/Agent.hs diff --git a/apps/xftp/Main.hs b/apps/xftp/Main.hs new file mode 100644 index 000000000..c96a664c9 --- /dev/null +++ b/apps/xftp/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Simplex.FileTransfer.Client.Main + +main :: IO () +main = xftpClientCLI diff --git a/package.yaml b/package.yaml index 2374d1984..dbb66441b 100644 --- a/package.yaml +++ b/package.yaml @@ -59,6 +59,7 @@ dependencies: - sqlcipher-simple == 0.4.* - stm == 2.5.* - template-haskell == 2.16.* + - temporary == 1.3.* - text == 1.2.* - time == 1.9.* - time-compat == 1.9.* @@ -120,6 +121,14 @@ executables: ghc-options: - -threaded + xftp: + source-dirs: apps/xftp + main: Main.hs + dependencies: + - simplexmq + ghc-options: + - -threaded + tests: simplexmq-test: source-dirs: tests diff --git a/simplexmq.cabal b/simplexmq.cabal index 5e034019d..9ff4070e9 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -36,6 +36,7 @@ library exposed-modules: Simplex.FileTransfer Simplex.FileTransfer.Client + Simplex.FileTransfer.Client.Agent Simplex.FileTransfer.Client.Main Simplex.FileTransfer.Description Simplex.FileTransfer.Protocol @@ -158,6 +159,7 @@ library , sqlcipher-simple ==0.4.* , stm ==2.5.* , template-haskell ==2.16.* + , temporary ==1.3.* , text ==1.2.* , time ==1.9.* , time-compat ==1.9.* @@ -364,6 +366,70 @@ executable smp-server if flag(swift) cpp-options: -DswiftJSON +executable xftp + main-is: Main.hs + other-modules: + Paths_simplexmq + hs-source-dirs: + apps/xftp + ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded + build-depends: + QuickCheck ==2.14.* + , aeson ==2.0.* + , ansi-terminal >=0.10 && <0.12 + , asn1-encoding ==0.9.* + , asn1-types ==0.3.* + , async ==2.2.* + , attoparsec ==0.14.* + , base >=4.14 && <5 + , base64-bytestring >=1.0 && <1.3 + , bytestring ==0.10.* + , case-insensitive ==1.2.* + , composition ==1.0.* + , constraints >=0.12 && <0.14 + , containers ==0.6.* + , cryptonite >=0.27 && <0.30 + , cryptostore ==0.2.* + , data-default ==0.7.* + , direct-sqlcipher ==2.3.* + , directory ==1.3.* + , filepath ==1.4.* + , generic-random >=1.3 && <1.5 + , http-types ==0.12.* + , http2 ==4.0.* + , ini ==0.4.1 + , iso8601-time ==0.1.* + , memory ==0.15.* + , mtl ==2.2.* + , network >=3.1.2.7 && <3.2 + , network-transport ==0.5.4 + , optparse-applicative >=0.15 && <0.17 + , process ==1.6.* + , random >=1.1 && <1.3 + , simple-logger ==0.1.* + , simplexmq + , socks ==0.6.* + , sqlcipher-simple ==0.4.* + , stm ==2.5.* + , template-haskell ==2.16.* + , temporary ==1.3.* + , text ==1.2.* + , time ==1.9.* + , time-compat ==1.9.* + , time-manager ==0.0.* + , tls >=1.6.0 && <1.7 + , transformers ==0.5.* + , unliftio ==0.2.* + , unliftio-core ==0.2.* + , websockets ==0.12.* + , x509 ==1.7.* + , x509-store ==1.6.* + , x509-validation ==1.6.* + , yaml ==0.11.* + default-language: Haskell2010 + if flag(swift) + cpp-options: -DswiftJSON + executable xftp-server main-is: Main.hs other-modules: @@ -422,6 +488,7 @@ executable xftp-server , x509 ==1.7.* , x509-store ==1.6.* , x509-validation ==1.6.* + , yaml ==0.11.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs index c969137fa..e0528e0ce 100644 --- a/src/Simplex/FileTransfer/Client.hs +++ b/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 diff --git a/src/Simplex/FileTransfer/Client/Agent.hs b/src/Simplex/FileTransfer/Client/Agent.hs new file mode 100644 index 000000000..63cc77ed0 --- /dev/null +++ b/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) diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs index 467237e02..4a7504211 100644 --- a/src/Simplex/FileTransfer/Client/Main.hs +++ b/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) diff --git a/src/Simplex/FileTransfer/Description.hs b/src/Simplex/FileTransfer/Description.hs index a911353c7..8bdc4f300 100644 --- a/src/Simplex/FileTransfer/Description.hs +++ b/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 diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 9b68c4172..2cd084a68 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/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 diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 1af672873..a84c78277 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/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 diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index 05b9b14ed..31c352aa9 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/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 diff --git a/tests/FileDescriptionTests.hs b/tests/FileDescriptionTests.hs index 9cfb3876b..b8fa62da9 100644 --- a/tests/FileDescriptionTests.hs +++ b/tests/FileDescriptionTests.hs @@ -15,26 +15,42 @@ import Simplex.Messaging.Encoding.String (StrEncoding (..)) import System.Directory (removeFile) import Test.Hspec +fileDescriptionTests :: Spec +fileDescriptionTests = + describe "file description parsing / serializing" $ do + it "parse YAML file description" testParseYAMLFileDescription + it "serialize YAML file description" testSerializeYAMLFileDescription + it "parse file description" testParseFileDescription + it "serialize file description" testSerializeFileDescription + fileDescPath :: FilePath fileDescPath = "tests/fixtures/file_description.yaml" tmpFileDescPath :: FilePath tmpFileDescPath = "tests/tmp/file_description.yaml" +mb :: Num a => a +mb = 1024 * 1024 + +testSbKey :: C.SbKey +testSbKey = either error id $ strDecode "00n8p1tJq5E-SGnHcYTOrS4A9I07gTA_WFD6MTFFFOY=" + +testCbNonce :: C.CbNonce +testCbNonce = either error id $ strDecode "dPSF-wrQpDiK_K6sYv0BDBZ9S4dg-jmu" + fileDesc :: FileDescription fileDesc = FileDescription - { name = "file.ext", - size = 33200000, + { size = FileSize $ 26 * mb, digest = FileDigest "abc", - key = C.Key "def", - iv = C.IV "ghi", - chunkSize = 8 * 1024 * 1024, + key = testSbKey, + nonce = testCbNonce, + chunkSize = defaultChunkSize, chunks = [ FileChunk { chunkNo = 1, digest = chunkDigest, - chunkSize = 8 * 1024 * 1024, + chunkSize = defaultChunkSize, replicas = [ FileChunkReplica {server = "xftp://abc=@example1.com", rcvId, rcvKey}, FileChunkReplica {server = "xftp://abc=@example3.com", rcvId, rcvKey} @@ -43,7 +59,7 @@ fileDesc = FileChunk { chunkNo = 2, digest = chunkDigest, - chunkSize = 8 * 1024 * 1024, + chunkSize = defaultChunkSize, replicas = [ FileChunkReplica {server = "xftp://abc=@example2.com", rcvId, rcvKey}, FileChunkReplica {server = "xftp://abc=@example4.com", rcvId, rcvKey} @@ -52,7 +68,7 @@ fileDesc = FileChunk { chunkNo = 3, digest = chunkDigest, - chunkSize = 8 * 1024 * 1024, + chunkSize = defaultChunkSize, replicas = [ FileChunkReplica {server = "xftp://abc=@example1.com", rcvId, rcvKey}, FileChunkReplica {server = "xftp://abc=@example4.com", rcvId, rcvKey} @@ -61,7 +77,7 @@ fileDesc = FileChunk { chunkNo = 4, digest = chunkDigest, - chunkSize = 2 * 1024 * 1024, + chunkSize = FileSize $ 2 * mb, replicas = [ FileChunkReplica {server = "xftp://abc=@example2.com", rcvId, rcvKey}, FileChunkReplica {server = "xftp://abc=@example3.com", rcvId, rcvKey} @@ -70,6 +86,7 @@ fileDesc = ] } where + defaultChunkSize = FileSize $ 8 * mb rcvId = ChunkReplicaId "abc" rcvKey = C.APrivateSignKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe" chunkDigest = FileDigest "ghi" @@ -77,12 +94,11 @@ fileDesc = yamlFileDesc :: YAMLFileDescription yamlFileDesc = YAMLFileDescription - { name = "file.ext", - size = 33200000, + { size = "26mb", chunkSize = "8mb", digest = FileDigest "abc", - key = C.Key "def", - iv = C.IV "ghi", + key = testSbKey, + nonce = testCbNonce, replicas = [ YAMLServerReplicas { server = "xftp://abc=@example1.com", @@ -115,14 +131,6 @@ yamlFileDesc = ] } -fileDescriptionTests :: Spec -fileDescriptionTests = - describe "file description parsing / serializing" $ do - it "parse YAML file description" testParseYAMLFileDescription - it "serialize YAML file description" testSerializeYAMLFileDescription - it "parse file description" testParseFileDescription - it "serialize file description" testSerializeFileDescription - testParseYAMLFileDescription :: IO () testParseYAMLFileDescription = do yfd <- Y.decodeFileThrow fileDescPath diff --git a/tests/fixtures/file_description.yaml b/tests/fixtures/file_description.yaml index 42f521d1f..a96e9a4f3 100644 --- a/tests/fixtures/file_description.yaml +++ b/tests/fixtures/file_description.yaml @@ -1,8 +1,7 @@ chunkSize: 8mb digest: YWJj -iv: Z2hp -key: ZGVm -name: file.ext +key: 00n8p1tJq5E-SGnHcYTOrS4A9I07gTA_WFD6MTFFFOY= +nonce: dPSF-wrQpDiK_K6sYv0BDBZ9S4dg-jmu replicas: - chunks: - 1:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe:Z2hp @@ -20,4 +19,4 @@ replicas: - 2:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe - 3:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe server: xftp://abc=@example4.com -size: 33200000 +size: 26mb