cryptohash-sha512-0.11.102.0: src-tests/test-sha384.hs
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Data.Word (Word64)
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.SHA384 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))
[ "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b"
, "ca737f1014a48f4c0b6dd43cb177b0afd9e5169367544c494011e3317dbf9a509cb1e5dc1e85a941bbee3d7f2afbc9b1"
, "098cea620b0978caa5f0befba6ddcf22764bea977e1c70b3483edfdf1de25f4b40d6cea3cadf00f809d422feb1f0161b"
, "cb00753f45a35e8bb5a03d699ac65007272c32ab0eded1631a8b605a43ff5bed8086072ba1e7cc2358baeca134c825a7"
, "3391fdddfc8dc7393707a65b1b4709397cf8b1d162af05abfe8f450de5f36bc6b0455a8520bc4e6f5fe95b1fe3c8452b"
, "09330c33f71147e83d192fc782cd1b4753111b173b3b05d22fa08086e3b0f712fcc7c71a557e2db966c3e9fa91746039"
, "9d0e1809716474cb086e834e310a4a1ced149e9c00f248527972cec5704c2a5b07b8b3dc38ecc4ebae97ddd87f3d8985"
]
ansXLTest :: ByteString
ansXLTest = B.filter (/= 0x20)
"5441235cc0235341ed806a64fb354742b5e5c02a3c5cb71b5f63fb793458d8fdae599c8cd8884943c04f11b31b89f023"
katTests :: [TestTree]
katTests
| length vectors == length answers = map makeTest (zip3 [1::Int ..] vectors answers) ++ [xltest,xltest']
| otherwise = error "vectors/answers length mismatch"
where
makeTest (i, v, r) = testGroup ("vec"++show i) $
[ testCase "one-pass" (r @=? runTest v)
, 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-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 ] ++
[ 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
runTest' :: ByteString -> ByteString
runTest' = B16.encode . IUT.finalize . IUT.start
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
runTestLazy' :: Int -> ByteString -> ByteString
runTestLazy' i = B16.encode . IUT.finalize . IUT.startlazy . 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
runTestLazyU' :: Int -> ByteString -> ByteString
runTestLazyU' i = B16.encode . IUT.finalize . IUT.startlazy . 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")
xltest' = testGroup "XL-vec'"
[ testCase "inc" (ansXLTest @=? (B16.encode . IUT.finalize . IUT.startlazy) 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"afd03944d84895626b0825f4ab46907f15f9dadbe4101ec682aa034c7cebc59cfaea9ea9076ede7f4af152e8b2fa9cb6")
, ("Jefe", "what do ya want for nothing?", x"af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649")
, (rep 20 0xaa, rep 50 0xdd, x"88062608d3e6ad8a0aa2ace014c8a86f0aa635d947ac9febe83ef4e55966144b2a5ab39dc13814b94e3ab6e101a34f27")
, (B.pack [1..25], rep 50 0xcd, x"3e8a69b7783c25851933ab6290af6ca77a9981480850009cc5577c6e1f573b4e6801dd23c4a7d679ccf8a386c674cffb")
, (rep 20 0x0c, "Test With Truncation", x"3abf34c3503b2a23a46efc619baef897f4c8e42c934ce55ccbae9740fcbc1af4ca62269e2a37cd88ba926341efe4aeea")
, (rep 131 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"4ece084485813e9088d2c63a041bc5b44f9ef1012a2b588f3cd11f05033ac4c60c2ef6ab4030fe8296248df163f44952")
, (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"6617178e941f020d351e2f254e8fd32c602420feb0b8fb9adccebb82461e99c5a678cc31e799176d3860e6110c46523e")
]
where
x = B16.decodeLenient
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 "start" prop_start
, testProperty "hashlazy" prop_hashlazy
, testProperty "startlazy" prop_startlazy
, testProperty "hashlazyAndLength" prop_hashlazyAndLength
, testProperty "hmac" prop_hmac
, testProperty "hmaclazy" prop_hmaclazy
, testProperty "hmaclazyAndLength" prop_hmaclazyAndLength
]
where
prop_hash (RandBS bs)
= ref_hash bs == IUT.hash bs
prop_start (RandBS bs)
= ref_hash bs == (IUT.finalize $ IUT.start bs)
prop_hashlazy (RandLBS bs)
= ref_hashlazy bs == IUT.hashlazy bs
prop_hashlazyAndLength (RandLBS bs)
= ref_hashlazyAndLength bs == IUT.hashlazyAndLength bs
prop_startlazy (RandLBS bs)
= ref_hashlazy bs == (IUT.finalize $ IUT.startlazy 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
prop_hmaclazyAndLength (RandBS k) (RandLBS bs)
= ref_hmaclazyAndLength k bs == IUT.hmaclazyAndLength k bs
ref_hash :: ByteString -> ByteString
ref_hash = ref_hashlazy . fromStrict
ref_hashlazy :: BL.ByteString -> ByteString
ref_hashlazy = toStrict . REF.bytestringDigest . REF.sha384
ref_hashlazyAndLength :: BL.ByteString -> (ByteString,Word64)
ref_hashlazyAndLength x = (ref_hashlazy x, fromIntegral (BL.length x))
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.hmacSha384 (fromStrict secret)
ref_hmaclazyAndLength :: ByteString -> BL.ByteString -> (ByteString,Word64)
ref_hmaclazyAndLength secret msg = (ref_hmaclazy secret msg, fromIntegral (BL.length msg))
-- toStrict/fromStrict only available with bytestring-0.10 and later
toStrict = B.concat . BL.toChunks
fromStrict = BL.fromChunks . (:[])
main :: IO ()
main = defaultMain $ testGroup "cryptohash-sha384"
[ testGroup "KATs" katTests
, testGroup "RFC4231" rfc4231Tests
, testGroup "REF" refImplTests
]