cryptohash 0.7.6 → 0.7.7

raw patch · 24 files changed

+1508/−915 lines, 24 filesdep +QuickCheckdep +cryptohashdep +test-frameworkdep ~basedep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, cryptohash, test-framework, test-framework-hunit, test-framework-quickcheck2

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• Bench.hs +0/−44
• Bench/Bench.hs +64/−0
• Crypto/Hash/MD2.hs +68/−47
• Crypto/Hash/MD4.hs +68/−47
• Crypto/Hash/MD5.hs +68/−47
• Crypto/Hash/RIPEMD160.hs +68/−47
• Crypto/Hash/SHA1.hs +68/−47
• Crypto/Hash/SHA224.hs +68/−47
• Crypto/Hash/SHA256.hs +68/−47
• Crypto/Hash/SHA3.hs +121/−0
• Crypto/Hash/SHA384.hs +68/−47
• Crypto/Hash/SHA512.hs +71/−49
• Crypto/Hash/SHA512t.hs +10/−10
• Crypto/Hash/Skein256.hs +69/−53
• Crypto/Hash/Skein512.hs +69/−53
• Crypto/Hash/Tiger.hs +68/−47
• Crypto/Hash/Whirlpool.hs +70/−49
• Crypto/MAC/HMAC.hs +7/−7
• README.md +1/−0
• Tests.hs +0/−181
• Tests/KAT.hs +199/−0
• cbits/sha3.c +150/−0
• cbits/sha3.h +45/−0
• cryptohash.cabal +20/−46

@@ -1,44 +0,0 @@-import Criterion.Main-import qualified Data.ByteString as B-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.SHA512t as SHA512t-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--allHashs =-	[ ("MD2",MD2.hash)-	, ("MD4",MD4.hash)-	, ("MD5",MD5.hash)-	, ("SHA1",SHA1.hash)-	, ("SHA224",SHA224.hash)-	, ("SHA256",SHA256.hash)-	, ("SHA384",SHA384.hash)-	, ("SHA512",SHA512.hash)-	, ("SHA512t-512",(SHA512t.hash 512))-	, ("RIPEMD160",RIPEMD160.hash)-	, ("Tiger",Tiger.hash)-	, ("Skein256-256",Skein256.hash 256)-	, ("Skein512-512",Skein512.hash 512)-    , ("Whirlpool",Whirlpool.hash)-	]--benchHash :: Int -> (B.ByteString -> B.ByteString) -> Pure-benchHash sz f = whnf f (B.replicate sz 0)--withHashes f = map f allHashs--main = defaultMain-	[ bgroup "hash-256b" (withHashes (\(name, f) -> bench name $ benchHash 256 f))-	, bgroup "hash-4Kb" (withHashes (\(name, f) -> bench name $ benchHash 4096 f))-	, bgroup "hash-1Mb" (withHashes (\(name, f) -> bench name $ benchHash (1*1024*1024) f))-	]

@@ -0,0 +1,64 @@+{-# LANGUAGE BangPatterns #-}+import Criterion.Main+import qualified Data.ByteString as B+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.SHA512t as SHA512t+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++hashmany (i,u,f) = f . foldl u i++allHashs =+    [ ("MD2",MD2.hash, hashmany (MD2.init,MD2.update,MD2.finalize))+    , ("MD4",MD4.hash, hashmany (MD4.init,MD4.update,MD4.finalize))+    , ("MD5",MD5.hash, hashmany (MD5.init,MD5.update,MD5.finalize))+    , ("SHA1",SHA1.hash, hashmany (SHA1.init,SHA1.update,SHA1.finalize))+    , ("SHA2-224",SHA224.hash, hashmany (SHA224.init,SHA224.update,SHA224.finalize))+    , ("SHA2-256",SHA256.hash, hashmany (SHA256.init,SHA256.update,SHA256.finalize))+    , ("SHA2-384",SHA384.hash, hashmany (SHA384.init,SHA384.update,SHA384.finalize))+    , ("SHA2-512",SHA512.hash, hashmany (SHA512.init,SHA512.update,SHA512.finalize))+    , ("SHA2-512t-512",SHA512t.hash 512, hashmany (SHA512t.init 512,SHA512t.update,SHA512t.finalize))+    , ("SHA3-224",SHA3.hash 224, hashmany (SHA3.init 224,SHA3.update,SHA3.finalize))+    , ("SHA3-256",SHA3.hash 256, hashmany (SHA3.init 256,SHA3.update,SHA3.finalize))+    , ("SHA3-384",SHA3.hash 384, hashmany (SHA3.init 384,SHA3.update,SHA3.finalize))+    , ("SHA3-512",SHA3.hash 512, hashmany (SHA3.init 512,SHA3.update,SHA3.finalize))+    , ("RIPEMD160",RIPEMD160.hash, hashmany (RIPEMD160.init,RIPEMD160.update,RIPEMD160.finalize))+    , ("Tiger",Tiger.hash, hashmany (Tiger.init,Tiger.update,Tiger.finalize))+    , ("Skein256-256",Skein256.hash 256, hashmany (Skein256.init 256,Skein256.update,Skein256.finalize))+    , ("Skein512-512",Skein512.hash 512, hashmany (Skein512.init 512,Skein512.update,Skein512.finalize))+    , ("Whirlpool",Whirlpool.hash, hashmany (Whirlpool.init,Whirlpool.update,Whirlpool.finalize))+    ]++benchHash :: a -> (a -> B.ByteString) -> Pure+benchHash bs f = whnf f bs++withHashesFilter out f = map f $ filter (\(n,_,_) -> not (n `elem` out)) allHashs+withHashes f = map f allHashs++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+        [ bgroup "hash-32b" (withHashes (\(name, f,_) -> bench name $ benchHash bs32 f))+        , bgroup "hash-256b" (withHashes (\(name, f,_) -> bench name $ benchHash bs256 f))+        , bgroup "hash-4Kb" (withHashes (\(name, f,_) -> bench name $ benchHash bs4096 f))+        , bgroup "hash-1Mb" (withHashesFilter ["MD2"] (\(name, f,_) -> bench name $ benchHash bs1M f))+        , bgroup "iuf-64x256" (withHashes (\(name, _,f) -> bench name $ benchHash lbs64x256 f))+        , bgroup "iuf-64x4096" (withHashes (\(name, _,f) -> bench name $ benchHash lbs64x4096 f))+        ]

@@ -10,30 +10,28 @@ -- A module containing MD2 bindings -- module Crypto.Hash.MD2-	( Ctx(..)-	, MD2+    ( Ctx(..)+    , MD2 -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx MD2 where-	outputLength    = Tagged (16 * 8)-	blockLength     = Tagged (16 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (16 * 8)+    blockLength     = Tagged (16 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize MD2 where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data MD2 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 16++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 96 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "md2.h md2_init"-	c_md2_init :: Ptr Ctx -> IO ()+    c_md2_init :: Ptr Ctx -> IO ()  foreign import ccall "md2.h md2_update"-	c_md2_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_md2_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "md2.h md2_finalize"-	c_md2_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_md2_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_md2_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_md2_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_md2_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_md2_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_md2_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_md2_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_md2_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_md2_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_md2_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,30 +10,28 @@ -- A module containing MD4 bindings -- module Crypto.Hash.MD4-	( Ctx(..)-	, MD4+    ( Ctx(..)+    , MD4 -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx MD4 where-	outputLength    = Tagged (16 * 8)-	blockLength     = Tagged (64 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (16 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize MD4 where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data MD4 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 16++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 96 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "md4.h md4_init"-	c_md4_init :: Ptr Ctx -> IO ()+    c_md4_init :: Ptr Ctx -> IO ()  foreign import ccall "md4.h md4_update"-	c_md4_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_md4_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "md4.h md4_finalize"-	c_md4_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_md4_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_md4_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_md4_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_md4_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_md4_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_md4_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_md4_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_md4_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_md4_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_md4_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,30 +10,28 @@ -- A module containing MD5 bindings -- module Crypto.Hash.MD5-	( Ctx(..)-	, MD5+    ( Ctx(..)+    , MD5 -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx MD5 where-	outputLength    = Tagged (16 * 8)-	blockLength     = Tagged (64 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (16 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize MD5 where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data MD5 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 16++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 96 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "md5.h md5_init"-	c_md5_init :: Ptr Ctx -> IO ()+    c_md5_init :: Ptr Ctx -> IO ()  foreign import ccall "md5.h md5_update"-	c_md5_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_md5_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "md5.h md5_finalize"-	c_md5_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_md5_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_md5_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_md5_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_md5_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_md5_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_md5_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_md5_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_md5_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_md5_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_md5_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,30 +10,28 @@ -- A module containing RIPEMD160 bindings -- module Crypto.Hash.RIPEMD160-	( Ctx(..)-	, RIPEMD160+    ( Ctx(..)+    , RIPEMD160 -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx RIPEMD160 where-	outputLength    = Tagged (20 * 8)-	blockLength     = Tagged (64 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (20 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize RIPEMD160 where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data RIPEMD160 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 20++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 128 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(16-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "ripemd.h ripemd160_init"-	c_ripemd160_init :: Ptr Ctx -> IO ()+    c_ripemd160_init :: Ptr Ctx -> IO ()  foreign import ccall "ripemd.h ripemd160_update"-	c_ripemd160_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_ripemd160_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "ripemd.h ripemd160_finalize"-	c_ripemd160_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_ripemd160_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_ripemd160_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_ripemd160_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_ripemd160_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_ripemd160_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_ripemd160_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_ripemd160_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_ripemd160_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_ripemd160_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_ripemd160_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,30 +10,28 @@ -- A module containing SHA1 bindings -- module Crypto.Hash.SHA1-	( Ctx(..)-	, SHA1+    ( Ctx(..)+    , SHA1 -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx SHA1 where-	outputLength    = Tagged (20 * 8)-	blockLength     = Tagged (64 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (20 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize SHA1 where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data SHA1 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 20++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 96 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "sha1.h sha1_init"-	c_sha1_init :: Ptr Ctx -> IO ()+    c_sha1_init :: Ptr Ctx -> IO ()  foreign import ccall "sha1.h sha1_update"-	c_sha1_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_sha1_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "sha1.h sha1_finalize"-	c_sha1_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_sha1_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_sha1_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_sha1_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_sha1_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_sha1_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_sha1_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_sha1_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_sha1_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_sha1_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_sha1_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,30 +10,28 @@ -- A module containing SHA224 bindings -- module Crypto.Hash.SHA224-	( Ctx(..)-	, SHA224+    ( Ctx(..)+    , SHA224 -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx SHA224 where-	outputLength    = Tagged (28 * 8)-	blockLength     = Tagged (64 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (28 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize SHA224 where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data SHA224 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 28++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 192 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(24-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "sha256.h sha224_init"-	c_sha224_init :: Ptr Ctx -> IO ()+    c_sha224_init :: Ptr Ctx -> IO ()  foreign import ccall "sha256.h sha224_update"-	c_sha224_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_sha224_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "sha256.h sha224_finalize"-	c_sha224_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_sha224_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_sha224_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_sha224_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_sha224_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_sha224_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_sha224_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_sha224_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_sha224_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_sha224_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_sha224_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,30 +10,28 @@ -- A module containing SHA256 bindings -- module Crypto.Hash.SHA256-	( Ctx(..)-	, SHA256+    ( Ctx(..)+    , SHA256 -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx SHA256 where-	outputLength    = Tagged (32 * 8)-	blockLength     = Tagged (64 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (32 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize SHA256 where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data SHA256 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 32++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 192 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(24-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "sha256.h sha256_init"-	c_sha256_init :: Ptr Ctx -> IO ()+    c_sha256_init :: Ptr Ctx -> IO ()  foreign import ccall "sha256.h sha256_update"-	c_sha256_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_sha256_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "sha256.h sha256_finalize"-	c_sha256_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_sha256_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_sha256_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_sha256_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_sha256_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_sha256_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_sha256_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_sha256_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_sha256_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_sha256_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_sha256_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -0,0 +1,121 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Module      : Crypto.Hash.SHA3+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- A module containing SHA3 bindings+--+module Crypto.Hash.SHA3+    ( Ctx(..)++    -- * Incremental hashing Functions+    , init     -- :: Int -> Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString++    -- * Single Pass hashing+    , hash     -- :: Int -> ByteString -> ByteString+    , hashlazy -- :: Int -> ByteString -> ByteString+    ) where++import Prelude hiding (init)+import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Storable+import Foreign.Marshal.Alloc+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.Word++data Ctx = Ctx !ByteString++{-# INLINE sizeCtx #-}+sizeCtx :: Int+sizeCtx = 360++{- return the number of bytes of output for the digest -}+peekHashlen :: Ptr Ctx -> IO Int+peekHashlen ptr = peek iptr >>= \v -> return $! fromIntegral v+    where iptr :: Ptr Word32+          iptr = castPtr ptr++{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b++{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..44]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i++withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)++foreign import ccall unsafe "sha3.h sha3_init"+    c_sha3_init :: Ptr Ctx -> Word32 -> IO ()++foreign import ccall "sha3.h sha3_update"+    c_sha3_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()++foreign import ccall unsafe "sha3.h sha3_finalize"+    c_sha3_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()++updateInternalIO :: Ptr Ctx -> ByteString -> IO ()+updateInternalIO ptr d =+    unsafeUseAsCStringLen d (\(cs, len) -> c_sha3_update ptr (castPtr cs) (fromIntegral len))++finalizeInternalIO :: Ptr Ctx -> IO ByteString+finalizeInternalIO ptr =+    peekHashlen ptr >>= \digestSize -> create digestSize (c_sha3_finalize ptr)++{-# NOINLINE init #-}+-- | init a context+init :: Int -> Ctx+init hashlen = inlinePerformIO $ withCtxNew (\ctx -> c_sha3_init ctx (fromIntegral hashlen))++{-# NOINLINE update #-}+-- | update a context with a bytestring+update :: Ctx -> ByteString -> Ctx+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d++{-# NOINLINE finalize #-}+-- | finalize the context into a digest bytestring+finalize :: Ctx -> ByteString+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO++{-# NOINLINE hash #-}+-- | hash a strict bytestring into a digest bytestring+hash :: Int -> ByteString -> ByteString+hash hashlen d = inlinePerformIO $ 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+    c_sha3_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,30 +10,28 @@ -- A module containing SHA384 bindings -- module Crypto.Hash.SHA384-	( Ctx(..)-	, SHA384+    ( Ctx(..)+    , SHA384 -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx SHA384 where-	outputLength    = Tagged (48 * 8)-	blockLength     = Tagged (128 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (48 * 8)+    blockLength     = Tagged (128 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize SHA384 where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data SHA384 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 48++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 256 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(32-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "sha512.h sha384_init"-	c_sha384_init :: Ptr Ctx -> IO ()+    c_sha384_init :: Ptr Ctx -> IO ()  foreign import ccall "sha512.h sha384_update"-	c_sha384_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_sha384_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "sha512.h sha384_finalize"-	c_sha384_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_sha384_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_sha384_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_sha384_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_sha384_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_sha384_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_sha384_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_sha384_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_sha384_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_sha384_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_sha384_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,31 +10,30 @@ -- A module containing SHA512 bindings -- module Crypto.Hash.SHA512-	( Ctx(..)-	, SHA512+    ( Ctx(..)+    , SHA512 -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, init_t   -- :: Int -> Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , init_t   -- :: Int -> Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init) import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -47,87 +46,110 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx SHA512 where-	outputLength    = Tagged (64 * 8)-	blockLength     = Tagged (128 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (64 * 8)+    blockLength     = Tagged (128 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize SHA512 where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data SHA512 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 64++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 256 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(32-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "sha512.h sha512_init"-	c_sha512_init :: Ptr Ctx -> IO ()+    c_sha512_init :: Ptr Ctx -> IO ()  foreign import ccall unsafe "sha512.h sha512_init_t"-	c_sha512_init_t :: Ptr Ctx -> Int -> IO ()+    c_sha512_init_t :: Ptr Ctx -> Int -> IO ()  foreign import ccall "sha512.h sha512_update"-	c_sha512_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_sha512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "sha512.h sha512_finalize"-	c_sha512_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_sha512_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_sha512_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_sha512_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_sha512_init ptr >> peek ptr)+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 $ allocInternal $ \ptr -> do (c_sha512_init_t ptr t >> peek ptr)+init_t t = unsafePerformIO $ withCtxNew $ \ptr -> c_sha512_init_t ptr t  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = unsafePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = unsafePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_sha512_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = unsafePerformIO $ 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 $ allocInternal $ \ptr -> do-	c_sha512_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = unsafePerformIO $ withCtxNewThrow $ \ptr -> do+    c_sha512_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,18 +10,18 @@ -- A module containing SHA512/t -- module Crypto.Hash.SHA512t-	( Ctx(..)-	--, SHA512t+    ( Ctx(..)+    --, SHA512t -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init) import Data.List (foldl')

@@ -10,31 +10,29 @@ -- A module containing Skein256 bindings -- module Crypto.Hash.Skein256-	( Ctx(..)-	, Skein256+    ( Ctx(..)+    , Skein256 -	-- * Incremental hashing Functions-	, init     -- :: Int -> Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Int -> Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: Int -> ByteString -> ByteString-	, hashlazy -- :: Int -> ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: Int -> ByteString -> ByteString+    , hashlazy -- :: Int -> ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.C.Types import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, inlinePerformIO, toForeignPtr) import Data.Word import Data.Bits @@ -48,85 +46,103 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx Skein256 where-	outputLength    = Tagged (32 * 8)-	blockLength     = Tagged (32 * 8)-	initialCtx      = init (32 * 8)-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (32 * 8)+    blockLength     = Tagged (32 * 8)+    initialCtx      = init (32 * 8)+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize Skein256 where-	get            = liftM Digest (getByteString 32)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString 32)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data Skein256 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show)  sizeCtx :: Int-sizeCtx = 100+sizeCtx = 88 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+peekHashlen :: Ptr Ctx -> IO Int+peekHashlen ptr = do+    let iptr = castPtr ptr :: Ptr CUInt+    a <- peek iptr+    return ((fromIntegral a + 7) `shiftR` 3) -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -poke_hashlen :: Ptr Ctx -> IO Int-poke_hashlen ptr = do-	let iptr = castPtr ptr :: Ptr CUInt-	a <- peek iptr-	return $ fromIntegral a+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "skein256.h skein256_init"-	c_skein256_init :: Ptr Ctx -> CUInt -> IO ()+    c_skein256_init :: Ptr Ctx -> Word32 -> IO ()  foreign import ccall "skein256.h skein256_update"-	c_skein256_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_skein256_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "skein256.h skein256_finalize"-	c_skein256_finalize :: Ptr Ctx -> CString -> IO ()+    c_skein256_finalize :: Ptr Ctx -> Ptr Word8 -> IO () -allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca -allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)- updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_skein256_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_skein256_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr = do-	digestSize <- fmap (\x -> (x + 7) `shiftR` 3) $ poke_hashlen ptr-	allocaBytes digestSize (\cs -> c_skein256_finalize ptr cs >> B.packCStringLen (cs, digestSize))+finalizeInternalIO ptr =+    peekHashlen ptr >>= \digestSize -> create digestSize (c_skein256_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Int -> Ctx-init hashlen = unsafePerformIO $ allocInternal $ \ptr -> do (c_skein256_init ptr (fromIntegral hashlen) >> peek ptr)+init hashlen = inlinePerformIO $ withCtxNew $ \ptr -> c_skein256_init ptr (fromIntegral hashlen)  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: Int -> ByteString -> ByteString-hash hashlen d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_skein256_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash hashlen d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_skein256_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy hashlen l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_skein256_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,31 +10,29 @@ -- A module containing Skein512 bindings -- module Crypto.Hash.Skein512-	( Ctx(..)-	, Skein512+    ( Ctx(..)+    , Skein512 -	-- * Incremental hashing Functions-	, init     -- :: Int -> Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Int -> Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: Int -> ByteString -> ByteString-	, hashlazy -- :: Int -> ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: Int -> ByteString -> ByteString+    , hashlazy -- :: Int -> ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.C.Types import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, inlinePerformIO, toForeignPtr) import Data.Word import Data.Bits @@ -48,85 +46,103 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx Skein512 where-	outputLength    = Tagged (64 * 8)-	blockLength     = Tagged (64 * 8)-	initialCtx      = init (64 * 8)-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (64 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init (64 * 8)+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize Skein512 where-	get            = liftM Digest (getByteString 64)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString 64)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data Skein512 = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show)  sizeCtx :: Int-sizeCtx = 160+sizeCtx = 152 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+peekHashlen :: Ptr Ctx -> IO Int+peekHashlen ptr = do+    let iptr = castPtr ptr :: Ptr CUInt+    a <- peek iptr+    return ((fromIntegral a + 7) `shiftR` 3) -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -poke_hashlen :: Ptr Ctx -> IO Int-poke_hashlen ptr = do-	let iptr = castPtr ptr :: Ptr CUInt-	a <- peek iptr-	return $ fromIntegral a+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(20-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "skein512.h skein512_init"-	c_skein512_init :: Ptr Ctx -> CUInt -> IO ()+    c_skein512_init :: Ptr Ctx -> Word32 -> IO ()  foreign import ccall "skein512.h skein512_update"-	c_skein512_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_skein512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "skein512.h skein512_finalize"-	c_skein512_finalize :: Ptr Ctx -> CString -> IO ()+    c_skein512_finalize :: Ptr Ctx -> Ptr Word8 -> IO () -allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca -allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)- updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_skein512_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_skein512_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr = do-	digestSize <- fmap (\x -> (x + 7) `shiftR` 3) $ poke_hashlen ptr-	allocaBytes digestSize (\cs -> c_skein512_finalize ptr cs >> B.packCStringLen (cs, digestSize))+finalizeInternalIO ptr =+    peekHashlen ptr >>= \digestSize -> create digestSize (c_skein512_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Int -> Ctx-init hashlen = unsafePerformIO $ allocInternal $ \ptr -> do (c_skein512_init ptr (fromIntegral hashlen) >> peek ptr)+init hashlen = inlinePerformIO $ withCtxNew $ \ptr -> c_skein512_init ptr (fromIntegral hashlen)  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: Int -> ByteString -> ByteString-hash hashlen d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_skein512_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash hashlen d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_skein512_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy hashlen l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_skein512_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,30 +10,28 @@ -- A module containing Tiger bindings -- module Crypto.Hash.Tiger-	( Ctx(..)-	, Tiger+    ( Ctx(..)+    , Tiger -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx Tiger where-	outputLength    = Tagged (24 * 8)-	blockLength     = Tagged (64 * 8)-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (24 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize Tiger where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data Tiger = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int++{-# INLINE digestSize #-}+digestSize :: Int digestSize = 24++{-# INLINE sizeCtx #-}+sizeCtx :: Int sizeCtx = 96 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i +withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "tiger.h tiger_init"-	c_tiger_init :: Ptr Ctx -> IO ()+    c_tiger_init :: Ptr Ctx -> IO ()  foreign import ccall "tiger.h tiger_update"-	c_tiger_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_tiger_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "tiger.h tiger_finalize"-	c_tiger_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_tiger_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_tiger_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_tiger_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_tiger_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_tiger_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_tiger_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_tiger_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_tiger_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_tiger_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_tiger_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -10,30 +10,28 @@ -- A module containing Whirlpool bindings -- module Crypto.Hash.Whirlpool-	( Ctx(..)-	, Whirlpool+    ( Ctx(..)+    , Whirlpool -	-- * Incremental hashing Functions-	, init     -- :: Ctx-	, update   -- :: Ctx -> ByteString -> Ctx-	, finalize -- :: Ctx -> ByteString+    -- * Incremental hashing Functions+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , finalize -- :: Ctx -> ByteString -	-- * Single Pass hashing-	, hash     -- :: ByteString -> ByteString-	, hashlazy -- :: ByteString -> ByteString-	) where+    -- * Single Pass hashing+    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where  import Prelude hiding (init)-import System.IO.Unsafe (unsafePerformIO)-import Foreign.C.String import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable import Foreign.Marshal.Alloc-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString (ByteString)-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, memcpy)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO) import Data.Word  #ifdef HAVE_CRYPTOAPI@@ -46,79 +44,102 @@ import qualified Crypto.Classes as C (Hash(..))  instance C.Hash Ctx Whirlpool where-	outputLength    = Tagged 512-	blockLength     = Tagged 512-	initialCtx      = init-	updateCtx       = update-	finalize ctx bs = Digest . finalize $ update ctx bs+    outputLength    = Tagged (64 * 8)+    blockLength     = Tagged (64 * 8)+    initialCtx      = init+    updateCtx       = update+    finalize ctx bs = Digest . finalize $ update ctx bs  instance Serialize Whirlpool where-	get            = liftM Digest (getByteString digestSize)-	put (Digest d) = putByteString d+    get            = liftM Digest (getByteString digestSize)+    put (Digest d) = putByteString d  #endif  data Ctx = Ctx !ByteString data Whirlpool = Digest !ByteString-	deriving (Eq,Ord,Show)+    deriving (Eq,Ord,Show) -digestSize, sizeCtx :: Int-digestSize = 512 `div` 8-sizeCtx = 32 + 64 + 4 + 4 + 64 -instance Storable Ctx where-	sizeOf _    = sizeCtx-	alignment _ = 16-	poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))+{-# INLINE digestSize #-}+digestSize :: Int+digestSize = 64 -	peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx+{-# INLINE sizeCtx #-}+sizeCtx :: Int+sizeCtx = 168 +{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b++{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(21-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i++withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (castPtr dstPtr) (castPtr srcPtr)+                          f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)+ foreign import ccall unsafe "whirlpool.h whirlpool_init"-	c_whirlpool_init :: Ptr Ctx -> IO ()+    c_whirlpool_init :: Ptr Ctx -> IO ()  foreign import ccall "whirlpool.h whirlpool_update"-	c_whirlpool_update :: Ptr Ctx -> CString -> Word32 -> IO ()+    c_whirlpool_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()  foreign import ccall unsafe "whirlpool.h whirlpool_finalize"-	c_whirlpool_finalize :: Ptr Ctx -> CString -> IO ()--allocInternal :: (Ptr Ctx -> IO a) -> IO a-allocInternal = alloca--allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)+    c_whirlpool_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()  updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =-	unsafeUseAsCStringLen d (\(cs, len) -> c_whirlpool_update ptr cs (fromIntegral len))+    unsafeUseAsCStringLen d (\(cs, len) -> c_whirlpool_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr =-	allocaBytes digestSize (\cs -> c_whirlpool_finalize ptr cs >> B.packCStringLen (cs, digestSize))+    create digestSize (c_whirlpool_finalize ptr)  {-# NOINLINE init #-} -- | init a context init :: Ctx-init = unsafePerformIO $ allocInternal $ \ptr -> do (c_whirlpool_init ptr >> peek ptr)+init = inlinePerformIO $ withCtxNew $ c_whirlpool_init  {-# NOINLINE update #-} -- | update a context with a bytestring update :: Ctx -> ByteString -> Ctx-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d  {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> ByteString-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring hash :: ByteString -> ByteString-hash d = unsafePerformIO $ allocInternal $ \ptr -> do-	c_whirlpool_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = inlinePerformIO $ 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 = unsafePerformIO $ allocInternal $ \ptr -> do-	c_whirlpool_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do+    c_whirlpool_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

@@ -9,8 +9,8 @@ -- http://en.wikipedia.org/wiki/HMAC -- module Crypto.MAC.HMAC-	( hmac-	) where+    ( hmac+    ) where  import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -19,9 +19,9 @@ -- | compute a MAC using the supplied hashing function hmac :: (ByteString -> ByteString) -> Int -> ByteString -> ByteString -> ByteString hmac f blockSize secret msg = f $ B.append opad (f $ B.append ipad msg) where-	opad = B.map (xor 0x5c) k'-	ipad = B.map (xor 0x36) k'+    opad = B.map (xor 0x5c) k'+    ipad = B.map (xor 0x36) k' -	k' = B.append kt pad-	kt = if B.length secret > fromIntegral blockSize then f secret else secret-	pad = B.replicate (fromIntegral blockSize - B.length kt) 0+    k' = B.append kt pad+    kt = if B.length secret > fromIntegral blockSize then f secret else secret+    pad = B.replicate (fromIntegral blockSize - B.length kt) 0

@@ -15,6 +15,7 @@ * RIPEMD160 * SHA1 * SHA-2 family: 224, 256, 384, 512 and the newer 512t+* SHA-3 (aka Keccak) * Skein: 256, 512 * Tiger * Whirlpool

@@ -1,181 +0,0 @@-import Test.HUnit-import Data.Char-import Data.Bits-import Data.Word-import qualified Data.ByteString as B-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.SHA512t as SHA512t-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--v0 = ""-v1 = "The quick brown fox jumps over the lazy dog"-v2 = "The quick brown fox jumps over the lazy cog"-vectors = [ v0, v1, v2 ]--data HashFct = HashFct-	{ fctHash   :: (B.ByteString -> B.ByteString)-	, fctInc    :: ([B.ByteString] -> B.ByteString) }--hashinc i u f = f . foldl u i--md2Hash    = HashFct { fctHash = MD2.hash, fctInc = hashinc MD2.init MD2.update MD2.finalize }-md4Hash    = HashFct { fctHash = MD4.hash, fctInc = hashinc MD4.init MD4.update MD4.finalize }-md5Hash    = HashFct { fctHash = MD5.hash, fctInc = hashinc MD5.init MD5.update MD5.finalize }--sha1Hash   = HashFct { fctHash = SHA1.hash, fctInc = hashinc SHA1.init SHA1.update SHA1.finalize }--sha224Hash = HashFct { fctHash = SHA224.hash, fctInc = hashinc SHA224.init SHA224.update SHA224.finalize }-sha256Hash = HashFct { fctHash = SHA256.hash, fctInc = hashinc SHA256.init SHA256.update SHA256.finalize }--sha384Hash = HashFct { fctHash = SHA384.hash, fctInc = hashinc SHA384.init SHA384.update SHA384.finalize }-sha512Hash = HashFct { fctHash = SHA512.hash, fctInc = hashinc SHA512.init SHA512.update SHA512.finalize }-sha512_224Hash = HashFct { fctHash = SHA512t.hash 224, fctInc = hashinc (SHA512t.init 224) SHA512t.update SHA512t.finalize }-sha512_256Hash = HashFct { fctHash = SHA512t.hash 256, fctInc = hashinc (SHA512t.init 256) SHA512t.update SHA512t.finalize }--ripemd160Hash = HashFct { fctHash = RIPEMD160.hash, fctInc = hashinc RIPEMD160.init RIPEMD160.update RIPEMD160.finalize }-tigerHash = HashFct { fctHash = Tiger.hash, fctInc = hashinc Tiger.init Tiger.update Tiger.finalize }--skein256Hash x = HashFct { fctHash = Skein256.hash x, fctInc = hashinc (Skein256.init x) Skein256.update Skein256.finalize }-skein512Hash x = HashFct { fctHash = Skein512.hash x, fctInc = hashinc (Skein512.init x) Skein512.update Skein512.finalize }--whirlpoolHash = HashFct { fctHash = Whirlpool.hash, fctInc = hashinc Whirlpool.init Whirlpool.update Whirlpool.finalize }--results :: [ (String, HashFct, [String]) ]-results = [-	("MD2", md2Hash, [-		"8350e5a3e24c153df2275c9f80692773",-		"03d85a0d629d2c442e987525319fc471",-		"6b890c9292668cdbbfda00a4ebf31f05" ]),-	("MD4", md4Hash, [-		"31d6cfe0d16ae931b73c59d7e0c089c0",-		"1bee69a46ba811185c194762abaeae90",-		"b86e130ce7028da59e672d56ad0113df" ]),-	("MD5", md5Hash, [-		"d41d8cd98f00b204e9800998ecf8427e",-		"9e107d9d372bb6826bd81d3542a419d6",-		"1055d3e698d289f2af8663725127bd4b" ]),-	("SHA1", sha1Hash, [-		"da39a3ee5e6b4b0d3255bfef95601890afd80709",-		"2fd4e1c67a2d28fced849ee1bb76e7391b93eb12",-		"de9f2c7fd25e1b3afad3e85a0bd17d9b100db4b3" ]),-	("SHA224", sha224Hash, [-		"d14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f",-		"730e109bd7a8a32b1cb9d9a09aa2325d2430587ddbc0c38bad911525",-		"fee755f44a55f20fb3362cdc3c493615b3cb574ed95ce610ee5b1e9b" ]),-	("SHA256", sha256Hash, [-		"e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855",-		"d7a8fbb307d7809469ca9abcb0082e4f8d5651e46d3cdb762d02d0bf37c9e592",-		"e4c4d8f3bf76b692de791a173e05321150f7a345b46484fe427f6acc7ecc81be" ]),-	("SHA384", sha384Hash, [-		"38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b",-		"ca737f1014a48f4c0b6dd43cb177b0afd9e5169367544c494011e3317dbf9a509cb1e5dc1e85a941bbee3d7f2afbc9b1",-		"098cea620b0978caa5f0befba6ddcf22764bea977e1c70b3483edfdf1de25f4b40d6cea3cadf00f809d422feb1f0161b" ]),-	("SHA512", sha512Hash, [-		"cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e",-		"07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6",-		"3eeee1d0e11733ef152a6c29503b3ae20c4f1f3cda4cb26f1bc1a41f91c7fe4ab3bd86494049e201c4bd5155f31ecb7a3c8606843c4cc8dfcab7da11c8ae5045" ]),--	("SHA512/224", sha512_224Hash, [-		"6ed0dd02806fa89e25de060c19d3ac86cabb87d6a0ddd05c333b84f4",-		"944cd2847fb54558d4775db0485a50003111c8e5daa63fe722c6aa37",-		"2b9d6565a7e40f780ba8ab7c8dcf41e3ed3b77997f4c55aa987eede5" ]),-	("SHA512/256", sha512_256Hash, [-		"c672b8d1ef56ed28ab87c3622c5114069bdd3ad7b8f9737498d0c01ecef0967a",-		"dd9d67b371519c339ed8dbd25af90e976a1eeefd4ad3d889005e532fc5bef04d",-		"cc8d255a7f2f38fd50388fd1f65ea7910835c5c1e73da46fba01ea50d5dd76fb" ]),-	("RIPEMD160", ripemd160Hash, [-		"9c1185a5c5e9fc54612808977ee8f548b2258d31",-		"37f332f68db77bd9d7edd4969571ad671cf9dd3b",-		"132072df690933835eb8b6ad0b77e7b6f14acad7" ]),-	("Tiger", tigerHash, [-		"3293ac630c13f0245f92bbb1766e16167a4e58492dde73f3",-		"6d12a41e72e644f017b6f0e2f7b44c6285f06dd5d2c5b075",-		"a8f04b0f7201a0d728101c9d26525b31764a3493fcd8458f" ])-	, ("Skein256-160", skein256Hash 160, [-		"ff800bed6d2044ee9d604a674e3fda50d9b24a72",-		"3265703c166aa3e0d7da070b9cf1b1a5953f0a77",-		"17b29aa1424b3ec022505bd215ff73fd2e6d1e5a" ])-	, ("Skein256-256", skein256Hash 256, [-		"c8877087da56e072870daa843f176e9453115929094c3a40c463a196c29bf7ba",-		"c0fbd7d779b20f0a4614a66697f9e41859eaf382f14bf857e8cdb210adb9b3fe",-		"fb2f2f2deed0e1dd7ee2b91cee34e2d1c22072e1f5eaee288c35a0723eb653cd" ])-	, ("Skein512-160", skein512Hash 160, [-		"49daf1ccebb3544bc93cb5019ba91b0eea8876ee",-		"826325ee55a6dd18c3b2dbbc9c10420f5475975e",-		"7544ec7a35712ec953f02b0d0c86641cae4eb6e5" ])-	, ("Skein512-384", skein512Hash 384, [-		"dd5aaf4589dc227bd1eb7bc68771f5baeaa3586ef6c7680167a023ec8ce26980f06c4082c488b4ac9ef313f8cbe70808",-		"f814c107f3465e7c54048a5503547deddc377264f05c706b0d19db4847b354855ee52ab6a785c238c9e710d848542041",-		"e06520eeadc1d0a44fee1d2492547499c1e58526387c8b9c53905e5edb79f9840575cbf844e21b1ad1ea126dd8a8ca6f" ])-	, ("Skein512-512", skein512Hash 512, [-		"bc5b4c50925519c290cc634277ae3d6257212395cba733bbad37a4af0fa06af41fca7903d06564fea7a2d3730dbdb80c1f85562dfcc070334ea4d1d9e72cba7a",-		"94c2ae036dba8783d0b3f7d6cc111ff810702f5c77707999be7e1c9486ff238a7044de734293147359b4ac7e1d09cd247c351d69826b78dcddd951f0ef912713",-		"7f81113575e4b4d3441940e87aca331e6d63d103fe5107f29cd877af0d0f5e0ea34164258c60da5190189d0872e63a96596d2ef25e709099842da71d64111e0f" ])-	, ("Skein512-896", skein512Hash 896, [-		"b95175236c83a459ce7ec6c12b761a838b22d750e765b3fdaa892201b2aa714bc3d1d887dd64028bbf177c1dd11baa09c6c4ddb598fd07d6a8c131a09fc5b958e2999a8006754b25abe3bf8492b7eabec70e52e04e5ac867df2393c573f16eee3244554f1d2b724f2c0437c62007f770",-		"3265708553e7d146e5c7bcbc97b3e9e9f5b53a5e4af53612bdd6454da4fa7b13d413184fe34ed57b6574be10e389d0ec4b1d2b1dd2c80e0257d5a76b2cd86a19a27b1bcb3cc24d911b5dc5ee74d19ad558fd85b5f024e99f56d1d3199f1f9f88ed85fab9f945f11cf9fc00e94e3ca4c7",-		"3d23d3db9be719bbd2119f8402a28f38d8225faa79d5b68b80738c64a82004aafc7a840cd6dd9bced6644fa894a3d8d7d2ee89525fd1956a2db052c4c2f8d2111c91ef46b0997540d42bcf384826af1a5ef6510077f52d0574cf2b46f1b6a5dad07ed40f3d21a13ca2d079fa602ff02d" ])-    , ("Whirlpool", whirlpoolHash, [-        "19fa61d75522a4669b44e39c1d2e1726c530232130d407f89afee0964997f7a73e83be698b288febcf88e3e03c4f0757ea8964e59b63d93708b138cc42a66eb3",-        "b97de512e91e3828b40d2b0fdce9ceb3c4a71f9bea8d88e75c4fa854df36725fd2b52eb6544edcacd6f8beddfea403cb55ae31f03ad62a5ef54e42ee82c3fb35",-        "dce81fc695cfea3d7e1446509238daf89f24cc61896f2d265927daa70f2108f8902f0dfd68be085d5abb9fcd2e482c1dc24f2fabf81f40b73495cad44d7360d3"])-	]--hexalise s =-        concatMap (\c -> [ hex $ c `div` 16, hex $ c `mod` 16 ]) s-        where hex i-                | i >= 0 && i <= 9   = fromIntegral (ord '0') + i-                | i >= 10 && i <= 15 = fromIntegral (ord 'a') + i - 10-                | otherwise          = 0--hexaliseB :: B.ByteString -> B.ByteString-hexaliseB = B.pack . hexalise . B.unpack--splitB l b =-	if B.length b > l-		then-			let (b1, b2) = B.splitAt l b in-			b1 : splitB l b2-		else	-			[ b ]--showHash :: B.ByteString -> String-showHash = map (toEnum.fromEnum) . hexalise . B.unpack--runhash hash v = showHash $ (fctHash hash) $ v-runhashinc hash v = showHash $ (fctInc hash) $ v--makeTestAlg (name, hash, results) = concatMap maketest $ zip3 [0..] vectors results-	where-		testname i = name ++ " " ++ show i-		runtest v = runhash hash $ B.pack $ map (toEnum.fromEnum) v--		runtestinc i v = runhashinc hash $ splitB i $ B.pack $ map (toEnum.fromEnum) v--		maketest (i, v, r) =-			[ testname i ~: testname i ~: r ~=? (runtest v),-			  testname i ~: testname i ~: r ~=? (runtestinc 1 v),-			  testname i ~: testname i ~: r ~=? (runtestinc 2 v),-			  testname i ~: testname i ~: r ~=? (runtestinc 3 v),-			  testname i ~: testname i ~: r ~=? (runtestinc 4 v),-			  testname i ~: testname i ~: r ~=? (runtestinc 5 v),-			  testname i ~: testname i ~: r ~=? (runtestinc 9 v),-			  testname i ~: testname i ~: r ~=? (runtestinc 16 v) ]--mapTests :: [Test]-mapTests = concatMap makeTestAlg results--tests = TestList mapTests--main = runTestTT tests

@@ -0,0 +1,199 @@+import Test.HUnit+import Data.Char+import Data.Bits+import Data.Word+import qualified Data.ByteString as B+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.SHA512t as SHA512t+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++v0 = ""+v1 = "The quick brown fox jumps over the lazy dog"+v2 = "The quick brown fox jumps over the lazy cog"+vectors = [ v0, v1, v2 ]++data HashFct = HashFct+    { fctHash   :: (B.ByteString -> B.ByteString)+    , fctInc    :: ([B.ByteString] -> B.ByteString) }++hashinc i u f = f . foldl u i++md2Hash    = HashFct { fctHash = MD2.hash, fctInc = hashinc MD2.init MD2.update MD2.finalize }+md4Hash    = HashFct { fctHash = MD4.hash, fctInc = hashinc MD4.init MD4.update MD4.finalize }+md5Hash    = HashFct { fctHash = MD5.hash, fctInc = hashinc MD5.init MD5.update MD5.finalize }++sha1Hash   = HashFct { fctHash = SHA1.hash, fctInc = hashinc SHA1.init SHA1.update SHA1.finalize }++sha224Hash = HashFct { fctHash = SHA224.hash, fctInc = hashinc SHA224.init SHA224.update SHA224.finalize }+sha256Hash = HashFct { fctHash = SHA256.hash, fctInc = hashinc SHA256.init SHA256.update SHA256.finalize }++sha384Hash = HashFct { fctHash = SHA384.hash, fctInc = hashinc SHA384.init SHA384.update SHA384.finalize }+sha512Hash = HashFct { fctHash = SHA512.hash, fctInc = hashinc SHA512.init SHA512.update SHA512.finalize }+sha512_224Hash = HashFct { fctHash = SHA512t.hash 224, fctInc = hashinc (SHA512t.init 224) SHA512t.update SHA512t.finalize }+sha512_256Hash = HashFct { fctHash = SHA512t.hash 256, fctInc = hashinc (SHA512t.init 256) SHA512t.update SHA512t.finalize }++sha3Hash i = HashFct { fctHash = SHA3.hash i, fctInc = hashinc (SHA3.init i) SHA3.update SHA3.finalize }++ripemd160Hash = HashFct { fctHash = RIPEMD160.hash, fctInc = hashinc RIPEMD160.init RIPEMD160.update RIPEMD160.finalize }+tigerHash = HashFct { fctHash = Tiger.hash, fctInc = hashinc Tiger.init Tiger.update Tiger.finalize }++skein256Hash x = HashFct { fctHash = Skein256.hash x, fctInc = hashinc (Skein256.init x) Skein256.update Skein256.finalize }+skein512Hash x = HashFct { fctHash = Skein512.hash x, fctInc = hashinc (Skein512.init x) Skein512.update Skein512.finalize }++whirlpoolHash = HashFct { fctHash = Whirlpool.hash, fctInc = hashinc Whirlpool.init Whirlpool.update Whirlpool.finalize }++results :: [ (String, HashFct, [String]) ]+results = [+    ("MD2", md2Hash, [+        "8350e5a3e24c153df2275c9f80692773",+        "03d85a0d629d2c442e987525319fc471",+        "6b890c9292668cdbbfda00a4ebf31f05" ]),+    ("MD4", md4Hash, [+        "31d6cfe0d16ae931b73c59d7e0c089c0",+        "1bee69a46ba811185c194762abaeae90",+        "b86e130ce7028da59e672d56ad0113df" ]),+    ("MD5", md5Hash, [+        "d41d8cd98f00b204e9800998ecf8427e",+        "9e107d9d372bb6826bd81d3542a419d6",+        "1055d3e698d289f2af8663725127bd4b" ]),+    ("SHA1", sha1Hash, [+        "da39a3ee5e6b4b0d3255bfef95601890afd80709",+        "2fd4e1c67a2d28fced849ee1bb76e7391b93eb12",+        "de9f2c7fd25e1b3afad3e85a0bd17d9b100db4b3" ]),+    ("SHA224", sha224Hash, [+        "d14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f",+        "730e109bd7a8a32b1cb9d9a09aa2325d2430587ddbc0c38bad911525",+        "fee755f44a55f20fb3362cdc3c493615b3cb574ed95ce610ee5b1e9b" ]),+    ("SHA256", sha256Hash, [+        "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855",+        "d7a8fbb307d7809469ca9abcb0082e4f8d5651e46d3cdb762d02d0bf37c9e592",+        "e4c4d8f3bf76b692de791a173e05321150f7a345b46484fe427f6acc7ecc81be" ]),+    ("SHA384", sha384Hash, [+        "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b",+        "ca737f1014a48f4c0b6dd43cb177b0afd9e5169367544c494011e3317dbf9a509cb1e5dc1e85a941bbee3d7f2afbc9b1",+        "098cea620b0978caa5f0befba6ddcf22764bea977e1c70b3483edfdf1de25f4b40d6cea3cadf00f809d422feb1f0161b" ]),+    ("SHA512", sha512Hash, [+        "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e",+        "07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6",+        "3eeee1d0e11733ef152a6c29503b3ae20c4f1f3cda4cb26f1bc1a41f91c7fe4ab3bd86494049e201c4bd5155f31ecb7a3c8606843c4cc8dfcab7da11c8ae5045" ]),++    ("SHA512/224", sha512_224Hash, [+        "6ed0dd02806fa89e25de060c19d3ac86cabb87d6a0ddd05c333b84f4",+        "944cd2847fb54558d4775db0485a50003111c8e5daa63fe722c6aa37",+        "2b9d6565a7e40f780ba8ab7c8dcf41e3ed3b77997f4c55aa987eede5" ]),+    ("SHA512/256", sha512_256Hash, [+        "c672b8d1ef56ed28ab87c3622c5114069bdd3ad7b8f9737498d0c01ecef0967a",+        "dd9d67b371519c339ed8dbd25af90e976a1eeefd4ad3d889005e532fc5bef04d",+        "cc8d255a7f2f38fd50388fd1f65ea7910835c5c1e73da46fba01ea50d5dd76fb" ]),+    ("RIPEMD160", ripemd160Hash, [+        "9c1185a5c5e9fc54612808977ee8f548b2258d31",+        "37f332f68db77bd9d7edd4969571ad671cf9dd3b",+        "132072df690933835eb8b6ad0b77e7b6f14acad7" ]),+    ("Tiger", tigerHash, [+        "3293ac630c13f0245f92bbb1766e16167a4e58492dde73f3",+        "6d12a41e72e644f017b6f0e2f7b44c6285f06dd5d2c5b075",+        "a8f04b0f7201a0d728101c9d26525b31764a3493fcd8458f" ])+    , ("Skein256-160", skein256Hash 160, [+        "ff800bed6d2044ee9d604a674e3fda50d9b24a72",+        "3265703c166aa3e0d7da070b9cf1b1a5953f0a77",+        "17b29aa1424b3ec022505bd215ff73fd2e6d1e5a" ])+    , ("Skein256-256", skein256Hash 256, [+        "c8877087da56e072870daa843f176e9453115929094c3a40c463a196c29bf7ba",+        "c0fbd7d779b20f0a4614a66697f9e41859eaf382f14bf857e8cdb210adb9b3fe",+        "fb2f2f2deed0e1dd7ee2b91cee34e2d1c22072e1f5eaee288c35a0723eb653cd" ])+    , ("Skein512-160", skein512Hash 160, [+        "49daf1ccebb3544bc93cb5019ba91b0eea8876ee",+        "826325ee55a6dd18c3b2dbbc9c10420f5475975e",+        "7544ec7a35712ec953f02b0d0c86641cae4eb6e5" ])+    , ("Skein512-384", skein512Hash 384, [+        "dd5aaf4589dc227bd1eb7bc68771f5baeaa3586ef6c7680167a023ec8ce26980f06c4082c488b4ac9ef313f8cbe70808",+        "f814c107f3465e7c54048a5503547deddc377264f05c706b0d19db4847b354855ee52ab6a785c238c9e710d848542041",+        "e06520eeadc1d0a44fee1d2492547499c1e58526387c8b9c53905e5edb79f9840575cbf844e21b1ad1ea126dd8a8ca6f" ])+    , ("Skein512-512", skein512Hash 512, [+        "bc5b4c50925519c290cc634277ae3d6257212395cba733bbad37a4af0fa06af41fca7903d06564fea7a2d3730dbdb80c1f85562dfcc070334ea4d1d9e72cba7a",+        "94c2ae036dba8783d0b3f7d6cc111ff810702f5c77707999be7e1c9486ff238a7044de734293147359b4ac7e1d09cd247c351d69826b78dcddd951f0ef912713",+        "7f81113575e4b4d3441940e87aca331e6d63d103fe5107f29cd877af0d0f5e0ea34164258c60da5190189d0872e63a96596d2ef25e709099842da71d64111e0f" ])+    , ("Skein512-896", skein512Hash 896, [+        "b95175236c83a459ce7ec6c12b761a838b22d750e765b3fdaa892201b2aa714bc3d1d887dd64028bbf177c1dd11baa09c6c4ddb598fd07d6a8c131a09fc5b958e2999a8006754b25abe3bf8492b7eabec70e52e04e5ac867df2393c573f16eee3244554f1d2b724f2c0437c62007f770",+        "3265708553e7d146e5c7bcbc97b3e9e9f5b53a5e4af53612bdd6454da4fa7b13d413184fe34ed57b6574be10e389d0ec4b1d2b1dd2c80e0257d5a76b2cd86a19a27b1bcb3cc24d911b5dc5ee74d19ad558fd85b5f024e99f56d1d3199f1f9f88ed85fab9f945f11cf9fc00e94e3ca4c7",+        "3d23d3db9be719bbd2119f8402a28f38d8225faa79d5b68b80738c64a82004aafc7a840cd6dd9bced6644fa894a3d8d7d2ee89525fd1956a2db052c4c2f8d2111c91ef46b0997540d42bcf384826af1a5ef6510077f52d0574cf2b46f1b6a5dad07ed40f3d21a13ca2d079fa602ff02d" ])+    , ("Whirlpool", whirlpoolHash, [+        "19fa61d75522a4669b44e39c1d2e1726c530232130d407f89afee0964997f7a73e83be698b288febcf88e3e03c4f0757ea8964e59b63d93708b138cc42a66eb3",+        "b97de512e91e3828b40d2b0fdce9ceb3c4a71f9bea8d88e75c4fa854df36725fd2b52eb6544edcacd6f8beddfea403cb55ae31f03ad62a5ef54e42ee82c3fb35",+        "dce81fc695cfea3d7e1446509238daf89f24cc61896f2d265927daa70f2108f8902f0dfd68be085d5abb9fcd2e482c1dc24f2fabf81f40b73495cad44d7360d3"])+    , ("SHA3-224", sha3Hash 224, [+        "f71837502ba8e10837bdd8d365adb85591895602fc552b48b7390abd",+        "310aee6b30c47350576ac2873fa89fd190cdc488442f3ef654cf23fe",+        "0b27ff3b732133287f6831e2af47cf342b7ef1f3fcdee248811090cd" ])+    , ("SHA3-256", sha3Hash 256, [+        "c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470",+        "4d741b6f1eb29cb2a9b9911c82f56fa8d73b04959d3d9d222895df6c0b28aa15",+        "ed6c07f044d7573cc53bf1276f8cba3dac497919597a45b4599c8f73e22aa334" ])+    , ("SHA3-384", sha3Hash 384, [+        "2c23146a63a29acf99e73b88f8c24eaa7dc60aa771780ccc006afbfa8fe2479b2dd2b21362337441ac12b515911957ff",+        "283990fa9d5fb731d786c5bbee94ea4db4910f18c62c03d173fc0a5e494422e8a0b3da7574dae7fa0baf005e504063b3",+        "1cc515e1812491058d8b8b226fd85045e746b4937a58b0111b6b7a39dd431b6295bd6b6d05e01e225586b4dab3cbb87a" ])+    , ("SHA3-512", sha3Hash 512, [+        "0eab42de4c3ceb9235fc91acffe746b29c29a8c366b7c60e4e67c466f36a4304c00fa9caf9d87976ba469bcbe06713b435f091ef2769fb160cdab33d3670680e",+        "d135bb84d0439dbac432247ee573a23ea7d3c9deb2a968eb31d47c4fb45f1ef4422d6c531b5b9bd6f449ebcc449ea94d0a8f05f62130fda612da53c79659f609",+        "10f8caabb5b179861da5e447d34b84d604e3eb81830880e1c2135ffc94580a47cb21f6243ec0053d58b1124d13af2090033659075ee718e0f111bb3f69fb24cf" ])+    ]++hexalise s = concatMap (\c -> [ hex $ c `div` 16, hex $ c `mod` 16 ]) s+        where hex i+                | i >= 0 && i <= 9   = fromIntegral (ord '0') + i+                | i >= 10 && i <= 15 = fromIntegral (ord 'a') + i - 10+                | otherwise          = 0++hexaliseB :: B.ByteString -> B.ByteString+hexaliseB = B.pack . hexalise . B.unpack++splitB l b =+    if B.length b > l+        then+            let (b1, b2) = B.splitAt l b in+            b1 : splitB l b2+        else    +            [ b ]++showHash :: B.ByteString -> String+showHash = map (toEnum.fromEnum) . hexalise . B.unpack++runhash hash v = showHash $ (fctHash hash) $ v+runhashinc hash v = showHash $ (fctInc hash) $ v++makeTestAlg (name, hash, results) = concatMap maketest $ zip3 [0..] vectors results+    where+        testname i = name ++ " " ++ show i+        runtest v = runhash hash $ B.pack $ map (toEnum.fromEnum) v++        runtestinc i v = runhashinc hash $ splitB i $ B.pack $ map (toEnum.fromEnum) v++        maketest (i, v, r) =+            [ testname i ~: testname i ~: r ~=? (runtest v),+              testname i ~: testname i ~: r ~=? (runtestinc 1 v),+              testname i ~: testname i ~: r ~=? (runtestinc 2 v),+              testname i ~: testname i ~: r ~=? (runtestinc 3 v),+              testname i ~: testname i ~: r ~=? (runtestinc 4 v),+              testname i ~: testname i ~: r ~=? (runtestinc 5 v),+              testname i ~: testname i ~: r ~=? (runtestinc 9 v),+              testname i ~: testname i ~: r ~=? (runtestinc 16 v) ]++mapTests :: [Test]+mapTests = concatMap makeTestAlg results++tests = TestList mapTests++main = runTestTT tests

@@ -0,0 +1,150 @@+/*+ * Copyright (C) 2012 Vincent Hanquez <vincent@snarc.org>+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ *    notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ *    notice, this list of conditions and the following disclaimer in the+ *    documentation and/or other materials provided with the distribution.+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ */++#include <stdint.h>+#include <string.h>+#include "bitfn.h"+#include "sha3.h"++#define KECCAK_NB_ROUNDS 24++/* rounds constants */+static const uint64_t keccak_rndc[24] =+{+	0x0000000000000001ULL, 0x0000000000008082ULL, 0x800000000000808aULL,+	0x8000000080008000ULL, 0x000000000000808bULL, 0x0000000080000001ULL,+	0x8000000080008081ULL, 0x8000000000008009ULL, 0x000000000000008aULL,+	0x0000000000000088ULL, 0x0000000080008009ULL, 0x000000008000000aULL,+	0x000000008000808bULL, 0x800000000000008bULL, 0x8000000000008089ULL,+	0x8000000000008003ULL, 0x8000000000008002ULL, 0x8000000000000080ULL,+	0x000000000000800aULL, 0x800000008000000aULL, 0x8000000080008081ULL,+	0x8000000000008080ULL, 0x0000000080000001ULL, 0x8000000080008008ULL,+};++/* triangular numbers constants */+static const int keccak_rotc[24] =+	{ 1,3,6,10,15,21,28,36,45,55,2,14,27,41,56,8,25,43,62,18,39,61,20,44 };++static const int keccak_piln[24] =+	{ 10,7,11,17,18,3,5,16,8,21,24,4,15,23,19,13,12,2,20,14,22,9,6,1 };++static inline void sha3_do_chunk(uint64_t state[25], uint64_t buf[], int bufsz)+{+	int i, j, r;+	uint64_t tmp, bc[5];++	/* merge buf with state */+	for (i = 0; i < bufsz; i++)+		state[i] ^= buf[i];++	/* run keccak rounds */+	for (r = 0; r < KECCAK_NB_ROUNDS; r++) {+		/* compute the parity of each columns */+		for (i = 0; i < 5; i++)+			bc[i] = state[i] ^ state[i+5] ^ state[i+10] ^ state[i+15] ^ state[i+20];++		for (i = 0; i < 5; i++) {+			tmp = bc[(i + 4) % 5] ^ rol64(bc[(i + 1) % 5], 1);+			for (j = 0; j < 25; j += 5)+				state[j + i] ^= tmp;+		}++		/* rho pi */+		tmp = state[1];+		for (i = 0; i < 24; i++) {+			j = keccak_piln[i];+			bc[0] = state[j];+			state[j] = rol64(tmp, keccak_rotc[i]);+			tmp = bc[0];+		}++		/* bitwise combine along rows using a = a xor (not b and c) */+		for (j = 0; j < 25; j += 5) {+			for (i = 0; i < 5; i++)+				bc[i] = state[j + i];+			#define andn(b,c) (~(b) & (c))+			state[j + 0] ^= andn(bc[1], bc[2]);+			state[j + 1] ^= andn(bc[2], bc[3]);+			state[j + 2] ^= andn(bc[3], bc[4]);+			state[j + 3] ^= andn(bc[4], bc[0]);+			state[j + 4] ^= andn(bc[0], bc[1]);+			#undef andn+		}++		/* xor the round constant */+		state[0] ^= keccak_rndc[r];+	}+}++void sha3_init(struct sha3_ctx *ctx, uint32_t hashlen)+{+	memset(ctx, 0, sizeof(*ctx));+	ctx->hashlen = hashlen / 8;+	ctx->bufsz = 200 - 2 * ctx->hashlen;+}++void sha3_update(struct sha3_ctx *ctx, uint8_t *data, uint32_t len)+{+	uint32_t to_fill;++	to_fill = ctx->bufsz - ctx->bufindex;++	if (ctx->bufindex == ctx->bufsz) {+		sha3_do_chunk(ctx->state, (uint64_t *) ctx->buf, ctx->bufsz / 8);+		ctx->bufindex = 0;+	}++	/* process partial buffer if there's enough data to make a block */+	if (ctx->bufindex && len >= to_fill) {+		memcpy(ctx->buf + ctx->bufindex, data, to_fill);+		sha3_do_chunk(ctx->state, (uint64_t *) ctx->buf, ctx->bufsz / 8);+		len -= to_fill;+		data += to_fill;+		ctx->bufindex = 0;+	}++	/* process as much ctx->bufsz-block as possible except the last one in case we finalize */+	for (; len > ctx->bufsz; len -= ctx->bufsz, data += ctx->bufsz)+		sha3_do_chunk(ctx->state, (uint64_t *) data, ctx->bufsz / 8);++	/* append data into buf */+	if (len) {+		memcpy(ctx->buf + ctx->bufindex, data, len);+		ctx->bufindex += len;+	}+}++void sha3_finalize(struct sha3_ctx *ctx, uint8_t *out)+{+	/* add the 10*1 padding */+	ctx->buf[ctx->bufindex++] = 1;+	memset(ctx->buf + ctx->bufindex, 0, ctx->bufsz - ctx->bufindex);+	ctx->buf[ctx->bufsz - 1] |= 0x80;++	/* process */+	sha3_do_chunk(ctx->state, (uint64_t *) ctx->buf, ctx->bufsz / 8);++	/* output */+	memcpy(out, ctx->state, ctx->hashlen);+}

@@ -0,0 +1,45 @@+/*+ * Copyright (C) 2012 Vincent Hanquez <vincent@snarc.org>+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ *    notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ *    notice, this list of conditions and the following disclaimer in the+ *    documentation and/or other materials provided with the distribution.+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ */+#ifndef CRYPTOHASH_SHA3_H+#define CRYPTOHASH_SHA3_H++#include <stdint.h>++struct sha3_ctx+{+	uint32_t hashlen; /* in bytes */+	uint32_t bufindex;+	uint64_t state[25];+	uint32_t bufsz;+	uint32_t _padding;+	uint8_t  buf[144]; /* minimum SHA3-224, otherwise buffer need increases */+};++#define SHA3_CTX_SIZE		sizeof(struct sha3_ctx)++void sha3_init(struct sha3_ctx *ctx, uint32_t hashlen);+void sha3_update(struct sha3_ctx *ctx, uint8_t *data, uint32_t len);+void sha3_finalize(struct sha3_ctx *ctx, uint8_t *out);++#endif

@@ -1,5 +1,5 @@ Name:                cryptohash-Version:             0.7.6+Version:             0.7.7 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.@@ -14,20 +14,16 @@ Synopsis:            collection of crypto hashes, fast, pure and practical Category:            Data, Cryptography Build-Type:          Simple-Cabal-Version:       >=1.6+Cabal-Version:       >=1.8 Homepage:            http://github.com/vincenthz/hs-cryptohash data-files:          README.md  extra-source-files:   cbits/bitfn.h cbits/md2.h cbits/md4.h cbits/md5.h-  cbits/ripemd.h cbits/sha1.h cbits/sha256.h cbits/sha512.h+  cbits/ripemd.h cbits/sha1.h cbits/sha256.h cbits/sha512.h cbits/sha3.h   cbits/skein.h cbits/skein256.h cbits/skein512.h   cbits/tiger.h cbits/whirlpool.h -Flag test-  Description:       Build unit test-  Default:           False- Flag benchmark   Description:       Build benchmark test   Default:           False@@ -50,6 +46,7 @@                      Crypto.Hash.SHA384                      Crypto.Hash.SHA512                      Crypto.Hash.SHA512t+                     Crypto.Hash.SHA3                      Crypto.Hash.MD2                      Crypto.Hash.MD4                      Crypto.Hash.MD5@@ -59,10 +56,11 @@                      Crypto.Hash.Tiger                      Crypto.Hash.Whirlpool                      Crypto.MAC.HMAC-  ghc-options:       -Wall -O2 -optc-O3 -fno-cse+  ghc-options:       -Wall -O2 -optc-O3 -fno-cse -fwarn-tabs   C-sources:         cbits/sha1.c                      cbits/sha256.c                      cbits/sha512.c+                     cbits/sha3.c                      cbits/md2.c                      cbits/md4.c                      cbits/md5.c@@ -73,51 +71,27 @@                      cbits/whirlpool.c   Include-Dirs:      cbits -Executable           Tests-  Main-Is:           Tests.hs-  Extensions:        ForeignFunctionInterface-  C-sources:         cbits/sha1.c-                     cbits/sha256.c-                     cbits/sha512.c-                     cbits/md2.c-                     cbits/md4.c-                     cbits/md5.c-                     cbits/ripemd.c-                     cbits/skein256.c-                     cbits/skein512.c-                     cbits/tiger.c-                     cbits/whirlpool.c-  if flag(test)-    Buildable:       True-    Build-depends:   base >= 4, HUnit, bytestring-  else-    Buildable:       False-  if flag(cryptoapi)-    Build-depends:   crypto-api >= 0.5, tagged >= 0.1, cereal >= 0.2-    cpp-options:     -DHAVE_CRYPTOAPI+Test-Suite test-kat+  type:              exitcode-stdio-1.0+  hs-source-dirs:    Tests+  Main-Is:           KAT.hs+  Build-depends:     base >= 4 && < 5+                   , bytestring+                   , HUnit+                   , QuickCheck >= 2+                   , test-framework >= 0.3.3 && < 0.7+                   , test-framework-quickcheck2 >= 0.2.9 && < 0.3+                   , test-framework-hunit+                   , cryptohash  Executable           Bench   Main-Is:           Bench.hs-  Extensions:        ForeignFunctionInterface-  C-sources:         cbits/sha1.c-                     cbits/sha256.c-                     cbits/sha512.c-                     cbits/md2.c-                     cbits/md4.c-                     cbits/md5.c-                     cbits/ripemd.c-                     cbits/skein256.c-                     cbits/skein512.c-                     cbits/tiger.c-                     cbits/whirlpool.c+  hs-source-dirs:    Bench   if flag(benchmark)     Buildable:       True-    Build-depends:   base >= 4, bytestring, criterion+    Build-depends:   base >= 4, bytestring, criterion, cryptohash   else     Buildable:       False-  if flag(cryptoapi)-    Build-depends:   crypto-api >= 0.5, tagged >= 0.1, cereal >= 0.2-    cpp-options:     -DHAVE_CRYPTOAPI  source-repository head   type:     git