cryptohash 0.7.10 → 0.8.0

raw patch · 24 files changed

+703/−174 lines, 24 filesdep +ghc-primdep ~basedep ~bytestringdep ~crypto-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

Dependency ranges changed: base, bytestring, crypto-api

API changes (from Hackage documentation)

Files

• Bench/BenchAPI.hs +37/−0
• Crypto/Hash.hs +125/−0
• Crypto/Hash/MD2.hs +22/−9
• Crypto/Hash/MD4.hs +22/−9
• Crypto/Hash/MD5.hs +22/−9
• Crypto/Hash/RIPEMD160.hs +22/−9
• Crypto/Hash/SHA1.hs +22/−9
• Crypto/Hash/SHA224.hs +22/−9
• Crypto/Hash/SHA256.hs +22/−9
• Crypto/Hash/SHA3.hs +47/−9
• Crypto/Hash/SHA384.hs +22/−9
• Crypto/Hash/SHA512.hs +29/−17
• Crypto/Hash/SHA512t.hs +0/−3
• Crypto/Hash/Skein256.hs +26/−15
• Crypto/Hash/Skein512.hs +26/−15
• Crypto/Hash/Tiger.hs +22/−9
• Crypto/Hash/Types.hs +49/−0
• Crypto/Hash/Utils.hs +72/−0
• Crypto/Hash/Whirlpool.hs +22/−9
• README.md +29/−6
• cbits/skein256.c +2/−2
• cbits/skein512.c +2/−2
• cbits/skein512.h +1/−1
• cryptohash.cabal +38/−14

@@ -0,0 +1,37 @@+{-# LANGUAGE BangPatterns #-}+import Criterion.Main+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Crypto.Hash.SHA1 as SHA1+import qualified Crypto.Hash.SHA3 as SHA3+import Crypto.Hash+import qualified Crypto.Classes as CAPI++main = do+    let !bs32     = B.replicate 32 0+        !bs256    = B.replicate 256 0+        !bs4096   = B.replicate 4096 0+        !bs1M     = B.replicate (1*1024*1024) 0+    let !lbs64x256 = (map (const (B.replicate 64 0)) [0..3])+        !lbs64x4096 = (map (const (B.replicate 64 0)) [0..63])+    defaultMain+        [ bcompare+            [ bench "sha1.hash 32" $ whnf SHA1.hash bs32+            , bench "sha1.incr 32" $ whnf (SHA1.finalize . SHA1.update SHA1.init) bs32+            , bench "sha1.api 32"  $ whnf (digestToByteString . hashsha1) bs32+            , bench "sha1.capi 32" $ whnf (CAPI.hash' :: B.ByteString -> SHA1.SHA1) bs32+            ]+        , bcompare+            [ bench "sha1.hash 256" $ whnf SHA1.hash bs256+            , bench "sha1.incr 256" $ whnf (SHA1.finalize . SHA1.update SHA1.init) bs256+            , bench "sha1.api 256"  $ whnf (digestToByteString . hashsha1) bs256+            , bench "sha1.capi 256" $ whnf (CAPI.hash' :: B.ByteString -> SHA1.SHA1) bs256+            ]+        , bcompare+            [ bench "sha1.hash 4096" $ whnf SHA1.hash bs4096+            , bench "sha1.incr 4096" $ whnf (SHA1.finalize . SHA1.update SHA1.init) bs4096+            , bench "sha1.api 4096"  $ whnf (digestToByteString . hashsha1) bs4096+            , bench "sha1.capi 4096" $ whnf (CAPI.hash' :: B.ByteString -> SHA1.SHA1) bs4096+            ]+        ]+    where hashsha1 = hash :: B.ByteString -> Digest SHA1

@@ -0,0 +1,125 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE CPP #-}+-- |+-- Module      : Crypto.Hash+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- Crypto hash main module+--+module Crypto.Hash+    (+    -- * Types+      HashAlgorithm(..)+    , Context+    , Digest+    -- * Functions+    , digestToByteString+    , digestToHexByteString+    , hash+    , hashlazy+    , hashUpdate+    -- * hash algorithms+    , MD2+    , MD4+    , MD5+    , SHA1+    , SHA224+    , SHA256+    , SHA384+    , SHA512+    , RIPEMD160+    , Tiger+    , SHA3_224+    , SHA3_256+    , SHA3_384+    , SHA3_512+    , Skein256_224+    , Skein256_256+    , Skein512_224+    , Skein512_256+    , Skein512_384+    , Skein512_512+    , Whirlpool+    )+    where++import Crypto.Hash.Types+import Crypto.Hash.Utils+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as L++import qualified Crypto.Hash.MD2 as MD2+import qualified Crypto.Hash.MD4 as MD4+import qualified Crypto.Hash.MD5 as MD5+import qualified Crypto.Hash.SHA1 as SHA1+import qualified Crypto.Hash.SHA224 as SHA224+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Crypto.Hash.SHA384 as SHA384+import qualified Crypto.Hash.SHA512 as SHA512+import qualified Crypto.Hash.SHA3 as SHA3+import qualified Crypto.Hash.RIPEMD160 as RIPEMD160+import qualified Crypto.Hash.Tiger as Tiger+import qualified Crypto.Hash.Skein256 as Skein256+import qualified Crypto.Hash.Skein512 as Skein512+import qualified Crypto.Hash.Whirlpool as Whirlpool++-- | run hashUpdates on one single bytestring and return the updated context.+hashUpdate :: HashAlgorithm a => Context a -> ByteString -> Context a+hashUpdate ctx b = hashUpdates ctx [b]++-- | Hash a strict bytestring into a digest.+hash :: HashAlgorithm a => ByteString -> Digest a+hash bs = hashFinalize $ hashUpdate hashInit bs++-- | Hash a lazy bytestring into a digest.+hashlazy :: HashAlgorithm a => L.ByteString -> Digest a+hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs)++-- | Return the hexadecimal (base16) bytestring of the digest+digestToHexByteString :: Digest a -> ByteString+digestToHexByteString = toHex . digestToByteString++#define DEFINE_INSTANCE(NAME, MODULENAME) \+data NAME; \+instance HashAlgorithm NAME where \+    { hashInit = Context c where { (MODULENAME.Ctx c) = MODULENAME.init } \+    ; hashUpdates (Context c) bs = Context nc where { (MODULENAME.Ctx nc) = MODULENAME.updates (MODULENAME.Ctx c) bs } \+    ; hashFinalize (Context c) = Digest $ MODULENAME.finalize (MODULENAME.Ctx c) \+    };++#define DEFINE_INSTANCE_LEN(NAME, MODULENAME, LEN) \+data NAME; \+instance HashAlgorithm NAME where \+    { hashInit = Context c where { (MODULENAME.Ctx c) = MODULENAME.init LEN } \+    ; hashUpdates (Context c) bs = Context nc where { (MODULENAME.Ctx nc) = MODULENAME.updates (MODULENAME.Ctx c) bs } \+    ; hashFinalize (Context c) = Digest $ MODULENAME.finalize (MODULENAME.Ctx c) \+    };++DEFINE_INSTANCE(MD2, MD2)+DEFINE_INSTANCE(MD4, MD4)+DEFINE_INSTANCE(MD5, MD5)+DEFINE_INSTANCE(SHA1, SHA1)+DEFINE_INSTANCE(SHA224, SHA224)+DEFINE_INSTANCE(SHA256, SHA256)+DEFINE_INSTANCE(SHA384, SHA384)+DEFINE_INSTANCE(SHA512, SHA512)++DEFINE_INSTANCE(RIPEMD160, RIPEMD160)+DEFINE_INSTANCE(Whirlpool, Whirlpool)+DEFINE_INSTANCE(Tiger, Tiger)++DEFINE_INSTANCE_LEN(SHA3_224, SHA3, 224)+DEFINE_INSTANCE_LEN(SHA3_256, SHA3, 256)+DEFINE_INSTANCE_LEN(SHA3_384, SHA3, 384)+DEFINE_INSTANCE_LEN(SHA3_512, SHA3, 512)++DEFINE_INSTANCE_LEN(Skein256_224, Skein256, 224)+DEFINE_INSTANCE_LEN(Skein256_256, Skein256, 256)++DEFINE_INSTANCE_LEN(Skein512_224, Skein512, 224)+DEFINE_INSTANCE_LEN(Skein512_256, Skein512, 256)+DEFINE_INSTANCE_LEN(Skein512_384, Skein512, 384)+DEFINE_INSTANCE_LEN(Skein512_512, Skein512, 512)

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data MD2 = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 96 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_md2_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_md2_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_md2_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_md2_init+init = unsafeDupablePerformIO $ withCtxNew $ c_md2_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_md2_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_md2_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data MD4 = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 96 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_md4_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_md4_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_md4_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_md4_init+init = unsafeDupablePerformIO $ withCtxNew $ c_md4_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_md4_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_md4_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data MD5 = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 96 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_md5_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_md5_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_md5_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_md5_init+init = unsafeDupablePerformIO $ withCtxNew $ c_md5_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_md5_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_md5_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data RIPEMD160 = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 128 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_ripemd160_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_ripemd160_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_ripemd160_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_ripemd160_init+init = unsafeDupablePerformIO $ withCtxNew $ c_ripemd160_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_ripemd160_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_ripemd160_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data SHA1 = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 96 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_sha1_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_sha1_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_sha1_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_sha1_init+init = unsafeDupablePerformIO $ withCtxNew $ c_sha1_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha1_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha1_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data SHA224 = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 192 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_sha224_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_sha224_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_sha224_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_sha224_init+init = unsafeDupablePerformIO $ withCtxNew $ c_sha224_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha224_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha224_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data SHA256 = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 192 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_sha256_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_sha256_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_sha256_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_sha256_init+init = unsafeDupablePerformIO $ withCtxNew $ c_sha256_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha256_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha256_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}  -- | -- Module      : Crypto.Hash.SHA3@@ -11,10 +11,12 @@ -- module Crypto.Hash.SHA3     ( Ctx(..)+    , SHA3      -- * Incremental hashing Functions     , init     -- :: Int -> Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -30,11 +32,37 @@ import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO) -data Ctx = Ctx !ByteString+#ifdef HAVE_CRYPTOAPI +import Control.Monad (liftM)+import Data.Serialize (Serialize(..))+import Data.Serialize.Get (getByteString)+import Data.Serialize.Put (putByteString)+import Data.Tagged (Tagged(..))+import qualified Crypto.Classes as C (Hash(..))++instance C.Hash Ctx SHA3 where+    outputLength    = Tagged (64 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init (64 * 8)+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs++instance Serialize SHA3 where+    get            = liftM Digest (getByteString 64)+    put (Digest d) = putByteString d++#endif++newtype Ctx = Ctx ByteString+data SHA3 = Digest !ByteString+    deriving (Eq,Ord,Show)++ {-# INLINE sizeCtx #-} sizeCtx :: Int sizeCtx = 360@@ -45,6 +73,11 @@     where iptr :: Ptr Word32           iptr = castPtr ptr +{-# RULES "hash" forall b i. finalize (update (init i) b) = hash i b #-}+{-# RULES "hash.list1" forall b i. finalize (updates (init i) [b]) = hash i b #-}+{-# RULES "hashmany" forall b i. finalize (foldl update (init i) b) = hashlazy i (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b i. finalize (foldl update (init i) $ L.toChunks b) = hashlazy i b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -53,7 +86,7 @@  {-# INLINE memcopy64 #-} memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()-memcopy64 dst src = mapM_ peekAndPoke [0..44]+memcopy64 dst src = mapM_ peekAndPoke [0..(45-1)]     where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i  withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx@@ -96,26 +129,31 @@ {-# NOINLINE init #-} -- | init a context init :: Int -> Ctx-init hashlen = inlinePerformIO $ withCtxNew (\ctx -> c_sha3_init ctx (fromIntegral hashlen))+init hashlen = unsafeDupablePerformIO $ withCtxNew $ \ptr -> c_sha3_init ptr (fromIntegral hashlen)  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: Int -> ByteString -> ByteString-hash hashlen d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash hashlen d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha3_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: Int -> L.ByteString -> ByteString-hashlazy hashlen l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy hashlen l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha3_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data SHA384 = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 256 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_sha384_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_sha384_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_sha384_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_sha384_init+init = unsafeDupablePerformIO $ withCtxNew $ c_sha384_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha384_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha384_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -17,6 +17,7 @@     , init     -- :: Ctx     , init_t   -- :: Int -> Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -25,16 +26,17 @@     ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO) import Foreign.Ptr import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -58,7 +60,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data SHA512 = Digest !ByteString     deriving (Eq,Ord,Show) @@ -71,6 +73,12 @@ sizeCtx :: Int sizeCtx = 256 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -105,51 +113,55 @@ foreign import ccall unsafe "sha512.h sha512_init"     c_sha512_init :: Ptr Ctx -> IO () -foreign import ccall unsafe "sha512.h sha512_init_t"-    c_sha512_init_t :: Ptr Ctx -> Int -> IO ()- foreign import ccall "sha512.h sha512_update"     c_sha512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "sha512.h sha512_finalize"     c_sha512_finalize :: Ptr Ctx -> Ptr Word8 -> IO () +foreign import ccall unsafe "sha512.h sha512_init_t"+    c_sha512_init_t :: Ptr Ctx -> Int -> IO ()++{-# NOINLINE init_t #-}+-- | init a context using FIPS 180-4 for truncated SHA512+init_t :: Int -> Ctx+init_t t = unsafeDupablePerformIO $ withCtxNew $ \ptr -> c_sha512_init_t ptr t+ updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =     unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_sha512_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_sha512_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ withCtxNew $ c_sha512_init--{-# NOINLINE init_t #-}--- | init a context using FIPS 180-4 for truncated SHA512-init_t :: Int -> Ctx-init_t t = unsafePerformIO $ withCtxNew $ \ptr -> c_sha512_init_t ptr t+init = unsafeDupablePerformIO $ withCtxNew $ c_sha512_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha512_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = unsafePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_sha512_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -1,5 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses #-}- -- | -- Module      : Crypto.Hash.SHA512t -- License     : BSD-style@@ -11,7 +9,6 @@ -- module Crypto.Hash.SHA512t     ( Ctx(..)-    --, SHA512t      -- * Incremental hashing Functions     , init     -- :: Ctx

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Int -> Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -24,7 +25,6 @@     ) where  import Prelude hiding (init)-import Foreign.C.Types import Foreign.Ptr import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable@@ -32,9 +32,9 @@ import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, inlinePerformIO, toForeignPtr)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word-import Data.Bits+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -58,19 +58,26 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data Skein256 = Digest !ByteString     deriving (Eq,Ord,Show) ++{-# INLINE sizeCtx #-} sizeCtx :: Int-sizeCtx = 88+sizeCtx = 96 +{- return the number of bytes of output for the digest -} peekHashlen :: Ptr Ctx -> IO Int-peekHashlen ptr = do-    let iptr = castPtr ptr :: Ptr CUInt-    a <- peek iptr-    return ((fromIntegral a + 7) `shiftR` 3)+peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v+    where iptr :: Ptr Word32+          iptr = castPtr ptr +{-# RULES "hash" forall b i. finalize (update (init i) b) = hash i b #-}+{-# RULES "hash.list1" forall b i. finalize (updates (init i) [b]) = hash i b #-}+{-# RULES "hashmany" forall b i. finalize (foldl update (init i) b) = hashlazy i (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b i. finalize (foldl update (init i) $ L.toChunks b) = hashlazy i b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -111,7 +118,6 @@ foreign import ccall unsafe "skein256.h skein256_finalize"     c_skein256_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =     unsafeUseAsCStringLen d (\(cs, len) -> c_skein256_update ptr (castPtr cs) (fromIntegral len))@@ -123,26 +129,31 @@ {-# NOINLINE init #-} -- | init a context init :: Int -> Ctx-init hashlen = inlinePerformIO $ withCtxNew $ \ptr -> c_skein256_init ptr (fromIntegral hashlen)+init hashlen = unsafeDupablePerformIO $ withCtxNew $ \ptr -> c_skein256_init ptr (fromIntegral hashlen)  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: Int -> ByteString -> ByteString-hash hashlen d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash hashlen d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_skein256_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: Int -> L.ByteString -> ByteString-hashlazy hashlen l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy hashlen l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_skein256_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Int -> Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -24,7 +25,6 @@     ) where  import Prelude hiding (init)-import Foreign.C.Types import Foreign.Ptr import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable@@ -32,9 +32,9 @@ import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, inlinePerformIO, toForeignPtr)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word-import Data.Bits+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -58,19 +58,26 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data Skein512 = Digest !ByteString     deriving (Eq,Ord,Show) ++{-# INLINE sizeCtx #-} sizeCtx :: Int-sizeCtx = 152+sizeCtx = 160 +{- return the number of bytes of output for the digest -} peekHashlen :: Ptr Ctx -> IO Int-peekHashlen ptr = do-    let iptr = castPtr ptr :: Ptr CUInt-    a <- peek iptr-    return ((fromIntegral a + 7) `shiftR` 3)+peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v+    where iptr :: Ptr Word32+          iptr = castPtr ptr +{-# RULES "hash" forall b i. finalize (update (init i) b) = hash i b #-}+{-# RULES "hash.list1" forall b i. finalize (updates (init i) [b]) = hash i b #-}+{-# RULES "hashmany" forall b i. finalize (foldl update (init i) b) = hashlazy i (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b i. finalize (foldl update (init i) $ L.toChunks b) = hashlazy i b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -111,7 +118,6 @@ foreign import ccall unsafe "skein512.h skein512_finalize"     c_skein512_finalize :: Ptr Ctx -> Ptr Word8 -> IO () - updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =     unsafeUseAsCStringLen d (\(cs, len) -> c_skein512_update ptr (castPtr cs) (fromIntegral len))@@ -123,26 +129,31 @@ {-# NOINLINE init #-} -- | init a context init :: Int -> Ctx-init hashlen = inlinePerformIO $ withCtxNew $ \ptr -> c_skein512_init ptr (fromIntegral hashlen)+init hashlen = unsafeDupablePerformIO $ withCtxNew $ \ptr -> c_skein512_init ptr (fromIntegral hashlen)  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: Int -> ByteString -> ByteString-hash hashlen d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash hashlen d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_skein512_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: Int -> L.ByteString -> ByteString-hashlazy hashlen l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy hashlen l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_skein512_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data Tiger = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 96 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_tiger_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_tiger_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_tiger_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_tiger_init+init = unsafeDupablePerformIO $ withCtxNew $ c_tiger_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_tiger_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_tiger_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -0,0 +1,49 @@+-- |+-- Module      : Crypto.Hash.Types+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- Crypto hash types definitions+--+module Crypto.Hash.Types+    ( HashAlgorithm(..)+    , Context(..)+    , Digest(..)+    )+    where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BC+import Crypto.Hash.Utils (toHex)++-- | Class representing hashing algorithms.+--+-- The hash algorithm is built over 3 primitives:+--+--   init     : create a new context+--   updates  : update the context with some strict bytestrings+--   finalize : finalize the context into a digest+--+class HashAlgorithm a where+    -- | Initialize a new context for this hash algorithm+    hashInit     :: Context a++    -- | Update the context with a list of strict bytestring,+    -- and return a new context with the updates.+    hashUpdates  :: Context a -> [ByteString] -> Context a++    -- | Finalize a context and return a digest.+    hashFinalize :: Context a -> Digest a++-- | Represent a context for a given hash algorithm.+newtype Context a = Context { contextToByteString :: ByteString }++-- | Represent a digest for a given hash algorithm.+newtype Digest a = Digest { digestToByteString :: ByteString -- ^ Return the binary digest+                          }+    deriving (Eq,Ord)++instance Show (Digest a) where+    show (Digest bs) = BC.unpack $ toHex bs

@@ -0,0 +1,72 @@+{-# LANGUAGE MagicHash, BangPatterns #-}+-- |+-- Module      : Crypto.Hash.Utils+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- Crypto hash utility for hexadecimal+--+module Crypto.Hash.Utils+    ( toHex+    ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as B+import GHC.Prim+import GHC.Types+import GHC.Word+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (plusPtr)+import Foreign.Storable (poke, peek)++toHex :: ByteString -> ByteString+toHex (B.PS fp off len) = B.unsafeCreate (len*2) $ \d ->+        withForeignPtr fp $ \s -> start d (s `plusPtr` off)+    where start db sb = loop db sb+                where end            = sb `plusPtr` len+                      loop d s+                         | s == end  = return ()+                         | otherwise = do b <- fromIntegral `fmap` (peek s :: IO Word8)+                                          poke d               (r tableHi b)+                                          poke (d `plusPtr` 1) (r tableLo b)+                                          loop (d `plusPtr` 2) (s `plusPtr` 1)++          r :: Addr# -> Int -> Word8+          r table (I# index) = W8# (indexWord8OffAddr# table index)++          !tableLo =+              "\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\+              \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66"#+          !tableHi =+              "\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\+              \\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\+              \\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\+              \\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\+              \\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\+              \\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\+              \\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\+              \\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\+              \\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\+              \\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\+              \\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\+              \\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\+              \\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\+              \\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\+              \\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\+              \\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66"#

@@ -16,6 +16,7 @@     -- * Incremental hashing Functions     , init     -- :: Ctx     , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx     , finalize -- :: Ctx -> ByteString      -- * Single Pass hashing@@ -29,10 +30,12 @@ import Foreign.Storable import Foreign.Marshal.Alloc import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)  #ifdef HAVE_CRYPTOAPI @@ -56,7 +59,7 @@  #endif -data Ctx = Ctx !ByteString+newtype Ctx = Ctx ByteString data Whirlpool = Digest !ByteString     deriving (Eq,Ord,Show) @@ -69,6 +72,12 @@ sizeCtx :: Int sizeCtx = 168 +{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}+ {-# INLINE withByteStringPtr #-} withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a withByteStringPtr b f =@@ -114,32 +123,36 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_whirlpool_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr =-    create digestSize (c_whirlpool_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_whirlpool_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = inlinePerformIO $ withCtxNew $ c_whirlpool_init+init = unsafeDupablePerformIO $ withCtxNew $ c_whirlpool_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+update ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d +{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDupablePerformIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO+finalize ctx = unsafeDupablePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hash d = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_whirlpool_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr  {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring hashlazy :: L.ByteString -> ByteString-hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+hashlazy l = unsafeDupablePerformIO $ withCtxNewThrow $ \ptr -> do     c_whirlpool_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -33,15 +33,16 @@ Incremental API --------------- -it's based on 3 different functions, similar to the lowlevel operations+it's based on 4 different functions, similar to the lowlevel operations of a typical hash:  * init: create a new hash context * update: update non-destructively a new hash context with a strict bytestring+* updates: same as update, except that it takes a list of strict bytestring * finalize: finalize the context and returns a digest bytestring.  all those operations are completely pure, and instead of changing the-context as usual in others language, it create a new context each time.+context as usual in others language, it re-allocate a new context each time.  One Pass API ------------@@ -52,11 +53,33 @@ * hash: create a digest (init+update+finalize) from a strict bytestring * hashlazy: create a digest (init+update+finalize) from a lazy bytestring -Integration with crypto-api----------------------------+More Type safety+---------------- -cryptohash is fully integrated with crypto-api and you can use the-related function in crypto-api to use any cryptohash modules.+A more type safe API is also available from Crypto.Hash. The API provides+all the supported hashes in the same namespace, through unified functions.++It introduces 2 new types, the Context type and the Digest type.+Both those types are parametrized with the HashAlgorithm used.++The API is very similar to each single hash module, except the types are+slightly differents.++    import Crypto.Hash++    -- use the incremental API to hash the byte [1,2,3] with SHA1+    -- and print the hexadecimal digest.+    example1 = do+        let ctx = hashInit+            ctx' = hashUpdates ctx [ Data.ByteString.pack [1,2,3] ]+            dgt  = hashFinalize ctx' :: Digest SHA1+        putStrLn $ show dgt++    -- use the one-pass API to hash the byte 1,2,3 with SHA3_512+    -- and print the hexadecimal digest.+    example2 = do+        let dgt  = hash (Data.ByteString.pack [1,2,3]) :: Digest SHA3_512+        putStrLn $ show dgt  Performance -----------

@@ -108,7 +108,7 @@ 	uint64_t buf[4]; 	memset(ctx, 0, sizeof(*ctx)); -	ctx->hashlen = hashlen;+	ctx->hashlen = (hashlen + 7) >> 3; 	SET_TYPE(ctx, FLAG_FIRST | FLAG_FINAL | FLAG_TYPE(TYPE_CFG)); 	 	memset(buf, '\0', sizeof(buf));@@ -167,7 +167,7 @@ 	memset(ctx->buf, '\0', 32);  	/* make sure we have a 8 bit rounded value */-	outsize = (ctx->hashlen + 7) >> 3;+	outsize = ctx->hashlen;  	/* backup h[0--4] */ 	for (j = 0; j < 4; j++)

@@ -126,7 +126,7 @@ 	uint64_t buf[8]; 	memset(ctx, 0, sizeof(*ctx)); -	ctx->hashlen = hashlen;+	ctx->hashlen = (hashlen + 7) >> 3; 	SET_TYPE(ctx, FLAG_FIRST | FLAG_FINAL | FLAG_TYPE(TYPE_CFG)); 	 	memset(buf, '\0', sizeof(buf));@@ -185,7 +185,7 @@ 	memset(ctx->buf, '\0', 64);  	/* make sure we have a 8 bit rounded value */-	outsize = (ctx->hashlen + 7) >> 3;+	outsize = ctx->hashlen;  	/* backup h[0--7] */ 	for (j = 0; j < 8; j++)

@@ -28,7 +28,7 @@  struct skein512_ctx {-	uint32_t hashlen; /* in bits, typically 384, 512 */+	uint32_t hashlen; /* in bytes, typically 384/8, 512/8 */ 	uint32_t bufindex; 	uint8_t  buf[64]; 	uint64_t h[8];

@@ -1,11 +1,33 @@ Name:                cryptohash-Version:             0.7.10+Version:             0.8.0 Description:     A collection of crypto hashes, with a practical incremental and one-pass, pure APIs,     with performance close to the fastest implementations available in others languages.     .     The implementations are made in C with a haskell FFI wrapper that hide the C implementation.-+    .+    Simple examples using the unified API:+    .+    > import Crypto.Hash+    >+    > sha1 :: ByteString -> Digest SHA1+    > sha1 = hash+    >+    > hexSha3_512 :: ByteString -> String+    > hexSha3_512 bs = show (hash bs :: Digest SHA3_512)+    .+    Simple examples using the module API:+    .+    > import qualified Crypto.Hash.SHA1 as SHA1+    >+    > main = putStrLn $ show $ SHA1.hash (Data.ByteString.pack [1..256])+    .+    > import qualified Crypto.Hash.SHA3 as SHA3+    >+    > main = putStrLn $ show $ digest+    >   where digest = SHA3.finalize ctx+    >         ctx    = foldl' SHA3.update iCtx (map Data.ByteString.pack [ [1,2,3], [4,5,6] ]+    >         iCtx   = SHA3.init 224 License:             BSD3 License-file:        LICENSE Copyright:           Vincent Hanquez <vincent@snarc.org>@@ -24,23 +46,21 @@   cbits/skein.h cbits/skein256.h cbits/skein512.h   cbits/tiger.h cbits/whirlpool.h -Flag benchmark-  Description:       Build benchmark test-  Default:           False- Flag cryptoapi   Description:       Defines crypto-api instances   Default:           True  Library-  Build-Depends:     base >= 4 && < 6, bytestring+  Build-Depends:     base >= 4 && < 6, bytestring, ghc-prim   if flag(cryptoapi)     Build-depends:   crypto-api >= 0.5, tagged >= 0.1, cereal >= 0.2     cpp-options:     -DHAVE_CRYPTOAPI   if impl(ghc >= 7.2.1)     Extensions:      Trustworthy   Extensions:        ForeignFunctionInterface-  Exposed-modules:   Crypto.Hash.SHA1+  Exposed-modules:   Crypto.Hash+                     Crypto.Hash.Types+                     Crypto.Hash.SHA1                      Crypto.Hash.SHA224                      Crypto.Hash.SHA256                      Crypto.Hash.SHA384@@ -56,6 +76,7 @@                      Crypto.Hash.Tiger                      Crypto.Hash.Whirlpool                      Crypto.MAC.HMAC+  Other-modules:     Crypto.Hash.Utils   ghc-options:       -Wall -O2 -optc-O3 -fno-cse -fwarn-tabs   C-sources:         cbits/sha1.c                      cbits/sha256.c@@ -84,14 +105,17 @@                    , test-framework-hunit                    , cryptohash -Executable           Bench+Benchmark bench-hashes   Main-Is:           Bench.hs   hs-source-dirs:    Bench-  if flag(benchmark)-    Buildable:       True-    Build-depends:   base >= 4, bytestring, criterion, cryptohash-  else-    Buildable:       False+  type:              exitcode-stdio-1.0+  Build-depends:     base >= 4, bytestring, criterion, cryptohash++Benchmark bench-api+  Main-Is:           BenchAPI.hs+  hs-source-dirs:    Bench+  type:              exitcode-stdio-1.0+  Build-depends:     base >= 4, bytestring, criterion, cryptohash, crypto-api  source-repository head   type:     git