From 94de01a06f13aeed152129a367e50fb7a54182b6 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Wed, 1 Mar 2023 14:36:55 +0000 Subject: [PATCH] xftp: use SHA256 digest for file chunks to reduce file description size (#666) * xftp: use SHA256 digest for file chunks to reduce file description size * enable all tests --- src/Simplex/FileTransfer/Client/Main.hs | 2 +- src/Simplex/FileTransfer/Transport.hs | 2 +- src/Simplex/Messaging/Crypto/Lazy.hs | 10 +++++++--- tests/XFTPServerTests.hs | 16 ++++++++-------- 4 files changed, 17 insertions(+), 13 deletions(-) diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs index d0c68c3be..3806df586 100644 --- a/src/Simplex/FileTransfer/Client/Main.hs +++ b/src/Simplex/FileTransfer/Client/Main.hs @@ -352,7 +352,7 @@ cliSendFile SendOptions {filePath, outputDir, numRecipients, xftpServers, retryC 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) + digest <- LC.sha256Hash <$> LB.hGet h (fromIntegral chunkSize) pure FileInfo {sndKey, size = fromIntegral chunkSize, digest} getXFTPServer :: TVar StdGen -> NonEmpty XFTPServerWithAuth -> IO XFTPServerWithAuth getXFTPServer gen = \case diff --git a/src/Simplex/FileTransfer/Transport.hs b/src/Simplex/FileTransfer/Transport.hs index d90e54c55..5103d94cf 100644 --- a/src/Simplex/FileTransfer/Transport.hs +++ b/src/Simplex/FileTransfer/Transport.hs @@ -113,5 +113,5 @@ receiveEncFile getBody = receiveFile_ . receive receiveFile_ :: (Handle -> Word32 -> IO (Either XFTPErrorType ())) -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO () receiveFile_ receive XFTPRcvChunkSpec {filePath, chunkSize, chunkDigest} = do ExceptT $ withFile filePath WriteMode (`receive` chunkSize) - digest' <- liftIO $ LC.sha512Hash <$> LB.readFile filePath + digest' <- liftIO $ LC.sha256Hash <$> LB.readFile filePath when (digest' /= chunkDigest) $ throwError DIGEST diff --git a/src/Simplex/Messaging/Crypto/Lazy.hs b/src/Simplex/Messaging/Crypto/Lazy.hs index 1e055bdfd..db40a9fb9 100644 --- a/src/Simplex/Messaging/Crypto/Lazy.hs +++ b/src/Simplex/Messaging/Crypto/Lazy.hs @@ -1,14 +1,14 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Simplex.Messaging.Crypto.Lazy - ( sha512Hash, + ( sha256Hash, + sha512Hash, pad, unPad, sbEncrypt, @@ -28,7 +28,7 @@ where import qualified Crypto.Cipher.XSalsa as XSalsa import qualified Crypto.Error as CE import Crypto.Hash (Digest, hashlazy) -import Crypto.Hash.Algorithms (SHA512) +import Crypto.Hash.Algorithms (SHA256, SHA512) import qualified Crypto.MAC.Poly1305 as Poly1305 import Data.ByteArray (ByteArrayAccess) import qualified Data.ByteArray as BA @@ -45,6 +45,10 @@ import Simplex.Messaging.Encoding type LazyByteString = LB.ByteString +-- | SHA512 digest of a lazy bytestring. +sha256Hash :: LazyByteString -> ByteString +sha256Hash = BA.convert . (hashlazy :: LazyByteString -> Digest SHA256) + -- | SHA512 digest of a lazy bytestring. sha512Hash :: LazyByteString -> ByteString sha512Hash = BA.convert . (hashlazy :: LazyByteString -> Digest SHA512) diff --git a/tests/XFTPServerTests.hs b/tests/XFTPServerTests.hs index 7e3d5ed16..9da40ef8f 100644 --- a/tests/XFTPServerTests.hs +++ b/tests/XFTPServerTests.hs @@ -83,7 +83,7 @@ runTestFileChunkDelivery s r = do (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 (rcvKey, rpKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 bytes <- liftIO $ createTestChunk testChunkPath - digest <- liftIO $ LC.sha512Hash <$> LB.readFile testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath let file = FileInfo {sndKey, size = chSize, digest} chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize} (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing @@ -108,7 +108,7 @@ runTestFileChunkDelete s r = do (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 (rcvKey, rpKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 bytes <- liftIO $ createTestChunk testChunkPath - digest <- liftIO $ LC.sha512Hash <$> LB.readFile testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath let file = FileInfo {sndKey, size = chSize, digest} chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize} (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing @@ -136,7 +136,7 @@ runTestFileChunkAck s r = do (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 (rcvKey, rpKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 bytes <- liftIO $ createTestChunk testChunkPath - digest <- liftIO $ LC.sha512Hash <$> LB.readFile testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath let file = FileInfo {sndKey, size = chSize, digest} chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize} (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing @@ -156,7 +156,7 @@ testWrongChunkSize = xftpTest $ \c -> runRight_ $ do (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 (rcvKey, _rpKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 liftIO $ B.writeFile testChunkPath =<< getRandomBytes (kb 96) - digest <- liftIO $ LC.sha512Hash <$> LB.readFile testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath let file = FileInfo {sndKey, size = kb 96, digest} void (createXFTPChunk c spKey file [rcvKey] Nothing) `catchError` (liftIO . (`shouldBe` PCEProtocolError SIZE)) @@ -167,7 +167,7 @@ testFileChunkExpiration = withXFTPServerCfg testXFTPServerConfig {fileExpiration (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 (rcvKey, rpKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 bytes <- liftIO $ createTestChunk testChunkPath - digest <- liftIO $ LC.sha512Hash <$> LB.readFile testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath let file = FileInfo {sndKey, size = chSize, digest} chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize} (sId, [rId]) <- createXFTPChunk c spKey file [rcvKey] Nothing @@ -190,7 +190,7 @@ testFileStorageQuota = withXFTPServerCfg testXFTPServerConfig {fileSizeQuota = J (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 (rcvKey, rpKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 bytes <- liftIO $ createTestChunk testChunkPath - digest <- liftIO $ LC.sha512Hash <$> LB.readFile testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath let file = FileInfo {sndKey, size = chSize, digest} chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize} download rId = do @@ -217,7 +217,7 @@ testFileLog = do (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 (rcvKey1, rpKey1) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 (rcvKey2, rpKey2) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 - digest <- liftIO $ LC.sha512Hash <$> LB.readFile testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath sIdVar <- newTVarIO "" rIdVar1 <- newTVarIO "" rIdVar2 <- newTVarIO "" @@ -295,7 +295,7 @@ testFileBasicAuth allowNewFiles newFileBasicAuth clntAuth success = (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 (rcvKey, rpKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519 bytes <- liftIO $ createTestChunk testChunkPath - digest <- liftIO $ LC.sha512Hash <$> LB.readFile testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath let file = FileInfo {sndKey, size = chSize, digest} chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize} if success