diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -13,6 +13,8 @@ ( -- * Types HashAlgorithm(..) + , HashFunctionBS + , HashFunctionLBS , Context , Digest -- * Functions @@ -43,12 +45,17 @@ , Skein512_384 , Skein512_512 , Whirlpool + -- * MAC algorithms + , HMAC(..) + , hmac ) where import Crypto.Hash.Types import Crypto.Hash.Utils import Data.ByteString (ByteString) +import Data.Bits (xor) +import Data.List (foldl') import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L @@ -67,6 +74,12 @@ 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] @@ -126,3 +139,32 @@ DEFINE_INSTANCE_LEN(Skein512_256, Skein512, 256) DEFINE_INSTANCE_LEN(Skein512_384, Skein512, 384) DEFINE_INSTANCE_LEN(Skein512_512, Skein512, 512) + +-- | Represent an HMAC that is phantom types with the hash used to produce the mac. +-- +-- The Eq instance is constant time. +data HMAC a = HMAC { hmacToByteString :: ByteString -- ^ return the binary HMAC + } + +instance Eq (HMAC a) where + (HMAC b1) == (HMAC b2) + | B.length b1 /= B.length b2 = False + | otherwise = foldl' (&&!) True $ B.zipWith (==) b1 b2 + where True &&! True = True + True &&! False = False + False &&! True = False + False &&! False = False + +-- | compute a MAC using the supplied hashing function +hmac :: HashFunctionBS a -- ^ Hash function to use + -> Int -- ^ Block size in bytes of the hash function + -> ByteString -- ^ Secret key + -> ByteString -- ^ Message to MAC + -> HMAC a +hmac hashF blockSize secret msg = HMAC $ digestToByteString $ hashF $ B.append opad (digestToByteString $ 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 B.length secret > fromIntegral blockSize then digestToByteString (hashF secret) else secret + pad = B.replicate (fromIntegral blockSize - B.length kt) 0 diff --git a/Crypto/MAC/HMAC.hs b/Crypto/MAC/HMAC.hs --- a/Crypto/MAC/HMAC.hs +++ b/Crypto/MAC/HMAC.hs @@ -18,10 +18,10 @@ -- | 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' +hmac hashF blockSize secret msg = hashF $ B.append opad (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 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 hashF secret else secret + pad = B.replicate (fromIntegral blockSize - B.length kt) 0 diff --git a/Tests/KAT.hs b/Tests/KAT.hs --- a/Tests/KAT.hs +++ b/Tests/KAT.hs @@ -1,8 +1,11 @@ -import Test.HUnit +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} import Data.Char import Data.Bits import Data.Word +import Data.ByteString (ByteString) import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC import qualified Crypto.Hash.MD2 as MD2 import qualified Crypto.Hash.MD4 as MD4 import qualified Crypto.Hash.MD5 as MD5 @@ -19,7 +22,14 @@ import qualified Crypto.Hash.Skein512 as Skein512 import qualified Crypto.Hash.Whirlpool as Whirlpool import Crypto.Hash +import qualified Crypto.MAC.HMAC as HMAC +import Test.Framework (Test, defaultMain, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.Framework.Providers.HUnit +import Test.HUnit ((@=?)) + +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" @@ -161,6 +171,7 @@ hexaliseB :: B.ByteString -> B.ByteString hexaliseB = B.pack . hexalise . B.unpack +splitB :: Int -> ByteString -> [ByteString] splitB l b = if B.length b > l then @@ -175,36 +186,70 @@ runhash hash v = showHash $ (fctHash hash) $ v runhashinc hash v = showHash $ (fctInc hash) $ v -makeTestAlg (name, hash, results) = concatMap maketest $ zip3 [0..] vectors results +makeTestAlg (name, hash, results) = testGroup name $ concatMap maketest (zip3 [0..] vectors results) where - testname i = name ++ " " ++ show i - runtest v = runhash hash $ B.pack $ map (toEnum.fromEnum) v + runtest :: ByteString -> String + runtest v = runhash hash v - runtestinc i v = runhashinc hash $ splitB i $ B.pack $ map (toEnum.fromEnum) v + runtestinc :: Int -> ByteString -> String + runtestinc i v = runhashinc hash $ splitB i v maketest (i, v, r) = - [ 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) ] + [ testCase (show i ++ " one-pass") (r @=? runtest v) + , testCase (show i ++ " inc 1") (r @=? runtestinc 1 v) + , testCase (show i ++ " inc 2") (r @=? runtestinc 2 v) + , testCase (show i ++ " inc 3") (r @=? runtestinc 3 v) + , testCase (show i ++ " inc 4") (r @=? runtestinc 4 v) + , testCase (show i ++ " inc 5") (r @=? runtestinc 5 v) + , testCase (show i ++ " inc 9") (r @=? runtestinc 9 v) + , testCase (show i ++ " inc 16") (r @=? runtestinc 16 v) + ] -mapTests :: [Test] -mapTests = concatMap makeTestAlg results +katTests :: [Test] +katTests = map makeTestAlg results 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) + [ testCase "sha1 api" (runhash sha1Hash B.empty @=? show (hash B.empty :: Digest SHA1)) + , testCase "sha256 api" (runhash sha256Hash B.empty @=? show (hash B.empty :: Digest SHA256)) + , testCase "sha512 api" (runhash sha512Hash B.empty @=? show (hash B.empty :: Digest SHA512)) + , testCase "sha3-224 api" (runhash (sha3Hash 224) B.empty @=? show (hash B.empty :: Digest SHA3_224)) + , testCase "sha3-256 api" (runhash (sha3Hash 256) B.empty @=? show (hash B.empty :: Digest SHA3_256)) + , testCase "sha3-512 api" (runhash (sha3Hash 512) B.empty @=? show (hash B.empty :: Digest SHA3_512)) ] -tests = TestList (mapTests ++ apiTests) -main = runTestTT tests +data MACVector = MACVector { macKey :: ByteString + , macSecret :: ByteString + , macResult :: ByteString + } + +md5MACVectors = + [ MACVector B.empty B.empty "\x74\xe6\xf7\x29\x8a\x9c\x2d\x16\x89\x35\xf5\x8c\x00\x1b\xad\x88" + , MACVector "key" v1 "\x80\x07\x07\x13\x46\x3e\x77\x49\xb9\x0c\x2d\xc2\x49\x11\xe2\x75" + ] + +sha1MACVectors = + [ MACVector B.empty B.empty "\xfb\xdb\x1d\x1b\x18\xaa\x6c\x08\x32\x4b\x7d\x64\xb7\x1f\xb7\x63\x70\x69\x0e\x1d" + , MACVector "key" v1 "\xde\x7c\x9b\x85\xb8\xb7\x8a\xa6\xbc\x8a\x7a\x36\xf7\x0a\x90\x70\x1c\x9d\xb4\xd9" + ] + +sha256MACVectors = + [ MACVector B.empty B.empty "\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 "\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" + ] + +macTests :: [Test] +macTests = + [ testGroup "hmac-md5" $ map (toMACTest MD5.hash 64) $ zip [0..] md5MACVectors + , testGroup "hmac-sha1" $ map (toMACTest SHA1.hash 64) $ zip [0..] sha1MACVectors + , testGroup "hmac-sha256" $ map (toMACTest SHA256.hash 64) $ zip [0..] sha256MACVectors + ] + where toMACTest hashF blockSize (i, macVector) = + testCase (show i) (macResult macVector @=? HMAC.hmac hashF blockSize (macKey macVector) (macSecret macVector)) + +main = defaultMain + [ testGroup "KATs" katTests + , testGroup "API" apiTests + , testGroup "MACs" macTests + ] diff --git a/cryptohash.cabal b/cryptohash.cabal --- a/cryptohash.cabal +++ b/cryptohash.cabal @@ -1,5 +1,5 @@ Name: cryptohash -Version: 0.8.2 +Version: 0.8.3 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.