diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs index d5090de..cd08a6a 100644 --- a/Crypto/Hash.hs +++ b/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 - => Context a -hashInit = doInit undefined B.allocAndFreeze - where - doInit :: HashAlgorithm a => a -> (Int -> (Ptr (Context a) -> IO ()) -> B.Bytes) -> Context a - doInit alg alloc = Context $ alloc (hashInternalContextSize alg) hashInternalInit -{-# NOINLINE hashInit #-} +hashInit :: forall a . HashAlgorithm a => Context a +hashInit = Context $ B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr (Context a)) -> + hashInternalInit ptr -- | 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) - where doUpdates :: HashAlgorithm a => ((Ptr (Context a) -> IO ()) -> B.Bytes) -> Context a - doUpdates copy = Context $ copy $ \ctx -> - mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) l -{-# NOINLINE hashUpdates #-} +hashUpdates c l + | null ls = c + | otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) -> + mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) ls + 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) - where doFinalize :: HashAlgorithm alg - => alg - -> ((Ptr (Context alg) -> IO ()) -> IO B.Bytes) - -> (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 #-} +hashFinalize !c = + Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do + ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig + return () -- | Initialize a new context for a specified hash algorithm hashInitWith :: HashAlgorithm alg => alg -> Context alg diff --git a/Crypto/Hash/IO.hs b/Crypto/Hash/IO.hs index 25570e5..91cb0f7 100644 --- a/Crypto/Hash/IO.hs +++ b/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 mc = doFinalize undefined (B.withByteArray mc) B.alloc - where doFinalize :: HashAlgorithm alg - => alg - -> ((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 +hashMutableFinalize :: forall a . HashAlgorithm a => MutableContext a -> IO (Digest a) +hashMutableFinalize mc = do + b <- B.alloc (hashDigestSize (undefined :: a)) $ \dig -> B.withByteArray mc $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig + return $ Digest b -- | Reset the mutable context to the initial state of the hash hashMutableReset :: HashAlgorithm a => MutableContext a -> IO () diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs index ccf8bfc..ec9d392 100644 --- a/Crypto/Hash/Types.hs +++ b/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 - deriving (Eq,Ord,ByteArrayAccess,NFData) +newtype Digest a = Digest (F.UArray Word8) + 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) diff --git a/cryptonite.cabal b/cryptonite.cabal index 4ebac8d..4ca7e6b 100644 --- a/cryptonite.cabal +++ b/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