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

Merge pull request #331 from chpatrick/hash-4gb

Browse Source 
Hash data in 4GB chunks to avoid uint32_t overflow.
This commit is contained in:
Vincent Hanquez 2020-08-08 09:24:47 +08:00 committed by GitHub
commit d0ead79fed
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
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