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

@@ -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

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

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)

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