Permalink
Browse files

Merge Tinctorius whirlpool implementation

  • Loading branch information...
2 parents 24553b4 + cde446f commit 3423754c789482359c2cda55992d31394d589097 @vincenthz committed Oct 29, 2012
Showing with 1,206 additions and 1 deletion.
  1. +2 −0 Bench.hs
  2. +124 −0 Crypto/Hash/Whirlpool.hs
  3. +1 −0 README.md
  4. +7 −0 Tests.hs
  5. +1,022 −0 cbits/whirlpool.c
  6. +45 −0 cbits/whirlpool.h
  7. +5 −1 cryptohash.cabal
View
@@ -13,6 +13,7 @@ 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)
@@ -28,6 +29,7 @@ allHashs =
, ("Tiger",Tiger.hash)
, ("Skein256-256",Skein256.hash 256)
, ("Skein512-512",Skein512.hash 512)
+ , ("Whirlpool",Whirlpool.hash)
]
benchHash :: Int -> (B.ByteString -> B.ByteString) -> Pure
View
@@ -0,0 +1,124 @@
+{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
+
+-- |
+-- Module : Crypto.Hash.Whirlpool
+-- License : BSD-style
+-- Maintainer : Vincent Hanquez <vincent@snarc.org>
+-- Stability : experimental
+-- Portability : unknown
+--
+-- A module containing Whirlpool bindings
+--
+module Crypto.Hash.Whirlpool
+ ( Ctx(..)
+ , Whirlpool
+
+ -- * Incremental hashing Functions
+ , init -- :: Ctx
+ , update -- :: Ctx -> ByteString -> Ctx
+ , finalize -- :: Ctx -> ByteString
+
+ -- * 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.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.Word
+
+#ifdef HAVE_CRYPTOAPI
+
+import Control.Monad (liftM)
+import Data.Serialize (Serialize(..))
+import Data.Serialize.Get (getByteString)
+import Data.Serialize.Put (putByteString)
+import Data.Tagged (Tagged(..))
+import qualified Crypto.Classes as C (Hash(..))
+
+instance C.Hash Ctx Whirlpool where
+ outputLength = Tagged 512
+ blockLength = Tagged 512
+ 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
+
+#endif
+
+data Ctx = Ctx !ByteString
+data Whirlpool = Digest !ByteString
+ 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))
+
+ peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx
+
+foreign import ccall unsafe "whirlpool.h whirlpool_init"
+ c_whirlpool_init :: Ptr Ctx -> IO ()
+
+foreign import ccall "whirlpool.h whirlpool_add"
+ c_whirlpool_update :: CString -> Word32 -> Ptr Ctx -> 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)
+
+updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
+updateInternalIO ptr d =
+ unsafeUseAsCStringLen d (\(cs, len) -> c_whirlpool_update cs (8 * fromIntegral len) ptr)
+
+finalizeInternalIO :: Ptr Ctx -> IO ByteString
+finalizeInternalIO ptr =
+ allocaBytes digestSize (\cs -> c_whirlpool_finalize ptr cs >> B.packCStringLen (cs, digestSize))
+
+{-# NOINLINE init #-}
+-- | init a context
+init :: Ctx
+init = unsafePerformIO $ allocInternal $ \ptr -> do (c_whirlpool_init ptr >> peek ptr)
+
+{-# 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
+
+{-# NOINLINE finalize #-}
+-- | finalize the context into a digest bytestring
+finalize :: Ctx -> ByteString
+finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr
+
+{-# 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
+
+{-# 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
View
@@ -17,6 +17,7 @@ The complete list of supported hashes:
* SHA-2 family: 224, 256, 384, 512 and the newer 512t
* Skein: 256, 512
* Tiger
+* Whirlpool
You can easily import any hash with the following:
View
@@ -16,6 +16,7 @@ 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"
@@ -48,6 +49,8 @@ tigerHash = HashFct { fctHash = Tiger.hash, fctInc = hashinc Tiger.init Tiger.up
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, [
@@ -123,6 +126,10 @@ results = [
"b95175236c83a459ce7ec6c12b761a838b22d750e765b3fdaa892201b2aa714bc3d1d887dd64028bbf177c1dd11baa09c6c4ddb598fd07d6a8c131a09fc5b958e2999a8006754b25abe3bf8492b7eabec70e52e04e5ac867df2393c573f16eee3244554f1d2b724f2c0437c62007f770",
"3265708553e7d146e5c7bcbc97b3e9e9f5b53a5e4af53612bdd6454da4fa7b13d413184fe34ed57b6574be10e389d0ec4b1d2b1dd2c80e0257d5a76b2cd86a19a27b1bcb3cc24d911b5dc5ee74d19ad558fd85b5f024e99f56d1d3199f1f9f88ed85fab9f945f11cf9fc00e94e3ca4c7",
"3d23d3db9be719bbd2119f8402a28f38d8225faa79d5b68b80738c64a82004aafc7a840cd6dd9bced6644fa894a3d8d7d2ee89525fd1956a2db052c4c2f8d2111c91ef46b0997540d42bcf384826af1a5ef6510077f52d0574cf2b46f1b6a5dad07ed40f3d21a13ca2d079fa602ff02d" ])
+ , ("Whirlpool", whirlpoolHash, [
+ "19fa61d75522a4669b44e39c1d2e1726c530232130d407f89afee0964997f7a73e83be698b288febcf88e3e03c4f0757ea8964e59b63d93708b138cc42a66eb3",
+ "b97de512e91e3828b40d2b0fdce9ceb3c4a71f9bea8d88e75c4fa854df36725fd2b52eb6544edcacd6f8beddfea403cb55ae31f03ad62a5ef54e42ee82c3fb35",
+ "dce81fc695cfea3d7e1446509238daf89f24cc61896f2d265927daa70f2108f8902f0dfd68be085d5abb9fcd2e482c1dc24f2fabf81f40b73495cad44d7360d3"])
]
hexalise s =
Oops, something went wrong.

0 comments on commit 3423754

Please sign in to comment.