diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs new file mode 100644 index 0000000..4c693c8 --- /dev/null +++ b/Crypto/Hash.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE CPP #-} +-- | +-- Module : Crypto.Hash +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- Generalized cryptographic hash interface, that you can use with cryptographic hash +-- algorithm that belong to the HashAlgorithm type class. +-- +-- > import Crypto.Hash +-- > +-- > sha1 :: ByteString -> Digest SHA1 +-- > sha1 = hash +-- > +-- > hexSha3_512 :: ByteString -> String +-- > hexSha3_512 bs = show (hash bs :: Digest SHA3_512) +-- +module Crypto.Hash + ( + -- * Types + HashAlgorithm(..) + , HashFunctionBS + , HashFunctionLBS + , Context + , Digest + -- * Functions + , digestToByteString + , digestToHexByteString + , hash + , hashlazy + , hashUpdate + , hashInitAlg + -- * hash algorithms + , MD2(..) + , MD4(..) + , MD5(..) + , SHA1(..) + , SHA224(..) + , SHA256(..) + , SHA384(..) + , SHA512(..) + , RIPEMD160(..) + , Tiger(..) + , SHA3_224(..) + , SHA3_256(..) + , SHA3_384(..) + , SHA3_512(..) + , Skein256_224(..) + , Skein256_256(..) + , Skein512_224(..) + , Skein512_256(..) + , Skein512_384(..) + , Skein512_512(..) + , Whirlpool(..) + ) where + +import Crypto.Hash.Types +import Crypto.Hash.Utils +import Data.ByteString (ByteString) +import Data.Byteable +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.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 + +-- | Alias to a single pass hash function that operate on a strict bytestring +type HashFunctionBS a = ByteString -> Digest a + +-- | Alias to a single pass hash function that operate on a lazy bytestring +type HashFunctionLBS a = L.ByteString -> Digest a + +-- | run hashUpdates on one single bytestring and return the updated context. +hashUpdate :: HashAlgorithm a => Context a -> ByteString -> Context a +hashUpdate ctx b = hashUpdates ctx [b] + +-- | Hash a strict bytestring into a digest. +hash :: HashAlgorithm a => ByteString -> Digest a +hash bs = hashFinalize $ hashUpdate hashInit bs + +-- | Hash a lazy bytestring into a digest. +hashlazy :: HashAlgorithm a => L.ByteString -> Digest a +hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs) + +-- | Return the hexadecimal (base16) bytestring of the digest +digestToHexByteString :: Digest a -> ByteString +digestToHexByteString = toHex . toBytes + +#define DEFINE_INSTANCE(NAME, MODULENAME, BLOCKSIZE) \ +data NAME = NAME deriving Show; \ +instance HashAlgorithm NAME where \ + { hashInit = Context c where { (MODULENAME.Ctx c) = MODULENAME.init } \ + ; hashBlockSize ~(Context _) = BLOCKSIZE \ + ; 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, BLOCKSIZE) \ +data NAME = NAME deriving Show; \ +instance HashAlgorithm NAME where \ + { hashInit = Context c where { (MODULENAME.Ctx c) = MODULENAME.init LEN } \ + ; hashBlockSize ~(Context _) = BLOCKSIZE \ + ; 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)) } \ + }; + +-- | MD2 cryptographic hash +DEFINE_INSTANCE(MD2, MD2, 16) +-- | MD4 cryptographic hash +DEFINE_INSTANCE(MD4, MD4, 64) +-- | MD5 cryptographic hash +DEFINE_INSTANCE(MD5, MD5, 64) +-- | SHA1 cryptographic hash +DEFINE_INSTANCE(SHA1, SHA1, 64) +-- | SHA224 cryptographic hash +DEFINE_INSTANCE(SHA224, SHA224, 64) +-- | SHA256 cryptographic hash +DEFINE_INSTANCE(SHA256, SHA256, 64) +-- | SHA384 cryptographic hash +DEFINE_INSTANCE(SHA384, SHA384, 128) +-- | SHA512 cryptographic hash +DEFINE_INSTANCE(SHA512, SHA512, 128) + +-- | RIPEMD160 cryptographic hash +DEFINE_INSTANCE(RIPEMD160, RIPEMD160, 64) +-- | Whirlpool cryptographic hash +DEFINE_INSTANCE(Whirlpool, Whirlpool, 64) +-- | Tiger cryptographic hash +DEFINE_INSTANCE(Tiger, Tiger, 64) + +-- | SHA3 (224 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(SHA3_224, SHA3, 224, 144) +-- | SHA3 (256 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(SHA3_256, SHA3, 256, 136) +-- | SHA3 (384 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(SHA3_384, SHA3, 384, 104) +-- | SHA3 (512 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(SHA3_512, SHA3, 512, 72) + +-- | Skein256 (224 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(Skein256_224, Skein256, 224, 32) +-- | Skein256 (256 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(Skein256_256, Skein256, 256, 32) + +-- | Skein512 (224 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(Skein512_224, Skein512, 224, 64) +-- | Skein512 (256 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(Skein512_256, Skein512, 256, 64) +-- | Skein512 (384 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(Skein512_384, Skein512, 384, 64) +-- | Skein512 (512 bits version) cryptographic hash +DEFINE_INSTANCE_LEN(Skein512_512, Skein512, 512, 64) + +-- | Initialize a new context for a specified hash algorithm +hashInitAlg :: HashAlgorithm alg => alg -> Context alg +hashInitAlg _ = hashInit diff --git a/Crypto/Hash/Utils/Cpu.hs b/Crypto/Hash/Utils/Cpu.hs new file mode 100644 index 0000000..4e4e447 --- /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/Crypto/MAC/HMAC.hs b/Crypto/MAC/HMAC.hs new file mode 100644 index 0000000..ef61724 --- /dev/null +++ b/Crypto/MAC/HMAC.hs @@ -0,0 +1,91 @@ +-- | +-- Module : Crypto.MAC.HMAC +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- provide the HMAC (Hash based Message Authentification Code) base algorithm. +-- +-- +{-# LANGUAGE BangPatterns #-} +module Crypto.MAC.HMAC + ( hmac + , HMAC(..) + -- * incremental + , Context(..) + , initialize + , update + , finalize + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Bits (xor) +import Data.Byteable +import Crypto.Hash hiding (Context) +import qualified Crypto.Hash as Hash (Context) + +-- | Represent an HMAC that is a phantom type with the hash used to produce the mac. +-- +-- The Eq instance is constant time. +newtype HMAC a = HMAC { hmacGetDigest :: Digest a } + +instance Byteable (HMAC a) where + toBytes (HMAC b) = toBytes b + +instance Eq (HMAC a) where + (HMAC b1) == (HMAC b2) = constEqBytes (toBytes b1) (toBytes b2) + +-- | compute a MAC using the supplied hashing function +hmac :: (Byteable key, HashAlgorithm a) + => key -- ^ Secret key + -> ByteString -- ^ Message to MAC + -> HMAC a +hmac secret msg = doHMAC hashInit + where doHMAC :: HashAlgorithm a => Hash.Context a -> HMAC a + doHMAC !ctxInit = HMAC $ hashF $ B.append opad (toBytes $ hashF $ B.append ipad msg) + where opad = B.map (xor 0x5c) k' + ipad = B.map (xor 0x36) k' + + k' = B.append kt pad + kt = if byteableLength secret > fromIntegral blockSize then toBytes (hashF (toBytes secret)) else toBytes secret + pad = B.replicate (fromIntegral blockSize - B.length kt) 0 + hashF = hashFinalize . hashUpdate ctxInit + blockSize = hashBlockSize ctxInit + +-- | Represent an ongoing HMAC state, that can be appended with 'hmacUpdate' +-- and finalize to an HMAC with 'hmacFinalize' +data Context hashalg = Context !(Hash.Context hashalg) !(Hash.Context hashalg) + +-- | Initialize a new incremental HMAC context +initialize :: (Byteable key, HashAlgorithm a) + => key -- ^ Secret key + -> Context a +initialize secret = Context octx ictx + where ictx = hashUpdates ctxInit [ipad] + octx = hashUpdates ctxInit [opad] + ipad = B.map (xor 0x36) k' + opad = B.map (xor 0x5c) k' + + k' = B.append kt pad + kt = if byteableLength secret > fromIntegral blockSize then toBytes (hashF (toBytes secret)) else toBytes secret + pad = B.replicate (fromIntegral blockSize - B.length kt) 0 + hashF = hashFinalize . hashUpdate ctxInit + blockSize = hashBlockSize ctxInit + !ctxInit = hashInit + +-- | Incrementally update a HMAC context +update :: HashAlgorithm a + => Context a -- ^ Current HMAC context + -> ByteString -- ^ Message to Mac + -> Context a -- ^ Updated HMAC context +update (Context octx ictx) msg = + Context octx (hashUpdate ictx msg) + +-- | Finalize a HMAC context and return the HMAC. +finalize :: HashAlgorithm a + => Context a + -> HMAC a +finalize (Context octx ictx) = + HMAC $ hashFinalize $ hashUpdates octx [toBytes $ hashFinalize ictx] diff --git a/cryptonite.cabal b/cryptonite.cabal index 3243190..6abe2de 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -23,6 +23,8 @@ Library Exposed-modules: Crypto.Cipher.ChaCha Crypto.Cipher.Salsa Crypto.MAC.Poly1305 + Crypto.MAC.HMAC + Crypto.Hash Crypto.Hash.SHA1 Crypto.Hash.SHA224 Crypto.Hash.SHA256 @@ -39,10 +41,13 @@ Library Crypto.Hash.Tiger Crypto.Hash.Whirlpool Other-modules: Crypto.Hash.Internal + , Crypto.Hash.Utils + , Crypto.Hash.Types Build-depends: base >= 4 && < 5 , bytestring , securemem , byteable + , ghc-prim ghc-options: -Wall -fwarn-tabs -optc-O3 default-language: Haskell2010 C-sources: cbits/cryptonite_chacha.c diff --git a/tests/KAT_HMAC.hs b/tests/KAT_HMAC.hs new file mode 100644 index 0000000..b41eabd --- /dev/null +++ b/tests/KAT_HMAC.hs @@ -0,0 +1,159 @@ +{-# LANGUAGE OverloadedStrings #-} +module KAT_HMAC (tests) where + +import qualified Crypto.MAC.HMAC as HMAC +import Crypto.Hash (MD5(..), SHA1(..), SHA256(..), SHA3_224(..), SHA3_256(..), SHA3_384(..), SHA3_512(..) + , HashAlgorithm, digestFromByteString) +import Control.Applicative ((<$>)) +import Control.Monad (replicateM) +import Data.Char +import Data.Bits +import Data.Word +import Data.ByteString (ByteString) +import Data.Byteable +import Data.Foldable (foldl') +import Data.Monoid (mconcat) +import qualified Data.ByteString as B + +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +data MACVector hash = MACVector + { macKey :: ByteString + , macSecret :: ByteString + , macResult :: HMAC.HMAC hash + } + +instance Show (HMAC.HMAC a) where + show (HMAC.HMAC d) = show d + +digest :: HashAlgorithm hash => ByteString -> HMAC.HMAC hash +digest = maybe (error "cannot get digest") HMAC.HMAC . digestFromByteString + +v0,v1,v2 :: ByteString +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 ] + +md5MACVectors :: [MACVector MD5] +md5MACVectors = + [ MACVector B.empty B.empty $ digest "\x74\xe6\xf7\x29\x8a\x9c\x2d\x16\x89\x35\xf5\x8c\x00\x1b\xad\x88" + , MACVector "key" v1 $ digest "\x80\x07\x07\x13\x46\x3e\x77\x49\xb9\x0c\x2d\xc2\x49\x11\xe2\x75" + ] + +sha1MACVectors :: [MACVector SHA1] +sha1MACVectors = + [ MACVector B.empty B.empty $ digest "\xfb\xdb\x1d\x1b\x18\xaa\x6c\x08\x32\x4b\x7d\x64\xb7\x1f\xb7\x63\x70\x69\x0e\x1d" + , MACVector "key" v1 $ digest "\xde\x7c\x9b\x85\xb8\xb7\x8a\xa6\xbc\x8a\x7a\x36\xf7\x0a\x90\x70\x1c\x9d\xb4\xd9" + ] + +sha256MACVectors :: [MACVector SHA256] +sha256MACVectors = + [ MACVector B.empty B.empty $ digest "\xb6\x13\x67\x9a\x08\x14\xd9\xec\x77\x2f\x95\xd7\x78\xc3\x5f\xc5\xff\x16\x97\xc4\x93\x71\x56\x53\xc6\xc7\x12\x14\x42\x92\xc5\xad" + , MACVector "key" v1 $ digest "\xf7\xbc\x83\xf4\x30\x53\x84\x24\xb1\x32\x98\xe6\xaa\x6f\xb1\x43\xef\x4d\x59\xa1\x49\x46\x17\x59\x97\x47\x9d\xbc\x2d\x1a\x3c\xd8" + ] + +sha3_key1 = "\x4a\x65\x66\x65" +sha3_data1 = "\x77\x68\x61\x74\x20\x64\x6f\x20\x79\x61\x20\x77\x61\x6e\x74\x20\x66\x6f\x72\x20\x6e\x6f\x74\x68\x69\x6e\x67\x3f" + +sha3_224_MAC_Vectors :: [MACVector SHA3_224] +sha3_224_MAC_Vectors = + [ MACVector sha3_key1 sha3_data1 $ digest "\xe8\x24\xfe\xc9\x6c\x07\x4f\x22\xf9\x92\x35\xbb\x94\x2d\xa1\x98\x26\x64\xab\x69\x2c\xa8\x50\x10\x53\xcb\xd4\x14" + ] + +sha3_256_MAC_Vectors :: [MACVector SHA3_256] +sha3_256_MAC_Vectors = + [ MACVector sha3_key1 sha3_data1 $ digest "\xaa\x9a\xed\x44\x8c\x7a\xbc\x8b\x5e\x32\x6f\xfa\x6a\x01\xcd\xed\xf7\xb4\xb8\x31\x88\x14\x68\xc0\x44\xba\x8d\xd4\x56\x63\x69\xa1" + ] + +sha3_384_MAC_Vectors :: [MACVector SHA3_384] +sha3_384_MAC_Vectors = + [ MACVector sha3_key1 sha3_data1 $ digest "\x5a\xf5\xc9\xa7\x7a\x23\xa6\xa9\x3d\x80\x64\x9e\x56\x2a\xb7\x7f\x4f\x35\x52\xe3\xc5\xca\xff\xd9\x3b\xdf\x8b\x3c\xfc\x69\x20\xe3\x02\x3f\xc2\x67\x75\xd9\xdf\x1f\x3c\x94\x61\x31\x46\xad\x2c\x9d" + ] + +sha3_512_MAC_Vectors :: [MACVector SHA3_512] +sha3_512_MAC_Vectors = + [ MACVector sha3_key1 sha3_data1 $ digest "\xc2\x96\x2e\x5b\xbe\x12\x38\x00\x78\x52\xf7\x9d\x81\x4d\xbb\xec\xd4\x68\x2e\x6f\x09\x7d\x37\xa3\x63\x58\x7c\x03\xbf\xa2\xeb\x08\x59\xd8\xd9\xc7\x01\xe0\x4c\xec\xec\xfd\x3d\xd7\xbf\xd4\x38\xf2\x0b\x8b\x64\x8e\x01\xbf\x8c\x11\xd2\x68\x24\xb9\x6c\xeb\xbd\xcb" + ] + + +macTests :: [TestTree] +macTests = + [ testGroup "hmac-md5" $ map toMACTest $ zip is md5MACVectors + , testGroup "hmac-sha1" $ map toMACTest $ zip is sha1MACVectors + , testGroup "hmac-sha256" $ map toMACTest $ zip is sha256MACVectors + , testGroup "hmac-sha3-224" $ map toMACTest $ zip is sha3_224_MAC_Vectors + , testGroup "hmac-sha3-256" $ map toMACTest $ zip is sha3_256_MAC_Vectors + , testGroup "hmac-sha3-384" $ map toMACTest $ zip is sha3_384_MAC_Vectors + , testGroup "hmac-sha3-512" $ map toMACTest $ zip is sha3_512_MAC_Vectors + ] + where toMACTest (i, macVector) = + testCase (show i) (macResult macVector @=? HMAC.hmac (macKey macVector) (macSecret macVector)) + is :: [Int] + is = [1..] + +data MacIncremental a = MacIncremental ByteString ByteString (HMAC.HMAC a) + deriving (Show,Eq) + +arbitraryBS = B.pack <$> (choose (1,299) >>= \i -> replicateM i arbitrary) + +instance HashAlgorithm a => Arbitrary (MacIncremental a) where + arbitrary = do + key <- arbitraryBS + msg <- arbitraryBS + return $ MacIncremental key msg (HMAC.hmac key msg) + +data MacIncrementalList a = MacIncrementalList ByteString [ByteString] (HMAC.HMAC a) + deriving (Show,Eq) + +instance HashAlgorithm a => Arbitrary (MacIncrementalList a) where + arbitrary = do + key <- arbitraryBS + msgs <- choose (1,20) >>= \i -> replicateM i arbitraryBS + return $ MacIncrementalList key msgs (HMAC.hmac key (B.concat msgs)) + +macIncrementalTests :: [TestTree] +macIncrementalTests = + [ testGroup "hmac-md5" $ map toMACTest $ zip is md5MACVectors + , testGroup "hmac-sha1" $ map toMACTest $ zip is sha1MACVectors + , testGroup "hmac-sha256" $ map toMACTest $ zip is sha256MACVectors + , testGroup "hmac-sha3-224" $ map toMACTest $ zip is sha3_224_MAC_Vectors + , testGroup "hmac-sha3-256" $ map toMACTest $ zip is sha3_256_MAC_Vectors + , testGroup "hmac-sha3-384" $ map toMACTest $ zip is sha3_384_MAC_Vectors + , testGroup "hmac-sha3-512" $ map toMACTest $ zip is sha3_512_MAC_Vectors + , testProperty "hmac-md5" $ prop_inc0 MD5 + , testProperty "hmac-md5" $ prop_inc1 MD5 + , testProperty "hmac-sha1" $ prop_inc0 SHA1 + , testProperty "hmac-sha1" $ prop_inc1 SHA1 + , testProperty "hmac-sha256" $ prop_inc0 SHA256 + , testProperty "hmac-sha256" $ prop_inc1 SHA256 + , testProperty "hmac-sha3-224" $ prop_inc0 SHA3_224 + , testProperty "hmac-sha3-224" $ prop_inc1 SHA3_224 + , testProperty "hmac-sha3-256" $ prop_inc0 SHA3_256 + , testProperty "hmac-sha3-256" $ prop_inc1 SHA3_256 + , testProperty "hmac-sha3-384" $ prop_inc0 SHA3_384 + , testProperty "hmac-sha3-384" $ prop_inc1 SHA3_384 + , testProperty "hmac-sha3-512" $ prop_inc0 SHA3_512 + , testProperty "hmac-sha3-512" $ prop_inc1 SHA3_512 + ] + where toMACTest (i, macVector) = + testCase (show i) (macResult macVector @=? HMAC.finalize (HMAC.update initCtx (macSecret macVector))) + where initCtx = HMAC.initialize (macKey macVector) + + prop_inc0 :: HashAlgorithm a => a -> MacIncremental a -> Bool + prop_inc0 _ (MacIncremental secret msg result) = + HMAC.finalize (HMAC.update (HMAC.initialize secret) msg) == result + + prop_inc1 :: HashAlgorithm a => a -> MacIncrementalList a -> Bool + prop_inc1 _ (MacIncrementalList secret msgs result) = + HMAC.finalize (foldl' HMAC.update (HMAC.initialize secret) msgs) == result + + is :: [Int] + is = [1..] + +tests = testGroup "HMAC" + [ testGroup "KATs" macTests + , testGroup "Incremental" macIncrementalTests + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index cd47817..cb389c7 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -15,6 +15,7 @@ import qualified Crypto.MAC.Poly1305 as Poly1305 import qualified KATSalsa import qualified KATHash +import qualified KAT_HMAC b8_128_k0_i0 = "\xe2\x8a\x5f\xa4\xa6\x7f\x8c\x5d\xef\xed\x3e\x6f\xb7\x30\x34\x86\xaa\x84\x27\xd3\x14\x19\xa7\x29\x57\x2d\x77\x79\x53\x49\x11\x20\xb6\x4a\xb8\xe7\x2b\x8d\xeb\x85\xcd\x6a\xea\x7c\xb6\x08\x9a\x10\x18\x24\xbe\xeb\x08\x81\x4a\x42\x8a\xab\x1f\xa2\xc8\x16\x08\x1b\x8a\x26\xaf\x44\x8a\x1b\xa9\x06\x36\x8f\xd8\xc8\x38\x31\xc1\x8c\xec\x8c\xed\x81\x1a\x02\x8e\x67\x5b\x8d\x2b\xe8\xfc\xe0\x81\x16\x5c\xea\xe9\xf1\xd1\xb7\xa9\x75\x49\x77\x49\x48\x05\x69\xce\xb8\x3d\xe6\xa0\xa5\x87\xd4\x98\x4f\x19\x92\x5f\x5d\x33\x8e\x43\x0d" @@ -67,6 +68,7 @@ tests = testGroup "cryptonite" in Poly1305.auth key msg == Poly1305.finalize (foldr (flip Poly1305.update) (Poly1305.initialize key) (chunks chunkLen msg)) ] , KATHash.tests + , KAT_HMAC.tests ] where chachaRunSimple expected rounds klen nonceLen = let chacha = ChaCha.initialize rounds (B.replicate klen 0) (B.replicate nonceLen 0)