haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Hash data in 4GB chunks to avoid uint32_t overflow.

Browse Source
This commit is contained in:
Patrick Chilton 2020-08-07 21:36:19 +02:00
parent 10dc63c51f
commit b29dc159fb
1 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Crypto/Hash.hs
View File

@ -50,11 +50,11 @@ import Basement.Block.Mutable (copyFromPtr, new)
import Crypto.Internal.Compat (unsafeDoIO) import Crypto.Internal.Compat (unsafeDoIO)
import Crypto.Hash.Types import Crypto.Hash.Types
import Crypto.Hash.Algorithms import Crypto.Hash.Algorithms
import Foreign.Ptr (Ptr) import Foreign.Ptr (Ptr, plusPtr)
import Crypto.Internal.ByteArray (ByteArrayAccess) import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B import qualified Crypto.Internal.ByteArray as B
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.Word (Word8) import Data.Word (Word8, Word32)
-- | Hash a strict bytestring into a digest. -- | Hash a strict bytestring into a digest.
hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a
@ -88,9 +88,17 @@ hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba)
hashUpdates c l hashUpdates c l
| null ls = c | null ls = c
| otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) -> | 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 where
ls = filter (not . B.null) l 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. -- | Finalize a context and return a digest.
hashFinalize :: forall a . HashAlgorithm a hashFinalize :: forall a . HashAlgorithm a