diff --git a/Bench/BenchAPI.hs b/Bench/BenchAPI.hs --- a/Bench/BenchAPI.hs +++ b/Bench/BenchAPI.hs @@ -3,10 +3,25 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Crypto.Hash.SHA512 as SHA512 import qualified Crypto.Hash.SHA3 as SHA3 import Crypto.Hash import qualified Crypto.Classes as CAPI +sha1F = ( "sha1" + , SHA1.hash + , SHA1.finalize . SHA1.update SHA1.init + , digestToByteString . (hash :: B.ByteString -> Digest SHA1) + , CAPI.hash' :: B.ByteString -> SHA1.SHA1 + ) + +sha512F = ( "sha512" + , SHA512.hash + , SHA512.finalize . SHA512.update SHA512.init + , digestToByteString . (hash :: B.ByteString -> Digest SHA512) + , CAPI.hash' :: B.ByteString -> SHA512.SHA512 + ) + main = do let !bs32 = B.replicate 32 0 !bs256 = B.replicate 256 0 @@ -14,24 +29,36 @@ !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]) + + let (fname, fHash, fIncr, fAPI, fCAPI) = sha512F + let benchName ty z = fname ++ "." ++ ty ++ " " ++ show z defaultMain - [ bcompare - [ bench "sha1.hash 32" $ whnf SHA1.hash bs32 - , bench "sha1.incr 32" $ whnf (SHA1.finalize . SHA1.update SHA1.init) bs32 - , bench "sha1.api 32" $ whnf (digestToByteString . hashsha1) bs32 - , bench "sha1.capi 32" $ whnf (CAPI.hash' :: B.ByteString -> SHA1.SHA1) bs32 + [ bgroup "digest hex" + [ bench "hex" $ whnf digestToHexByteString (hashsha1 B.empty) ] , bcompare - [ bench "sha1.hash 256" $ whnf SHA1.hash bs256 - , bench "sha1.incr 256" $ whnf (SHA1.finalize . SHA1.update SHA1.init) bs256 - , bench "sha1.api 256" $ whnf (digestToByteString . hashsha1) bs256 - , bench "sha1.capi 256" $ whnf (CAPI.hash' :: B.ByteString -> SHA1.SHA1) bs256 + [ bench (benchName "hash" 0) $ whnf fHash B.empty + , bench (benchName "incr" 0) $ whnf fIncr B.empty + , bench (benchName "api" 0) $ whnf fAPI B.empty + , bench (benchName "capi" 0) $ whnf fCAPI B.empty ] , bcompare - [ bench "sha1.hash 4096" $ whnf SHA1.hash bs4096 - , bench "sha1.incr 4096" $ whnf (SHA1.finalize . SHA1.update SHA1.init) bs4096 - , bench "sha1.api 4096" $ whnf (digestToByteString . hashsha1) bs4096 - , bench "sha1.capi 4096" $ whnf (CAPI.hash' :: B.ByteString -> SHA1.SHA1) bs4096 + [ bench (benchName "hash" 32) $ whnf SHA1.hash bs32 + , bench (benchName "incr" 32) $ whnf fIncr bs32 + , bench (benchName "api" 32) $ whnf fAPI bs32 + , bench (benchName "capi" 32) $ whnf fCAPI bs32 + ] + , bcompare + [ bench (benchName "hash" 256) $ whnf SHA1.hash bs256 + , bench (benchName "incr" 256) $ whnf fIncr bs256 + , bench (benchName "api" 256) $ whnf fAPI bs256 + , bench (benchName "capi" 256) $ whnf fCAPI bs256 + ] + , bcompare + [ bench (benchName "hash" 4096) $ whnf SHA1.hash bs4096 + , bench (benchName "incr" 4096) $ whnf fIncr bs4096 + , bench (benchName "api" 4096) $ whnf fAPI bs4096 + , bench (benchName "capi" 4096) $ whnf fCAPI bs4096 ] ] where hashsha1 = hash :: B.ByteString -> Digest SHA1 diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -49,6 +49,7 @@ import Crypto.Hash.Types import Crypto.Hash.Utils import Data.ByteString (ByteString) +import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Crypto.Hash.MD2 as MD2 @@ -88,6 +89,7 @@ { hashInit = Context c where { (MODULENAME.Ctx c) = MODULENAME.init } \ ; hashUpdates (Context c) bs = Context nc where { (MODULENAME.Ctx nc) = MODULENAME.updates (MODULENAME.Ctx c) bs } \ ; hashFinalize (Context c) = Digest $ MODULENAME.finalize (MODULENAME.Ctx c) \ + ; digestFromByteString bs = if B.length bs == len then (Just $ Digest bs) else Nothing where { len = B.length (MODULENAME.finalize MODULENAME.init) } \ }; #define DEFINE_INSTANCE_LEN(NAME, MODULENAME, LEN) \ @@ -96,6 +98,7 @@ { hashInit = Context c where { (MODULENAME.Ctx c) = MODULENAME.init LEN } \ ; hashUpdates (Context c) bs = Context nc where { (MODULENAME.Ctx nc) = MODULENAME.updates (MODULENAME.Ctx c) bs } \ ; hashFinalize (Context c) = Digest $ MODULENAME.finalize (MODULENAME.Ctx c) \ + ; digestFromByteString bs = if B.length bs == len then (Just $ Digest bs) else Nothing where { len = B.length (MODULENAME.finalize (MODULENAME.init LEN)) } \ }; DEFINE_INSTANCE(MD2, MD2) diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs --- a/Crypto/Hash/Types.hs +++ b/Crypto/Hash/Types.hs @@ -37,6 +37,9 @@ -- | Finalize a context and return a digest. hashFinalize :: Context a -> Digest a + -- | Try to convert a binary digest bytestring to a digest. + digestFromByteString :: ByteString -> Maybe (Digest a) + -- | Represent a context for a given hash algorithm. newtype Context a = Context { contextToByteString :: ByteString } diff --git a/Crypto/Hash/Utils.hs b/Crypto/Hash/Utils.hs --- a/Crypto/Hash/Utils.hs +++ b/Crypto/Hash/Utils.hs @@ -18,55 +18,58 @@ import GHC.Types import GHC.Word import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Ptr (plusPtr) +import Foreign.Ptr (plusPtr, castPtr) import Foreign.Storable (poke, peek) +import Crypto.Hash.Utils.Cpu +import Data.Bits (testBit) toHex :: ByteString -> ByteString toHex (B.PS fp off len) = B.unsafeCreate (len*2) $ \d -> withForeignPtr fp $ \s -> start d (s `plusPtr` off) - where start db sb = loop db sb + where start db sb + | use32Hex && (len `testBit` 0) == False = loop32 db sb + | otherwise = loop8 db sb where end = sb `plusPtr` len - loop d s + -- write the hex output using 32 bits write. + loop32 d s | s == end = return () + | otherwise = do b1 <- fromIntegral `fmap` (peek s :: IO Word8) + b2 <- fromIntegral `fmap` (peek (s `plusPtr` 1) :: IO Word8) + poke (castPtr d) (to32 b1 b2) + loop32 (d `plusPtr` 4) (s `plusPtr` 2) + -- write the hex output 8 bits, 2 at a time + loop8 d s + | s == end = return () | otherwise = do b <- fromIntegral `fmap` (peek s :: IO Word8) poke d (r tableHi b) poke (d `plusPtr` 1) (r tableLo b) - loop (d `plusPtr` 2) (s `plusPtr` 1) + loop8 (d `plusPtr` 2) (s `plusPtr` 1) + -- little endian version + to32 (I# i1) (I# i2) = W32# (or# (or# (or# hi2 lo2) hi1) lo1) + where hi2 = uncheckedShiftL# (indexWord8OffAddr# tableLo i2) 24# + lo2 = uncheckedShiftL# (indexWord8OffAddr# tableHi i2) 16# + hi1 = uncheckedShiftL# (indexWord8OffAddr# tableLo i1) 8# + lo1 = indexWord8OffAddr# tableHi i1 + r :: Addr# -> Int -> Word8 r table (I# index) = W8# (indexWord8OffAddr# table index) !tableLo = - "\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\ - \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66"# + "0123456789abcdef0123456789abcdef\ + \0123456789abcdef0123456789abcdef\ + \0123456789abcdef0123456789abcdef\ + \0123456789abcdef0123456789abcdef\ + \0123456789abcdef0123456789abcdef\ + \0123456789abcdef0123456789abcdef\ + \0123456789abcdef0123456789abcdef\ + \0123456789abcdef0123456789abcdef"# !tableHi = - "\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\ - \\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\ - \\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\ - \\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\ - \\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\ - \\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\ - \\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\ - \\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\ - \\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\ - \\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\ - \\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\ - \\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\ - \\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\ - \\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\ - \\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\ - \\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66"# + "00000000000000001111111111111111\ + \22222222222222223333333333333333\ + \44444444444444445555555555555555\ + \66666666666666667777777777777777\ + \88888888888888889999999999999999\ + \aaaaaaaaaaaaaaaabbbbbbbbbbbbbbbb\ + \ccccccccccccccccdddddddddddddddd\ + \eeeeeeeeeeeeeeeeffffffffffffffff"# diff --git a/Crypto/Hash/Utils/Cpu.hs b/Crypto/Hash/Utils/Cpu.hs new file mode 100644 --- /dev/null +++ b/Crypto/Hash/Utils/Cpu.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE CPP #-} +module Crypto.Hash.Utils.Cpu + ( use32Hex + ) where + +use32Hex :: Bool +#ifdef ARCH_X86 +use32Hex = True +#else +use32Hex = False +#endif diff --git a/Tests/KAT.hs b/Tests/KAT.hs --- a/Tests/KAT.hs +++ b/Tests/KAT.hs @@ -18,6 +18,7 @@ import qualified Crypto.Hash.Skein256 as Skein256 import qualified Crypto.Hash.Skein512 as Skein512 import qualified Crypto.Hash.Whirlpool as Whirlpool +import Crypto.Hash v0 = "" v1 = "The quick brown fox jumps over the lazy dog" @@ -182,18 +183,28 @@ 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) ] + [ testname i ~: r ~=? (runtest v), + testname i ~: r ~=? (runtestinc 1 v), + testname i ~: r ~=? (runtestinc 2 v), + testname i ~: r ~=? (runtestinc 3 v), + testname i ~: r ~=? (runtestinc 4 v), + testname i ~: r ~=? (runtestinc 5 v), + testname i ~: r ~=? (runtestinc 9 v), + testname i ~: r ~=? (runtestinc 16 v) ] mapTests :: [Test] mapTests = concatMap makeTestAlg results -tests = TestList mapTests +apiTests :: [Test] +apiTests = + [ "sha1 api" ~: runhash sha1Hash B.empty ~=? show (hash B.empty :: Digest SHA1) + , "sha256 api" ~: runhash sha256Hash B.empty ~=? show (hash B.empty :: Digest SHA256) + , "sha512 api" ~: runhash sha512Hash B.empty ~=? show (hash B.empty :: Digest SHA512) + , "sha3-224 api" ~: runhash (sha3Hash 224) B.empty ~=? show (hash B.empty :: Digest SHA3_224) + , "sha3-256 api" ~: runhash (sha3Hash 256) B.empty ~=? show (hash B.empty :: Digest SHA3_256) + , "sha3-512 api" ~: runhash (sha3Hash 512) B.empty ~=? show (hash B.empty :: Digest SHA3_512) + ] + +tests = TestList (mapTests ++ apiTests) main = runTestTT tests diff --git a/cryptohash.cabal b/cryptohash.cabal --- a/cryptohash.cabal +++ b/cryptohash.cabal @@ -1,5 +1,5 @@ Name: cryptohash -Version: 0.8.1 +Version: 0.8.2 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. @@ -77,6 +77,7 @@ Crypto.Hash.Whirlpool Crypto.MAC.HMAC Other-modules: Crypto.Hash.Utils + Crypto.Hash.Utils.Cpu Crypto.Hash.Internal ghc-options: -Wall -O2 -optc-O3 -fno-cse -fwarn-tabs C-sources: cbits/sha1.c @@ -92,6 +93,8 @@ cbits/tiger.c cbits/whirlpool.c Include-Dirs: cbits + if (arch(i386) || arch(x86_64)) + cpp-options: -DARCH_X86 Test-Suite test-kat type: exitcode-stdio-1.0