packages feed

cryptohash 0.8.1 → 0.8.2

raw patch · 7 files changed

+120/−59 lines, 7 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

+ Crypto.Hash: digestFromByteString :: HashAlgorithm a => ByteString -> Maybe (Digest a)
+ Crypto.Hash.Types: digestFromByteString :: HashAlgorithm a => ByteString -> Maybe (Digest a)

Files

Bench/BenchAPI.hs view
@@ -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
Crypto/Hash.hs view
@@ -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)
Crypto/Hash/Types.hs view
@@ -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 } 
Crypto/Hash/Utils.hs view
@@ -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"#
+ Crypto/Hash/Utils/Cpu.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}+module Crypto.Hash.Utils.Cpu+    ( use32Hex+    ) where++use32Hex :: Bool+#ifdef ARCH_X86+use32Hex = True+#else+use32Hex = False+#endif
Tests/KAT.hs view
@@ -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
cryptohash.cabal view
@@ -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