diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs index 37e6f9f..50abed6 100644 --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -28,14 +28,17 @@ module Crypto.Hash -- * Hash methods parametrized by algorithm , hashInitWith , hashWith + , hashPrefixWith -- * Hash methods , hashInit , hashUpdates , hashUpdate , hashFinalize + , hashFinalizePrefix , hashBlockSize , hashDigestSize , hash + , hashPrefix , hashlazy -- * Hash algorithms , module Crypto.Hash.Algorithms @@ -57,6 +60,10 @@ import Data.Word (Word8) hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a hash bs = hashFinalize $ hashUpdate hashInit bs +-- | Hash the first N bytes of a bytestring, with code path independent from N. +hashPrefix :: (ByteArrayAccess ba, HashAlgorithmPrefix a) => ba -> Int -> Digest a +hashPrefix = hashFinalizePrefix hashInit + -- | Hash a lazy bytestring into a digest. hashlazy :: HashAlgorithm a => L.ByteString -> Digest a hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs) @@ -94,6 +101,24 @@ hashFinalize !c = ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig return () +-- | Update the context with the first N bytes of a bytestring and return the +-- digest. The code path is independent from N but much slower than a normal +-- 'hashUpdate'. The function can be called for the last bytes of a message, in +-- order to exclude a variable padding, without leaking the padding length. The +-- begining of the message, never impacted by the padding, should preferably go +-- through 'hashUpdate' for better performance. +hashFinalizePrefix :: forall a ba . (HashAlgorithmPrefix a, ByteArrayAccess ba) + => Context a + -> ba + -> Int + -> Digest a +hashFinalizePrefix !c b len = + Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do + ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> + B.withByteArray b $ \d -> + hashInternalFinalizePrefix ctx d (fromIntegral $ B.length b) (fromIntegral len) dig + return () + -- | Initialize a new context for a specified hash algorithm hashInitWith :: HashAlgorithm alg => alg -> Context alg hashInitWith _ = hashInit @@ -102,6 +127,10 @@ hashInitWith _ = hashInit hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg hashWith _ = hash +-- | Run the 'hashPrefix' function but takes an explicit hash algorithm parameter +hashPrefixWith :: (ByteArrayAccess ba, HashAlgorithmPrefix alg) => alg -> ba -> Int -> Digest alg +hashPrefixWith _ = hashPrefix + -- | Try to transform a bytearray into a Digest of specific algorithm. -- -- If the digest is not the right size for the algorithm specified, then diff --git a/Crypto/Hash/Algorithms.hs b/Crypto/Hash/Algorithms.hs index 1565c0b..41ab7ee 100644 --- a/Crypto/Hash/Algorithms.hs +++ b/Crypto/Hash/Algorithms.hs @@ -9,6 +9,7 @@ -- module Crypto.Hash.Algorithms ( HashAlgorithm + , HashAlgorithmPrefix -- * Hash algorithms , Blake2s_160(..) , Blake2s_224(..) @@ -54,7 +55,7 @@ module Crypto.Hash.Algorithms , Whirlpool(..) ) where -import Crypto.Hash.Types (HashAlgorithm) +import Crypto.Hash.Types (HashAlgorithm, HashAlgorithmPrefix) import Crypto.Hash.Blake2s import Crypto.Hash.Blake2sp import Crypto.Hash.Blake2b diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs index 65a3b61..c5170fa 100644 --- a/Crypto/Hash/Types.hs +++ b/Crypto/Hash/Types.hs @@ -14,6 +14,7 @@ {-# LANGUAGE TypeFamilies #-} module Crypto.Hash.Types ( HashAlgorithm(..) + , HashAlgorithmPrefix(..) , Context(..) , Digest(..) ) where @@ -59,6 +60,17 @@ class HashAlgorithm a where -- | Finalize the context and set the digest raw memory to the right value hashInternalFinalize :: Ptr (Context a) -> Ptr (Digest a) -> IO () +-- | Hashing algorithms with a constant-time implementation. +class HashAlgorithm a => HashAlgorithmPrefix a where + -- | Update the context with the first N bytes of a buffer and finalize this + -- context. The code path executed is independent from N and depends only + -- on the complete buffer length. + hashInternalFinalizePrefix :: Ptr (Context a) + -> Ptr Word8 -> Word32 + -> Word32 + -> Ptr (Digest a) + -> IO () + {- hashContextGetAlgorithm :: HashAlgorithm a => Context a -> a hashContextGetAlgorithm = undefined