cryptohash-sha512-0.11.100.1: src-tests/test-sha512.hs
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Base16 as B16
-- reference implementation
import qualified Data.Digest.Pure.SHA as REF
-- implementation under test
import qualified Crypto.Hash.SHA512 as IUT
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
vectors :: [ByteString]
vectors =
[ ""
, "The quick brown fox jumps over the lazy dog"
, "The quick brown fox jumps over the lazy cog"
, "abc"
, "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
, "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"
, B.replicate 1000000 0x61
]
answers :: [ByteString]
answers = map (B.filter (/= 0x20))
[ "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e"
, "07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6"
, "3eeee1d0e11733ef152a6c29503b3ae20c4f1f3cda4cb26f1bc1a41f91c7fe4ab3bd86494049e201c4bd5155f31ecb7a3c8606843c4cc8dfcab7da11c8ae5045"
, "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f"
, "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445"
, "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909"
, "e718483d0ce769644e2e42c7bc15b4638e1f98b13b2044285632a803afa973ebde0ff244877ea60a4cb0432ce577c31beb009c5c2c49aa2e4eadb217ad8cc09b"
]
ansXLTest :: ByteString
ansXLTest = B.filter (/= 0x20)
"b47c933421ea2db149ad6e10fce6c7f93d0752380180ffd7f4629a712134831d77be6091b819ed352c2967a2e2d4fa5050723c9630691f1a05a7281dbe6c1086"
katTests :: [TestTree]
katTests
| length vectors == length answers = map makeTest (zip3 [1::Int ..] vectors answers) ++ [xltest]
| otherwise = error "vectors/answers length mismatch"
where
makeTest (i, v, r) = testGroup ("vec"++show i) $
[ testCase "one-pass" (r @=? runTest v)
, testCase "inc-1" (r @=? runTestInc 1 v)
, testCase "inc-2" (r @=? runTestInc 2 v)
, testCase "inc-3" (r @=? runTestInc 3 v)
, testCase "inc-4" (r @=? runTestInc 4 v)
, testCase "inc-5" (r @=? runTestInc 5 v)
, testCase "inc-7" (r @=? runTestInc 7 v)
, testCase "inc-8" (r @=? runTestInc 8 v)
, testCase "inc-9" (r @=? runTestInc 9 v)
, testCase "inc-16" (r @=? runTestInc 16 v)
, testCase "lazy-1" (r @=? runTestLazy 1 v)
, testCase "lazy-2" (r @=? runTestLazy 2 v)
, testCase "lazy-7" (r @=? runTestLazy 7 v)
, testCase "lazy-8" (r @=? runTestLazy 8 v)
, testCase "lazy-16" (r @=? runTestLazy 16 v)
] ++
[ testCase "lazy-63u" (r @=? runTestLazyU 63 v) | B.length v > 63 ] ++
[ testCase "lazy-65u" (r @=? runTestLazyU 65 v) | B.length v > 65 ] ++
[ testCase "lazy-97u" (r @=? runTestLazyU 97 v) | B.length v > 97 ] ++
[ testCase "lazy-131u" (r @=? runTestLazyU 131 v) | B.length v > 131 ]
runTest :: ByteString -> ByteString
runTest = B16.encode . IUT.hash
runTestInc :: Int -> ByteString -> ByteString
runTestInc i = B16.encode . IUT.finalize . myfoldl' IUT.update IUT.init . splitB i
runTestLazy :: Int -> ByteString -> ByteString
runTestLazy i = B16.encode . IUT.hashlazy . BL.fromChunks . splitB i
-- force unaligned md5-blocks
runTestLazyU :: Int -> ByteString -> ByteString
runTestLazyU i = B16.encode . IUT.hashlazy . BL.fromChunks . map B.copy . splitB i
----
xltest = testGroup "XL-vec"
[ testCase "inc" (ansXLTest @=? (B16.encode . IUT.hashlazy) vecXL) ]
where
vecXL = BL.fromChunks (replicate 16777216 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno")
splitB :: Int -> ByteString -> [ByteString]
splitB l b
| B.length b > l = b1 : splitB l b2
| otherwise = [b]
where
(b1, b2) = B.splitAt l b
rfc4231Vectors :: [(ByteString,ByteString,ByteString)]
rfc4231Vectors = -- (secrect,msg,mac)
[ (rep 20 0x0b, "Hi There", x"87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854")
, ("Jefe", "what do ya want for nothing?", x"164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737")
, (rep 20 0xaa, rep 50 0xdd, x"fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb")
, (B.pack [1..25], rep 50 0xcd, x"b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd")
, (rep 20 0x0c, "Test With Truncation", x"415fad6271580a531d4179bc891d87a650188707922a4fbb36663a1eb16da008711c5b50ddd0fc235084eb9d3364a1454fb2ef67cd1d29fe6773068ea266e96b")
, (rep 131 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598")
, (rep 131 0xaa, "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm.", x"e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58")
]
where
x = fst.B16.decode
rep n c = B.replicate n c
rfc4231Tests :: [TestTree]
rfc4231Tests = zipWith makeTest [1::Int ..] rfc4231Vectors
where
makeTest i (key, msg, mac) = testGroup ("vec"++show i) $
[ testCase "hmac" (hex mac @=? hex (IUT.hmac key msg))
, testCase "hmaclazy" (hex mac @=? hex (IUT.hmaclazy key lazymsg))
]
where
lazymsg = BL.fromChunks . splitB 1 $ msg
hex = B16.encode
-- define own 'foldl' here to avoid RULE rewriting to 'hashlazy'
myfoldl' :: (b -> a -> b) -> b -> [a] -> b
myfoldl' f z0 xs0 = lgo z0 xs0
where
lgo z [] = z
lgo z (x:xs) = let z' = f z x
in z' `seq` lgo z' xs
newtype RandBS = RandBS { unRandBS :: ByteString }
newtype RandLBS = RandLBS BL.ByteString
instance Arbitrary RandBS where
arbitrary = fmap (RandBS . B.pack) arbitrary
shrink (RandBS x) = fmap RandBS (go x)
where
go bs = zipWith B.append (B.inits bs) (tail $ B.tails bs)
instance Show RandBS where
show (RandBS x) = "RandBS {len=" ++ show (B.length x)++"}"
instance Arbitrary RandLBS where
arbitrary = fmap (RandLBS . BL.fromChunks . map unRandBS) arbitrary
instance Show RandLBS where
show (RandLBS x) = "RandLBS {len=" ++ show (BL.length x) ++ ", chunks=" ++ show (length $ BL.toChunks x)++"}"
refImplTests :: [TestTree]
refImplTests =
[ testProperty "hash" prop_hash
, testProperty "hashlazy" prop_hashlazy
, testProperty "hmac" prop_hmac
, testProperty "hmaclazy" prop_hmaclazy
]
where
prop_hash (RandBS bs)
= ref_hash bs == IUT.hash bs
prop_hashlazy (RandLBS bs)
= ref_hashlazy bs == IUT.hashlazy bs
prop_hmac (RandBS k) (RandBS bs)
= ref_hmac k bs == IUT.hmac k bs
prop_hmaclazy (RandBS k) (RandLBS bs)
= ref_hmaclazy k bs == IUT.hmaclazy k bs
ref_hash :: ByteString -> ByteString
ref_hash = ref_hashlazy . fromStrict
ref_hashlazy :: BL.ByteString -> ByteString
ref_hashlazy = toStrict . REF.bytestringDigest . REF.sha512
ref_hmac :: ByteString -> ByteString -> ByteString
ref_hmac secret = ref_hmaclazy secret . fromStrict
ref_hmaclazy :: ByteString -> BL.ByteString -> ByteString
ref_hmaclazy secret = toStrict . REF.bytestringDigest . REF.hmacSha512 (fromStrict secret)
-- toStrict/fromStrict only available with bytestring-0.10 and later
toStrict = B.concat . BL.toChunks
fromStrict = BL.fromChunks . (:[])
main :: IO ()
main = defaultMain $ testGroup "cryptohash-sha512"
[ testGroup "KATs" katTests
, testGroup "RFC4231" rfc4231Tests
, testGroup "REF" refImplTests
]