Add HashAlgorithmPrefix API

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

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

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