Merge pull request #156 from haskell-crypto/hash-update

Hash update

Crypto/Hash.hs

@@ -16,6 +16,8 @@
 -- > hexSha3_512 :: ByteString -> String
 -- > hexSha3_512 bs = show (hash bs :: Digest SHA3_512)
 --
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns        #-}
 module Crypto.Hash
     (
     -- * Types
@@ -56,44 +58,37 @@ hashlazy :: HashAlgorithm a => L.ByteString -> Digest a
 hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs)
 
 -- | Initialize a new context for this hash algorithm
-hashInit :: HashAlgorithm a
+hashInit :: forall a . HashAlgorithm a => Context a
-         => Context a
+hashInit = Context $ B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr (Context a)) ->
-hashInit = doInit undefined B.allocAndFreeze
+    hashInternalInit ptr
-  where
-        doInit :: HashAlgorithm a => a -> (Int -> (Ptr (Context a) -> IO ()) -> B.Bytes) -> Context a
-        doInit alg alloc = Context $ alloc (hashInternalContextSize alg) hashInternalInit
-{-# NOINLINE hashInit #-}
 
 -- | run hashUpdates on one single bytestring and return the updated context.
 hashUpdate :: (ByteArrayAccess ba, HashAlgorithm a) => Context a -> ba -> Context a
-hashUpdate ctx b = hashUpdates ctx [b]
+hashUpdate ctx b
+    | B.null b  = ctx
+    | otherwise = hashUpdates ctx [b]
 
 -- | Update the context with a list of strict bytestring,
 -- and return a new context with the updates.
-hashUpdates :: (HashAlgorithm a, ByteArrayAccess ba)
+hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba)
             => Context a
             -> [ba]
             -> Context a
-hashUpdates c l = doUpdates (B.copyAndFreeze c)
+hashUpdates c l
-  where doUpdates :: HashAlgorithm a => ((Ptr (Context a) -> IO ()) -> B.Bytes) -> Context a
+    | null ls   = c
-        doUpdates copy = Context $ copy $ \ctx ->
+    | otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) ->
-            mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) l
+        mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) ls
-{-# NOINLINE hashUpdates #-}
+  where
+    ls = filter (not . B.null) l
 
 -- | Finalize a context and return a digest.
-hashFinalize :: HashAlgorithm a
+hashFinalize :: forall a . HashAlgorithm a
              => Context a
              -> Digest a
-hashFinalize c = doFinalize undefined (B.copy c) (B.allocAndFreeze)
+hashFinalize !c =
-  where doFinalize :: HashAlgorithm alg
+    Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do
-                   => alg
+        ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
-                   -> ((Ptr (Context alg) -> IO ()) -> IO B.Bytes)
+        return ()
-                   -> (Int -> (Ptr (Digest alg)  -> IO ()) -> B.Bytes)
-                   -> Digest alg
-        doFinalize alg copy allocDigest =
-            Digest $ allocDigest (hashDigestSize alg) $ \dig ->
-                (void $ copy $ \ctx -> hashInternalFinalize ctx dig)
-{-# NOINLINE hashFinalize #-}
 
 -- | Initialize a new context for a specified hash algorithm
 hashInitWith :: HashAlgorithm alg => alg -> Context alg

Crypto/Hash/IO.hs

@@ -8,6 +8,7 @@
 -- Generalized impure cryptographic hash interface
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
 module Crypto.Hash.IO
     ( HashAlgorithm(..)
     , MutableContext
@@ -51,18 +52,10 @@ hashMutableUpdate mc dat = doUpdate mc (B.withByteArray mc)
                 hashInternalUpdate ctx d (fromIntegral $ B.length dat)
 
 -- | Finalize a mutable hash context and compute a digest
-hashMutableFinalize :: HashAlgorithm a => MutableContext a -> IO (Digest a)
+hashMutableFinalize :: forall a . HashAlgorithm a => MutableContext a -> IO (Digest a)
-hashMutableFinalize mc = doFinalize undefined (B.withByteArray mc) B.alloc
+hashMutableFinalize mc = do
-  where doFinalize :: HashAlgorithm alg
+    b <- B.alloc (hashDigestSize (undefined :: a)) $ \dig -> B.withByteArray mc $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
-                   => alg
+    return $ Digest b
-                   -> ((Ptr (Context alg) -> IO ()) -> IO ())
-                   -> (Int -> (Ptr (Digest alg)  -> IO ()) -> IO B.Bytes)
-                   -> IO (Digest alg)
-        doFinalize alg withCtx allocDigest = do
-            b <- allocDigest (hashDigestSize alg) $ \dig ->
-                    withCtx $ \ctx ->
-                        hashInternalFinalize ctx dig
-            return $ Digest b
 
 -- | Reset the mutable context to the initial state of the hash
 hashMutableReset :: HashAlgorithm a => MutableContext a -> IO ()

Crypto/Hash/Types.hs

@@ -18,6 +18,8 @@ import           Crypto.Internal.Imports
 import           Crypto.Internal.ByteArray (ByteArrayAccess, Bytes)
 import qualified Crypto.Internal.ByteArray as B
 import           Foreign.Ptr (Ptr)
+import qualified Foundation.Array as F
+import qualified Foundation       as F
 
 -- | Class representing hashing algorithms.
 --
@@ -50,8 +52,11 @@ newtype Context a = Context Bytes
     deriving (ByteArrayAccess,NFData)
 
 -- | Represent a digest for a given hash algorithm.
-newtype Digest a = Digest Bytes
+newtype Digest a = Digest (F.UArray Word8)
-    deriving (Eq,Ord,ByteArrayAccess,NFData)
+    deriving (Eq,Ord,ByteArrayAccess)
+
+instance NFData (Digest a) where
+    rnf (Digest u) = u `F.deepseq` ()
 
 instance Show (Digest a) where
     show (Digest bs) = map (toEnum . fromIntegral)

cryptonite.cabal

@@ -220,7 +220,8 @@ Library
                      Crypto.Internal.Nat
   Build-depends:     base >= 4.3 && < 5
                    , bytestring
-                   , memory >= 0.12
+                   , memory >= 0.14.5
+                   , foundation >= 0.0.8
                    , ghc-prim
   ghc-options:       -Wall -fwarn-tabs -optc-O3 -fno-warn-unused-imports
   default-language:  Haskell2010