From ca68eca86ef92ae266a4005ab1ad57b589f83933 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Fri, 15 Mar 2024 10:18:15 +0200
Subject: [PATCH] agent: fix leak in getChunkDigest (#1051)

---
 src/Simplex/FileTransfer/Agent.hs       | 5 +++--
 src/Simplex/FileTransfer/Client/Main.hs | 3 ++-
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index f2138d840..2abf8e3dc 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -35,6 +35,7 @@ import Control.Monad.Reader
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Coerce (coerce)
 import Data.Composition ((.:))
 import Data.Either (rights)
 import Data.Int (Int64)
@@ -406,8 +407,8 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           void $ liftError (INTERNAL . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize fsEncPath
           digest <- liftIO $ LC.sha512Hash <$> LB.readFile fsEncPath
           let chunkSpecs = prepareChunkSpecs fsEncPath chunkSizes
-          chunkDigests <- map FileDigest <$> mapM (liftIO . getChunkDigest) chunkSpecs
-          pure (FileDigest digest, zip chunkSpecs chunkDigests)
+          chunkDigests <- liftIO $ mapM getChunkDigest chunkSpecs
+          pure (FileDigest digest, zip chunkSpecs $ coerce chunkDigests)
         chunkCreated :: SndFileChunk -> Bool
         chunkCreated SndFileChunk {replicas} =
           any (\SndFileChunkReplica {replicaStatus} -> replicaStatus == SFRSCreated) replicas
diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs
index 90348099a..bca41cea8 100644
--- a/src/Simplex/FileTransfer/Client/Main.hs
+++ b/src/Simplex/FileTransfer/Client/Main.hs
@@ -414,7 +414,8 @@ getChunkDigest :: XFTPChunkSpec -> IO ByteString
 getChunkDigest XFTPChunkSpec {filePath = chunkPath, chunkOffset, chunkSize} =
   withFile chunkPath ReadMode $ \h -> do
     hSeek h AbsoluteSeek $ fromIntegral chunkOffset
-    LC.sha256Hash <$> LB.hGet h (fromIntegral chunkSize)
+    chunk <- LB.hGet h (fromIntegral chunkSize)
+    pure $! LC.sha256Hash chunk
 
 cliReceiveFile :: ReceiveOptions -> ExceptT CLIError IO ()
 cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath, verbose, yes} =