From b29dc159fb600eab756e9a92fb59eb06ce2379e3 Mon Sep 17 00:00:00 2001 From: Patrick Chilton Date: Fri, 7 Aug 2020 21:36:19 +0200 Subject: [PATCH] Hash data in 4GB chunks to avoid uint32_t overflow. --- Crypto/Hash.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs index 50abed6..9a53003 100644 --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -50,11 +50,11 @@ import Basement.Block.Mutable (copyFromPtr, new) import Crypto.Internal.Compat (unsafeDoIO) import Crypto.Hash.Types import Crypto.Hash.Algorithms -import Foreign.Ptr (Ptr) +import Foreign.Ptr (Ptr, plusPtr) import Crypto.Internal.ByteArray (ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B import qualified Data.ByteString.Lazy as L -import Data.Word (Word8) +import Data.Word (Word8, Word32) -- | Hash a strict bytestring into a digest. hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a @@ -88,9 +88,17 @@ hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) hashUpdates c l | null ls = c | otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) -> - mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) ls + mapM_ (\b -> B.withByteArray b (processBlocks ctx (B.length b))) ls where ls = filter (not . B.null) l + -- process the data in 4GB chunks to fit in uint32_t + processBlocks ctx bytesLeft dataPtr + | bytesLeft == 0 = return () + | otherwise = do + hashInternalUpdate ctx dataPtr (fromIntegral actuallyProcessed) + processBlocks ctx (bytesLeft - actuallyProcessed) (dataPtr `plusPtr` actuallyProcessed) + where + actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Word32)) -- | Finalize a context and return a digest. hashFinalize :: forall a . HashAlgorithm a