cryptohash-sha512-0.11.102.0: src-tests/test-sha512t.hs
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as BL
-- implementation under test
import qualified Crypto.Hash.SHA512t as IUT
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
vectors :: Int -> [ByteString]
vectors 224 =
[ ""
, "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
]
vectors 256 = vectors 224
vectors 100 = [ "", "a" ]
vectors 128 = [ "", "a" ]
vectors 160 = [ "", "a" ]
vectors 192 = [ "", "a" ]
vectors _ = undefined
answers :: Int -> [ByteString]
answers 224 = map (B.filter (/= 0x20))
[ "6ed0dd02806fa89e25de060c19d3ac86cabb87d6a0ddd05c333b84f4"
, "944cd2847fb54558d4775db0485a50003111c8e5daa63fe722c6aa37"
, "2b9d6565a7e40f780ba8ab7c8dcf41e3ed3b77997f4c55aa987eede5"
, "4634270f707b6a54daae7530460842e20e37ed265ceee9a43e8924aa"
, "e5302d6d54bb242275d1e7622d68df6eb02dedd13f564c13dbda2174"
, "23fec5bb94d60b23308192640b0c453335d664734fe40e7268674af9"
, "37ab331d76f0d36de422bd0edeb22a28accd487b7a8453ae965dd287"
]
answers 256 = map (B.filter (/= 0x20))
[ "c672b8d1ef56ed28ab87c3622c5114069bdd3ad7b8f9737498d0c01ecef0967a"
, "dd9d67b371519c339ed8dbd25af90e976a1eeefd4ad3d889005e532fc5bef04d"
, "cc8d255a7f2f38fd50388fd1f65ea7910835c5c1e73da46fba01ea50d5dd76fb"
, "53048e2681941ef99b2e29b76b4c7dabe4c2d0c634fc6d46e0e2f13107e7af23"
, "bde8e1f9f19bb9fd3406c90ec6bc47bd36d8ada9f11880dbc8a22a7078b6a461"
, "3928e184fb8690f840da3988121d31be65cb9d3ef83ee6146feac861e19b563a"
, "9a59a052930187a97038cae692f30708aa6491923ef5194394dc68d56c74fb21"
]
answers 100 = map (B.filter (/= 0x20))
[ "c00f7e9998dd8ee623557a8490"
, "12ed51ef9eec8c369a200b6c50"
]
answers 128 = map (B.filter (/= 0x20))
[ "deca5d803a5cfcbf4191e9fc4bc065e3"
, "81dc223475633e08da618cca7053d145"
]
answers 160 = map (B.filter (/= 0x20))
[ "4cc04bc7087617e98d7da7443d79fb481cf169bf"
, "ffa50d50f314aa7f53e3a215e5789508c2342135"
]
answers 192 = map (B.filter (/= 0x20))
[ "9896f27c73cdc4ecc8eca3e16f6eeb63afe04b6c0d39276c"
, "08ce8ab4f3bbc3acc1959cd62527b63b4359a54012e167a5"
]
answers _ = undefined
ansXLTest :: Int -> ByteString
ansXLTest 224 = B.filter (/= 0x20) "9a7f86727c3be1403d6702617646b15589b8c5a92c70f1703cd25b52"
ansXLTest 256 = B.filter (/= 0x20) "b5855a6179802ce567cbf43888284c6ac7c3f6c48b08c5bc1e8ad75d12782c9e"
ansXLTest _ = ""
katTests :: Int -> [TestTree]
katTests t
| length (vectors t) == length (answers t) = map makeTest (zip3 [1::Int ..] (vectors t) (answers t)) ++
(if B.null (ansXLTest t) then [] else [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 t
runTest' :: ByteString -> ByteString
runTest' = B16.encode . IUT.finalize . IUT.start t
runTestInc :: Int -> ByteString -> ByteString
runTestInc i = B16.encode . IUT.finalize . myfoldl' IUT.update (IUT.init t) . splitB i
runTestLazy :: Int -> ByteString -> ByteString
runTestLazy i = B16.encode . IUT.hashlazy t . BL.fromChunks . splitB i
runTestLazy' :: Int -> ByteString -> ByteString
runTestLazy' i = B16.encode . IUT.finalize . IUT.startlazy t . BL.fromChunks . splitB i
-- force unaligned md5-blocks
runTestLazyU :: Int -> ByteString -> ByteString
runTestLazyU i = B16.encode . IUT.hashlazy t . BL.fromChunks . map B.copy . splitB i
runTestLazyU' :: Int -> ByteString -> ByteString
runTestLazyU' i = B16.encode . IUT.finalize . IUT.startlazy t . BL.fromChunks . map B.copy . splitB i
----
xltest = testGroup "XL-vec"
[ testCase "inc" (ansXLTest t @=? (B16.encode . IUT.hashlazy t) vecXL) ]
where
vecXL = BL.fromChunks (replicate 16777216 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno")
xltest' = testGroup "XL-vec'"
[ testCase "inc" (ansXLTest t @=? (B16.encode . IUT.finalize . IUT.startlazy t) 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 :: Int -> [(ByteString,ByteString,ByteString)]
rfc4231Vectors t = case t of -- (secrect,msg,mac)
224 -> [ (rep 20 0x0b, "Hi There", x"b244ba01307c0e7a8ccaad13b1067a4cf6b961fe0c6a20bda3d92039")
, ("Jefe", "what do ya want for nothing?", x"4a530b31a79ebcce36916546317c45f247d83241dfb818fd37254bde")
, (rep 20 0xaa, rep 50 0xdd, x"db34ea525c2c216ee5a6ccb6608bea870bbef12fd9b96a5109e2b6fc")
, (B.pack [1..25], rep 50 0xcd, x"c2391863cda465c6828af06ac5d4b72d0b792109952da530e11a0d26")
, (rep 20 0x0c, "Test With Truncation", x"1df8eae8baeedd4eddfb555ec0ba768f4b5ba29e9e3d55f08303120f")
, (rep 131 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"29bef8ce88b54d4226c3c7718ea9e32ace2429026f089e38cea9aeda")
, (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"82a9619b47af0cea73a8b9741355ce902d807ad87ee9078522a246e1")
]
256 -> [ (rep 20 0x0b, "Hi There", x"9f9126c3d9c3c330d760425ca8a217e31feae31bfe70196ff81642b868402eab")
, ("Jefe", "what do ya want for nothing?", x"6df7b24630d5ccb2ee335407081a87188c221489768fa2020513b2d593359456")
, (rep 20 0xaa, rep 50 0xdd, x"229006391d66c8ecddf43ba5cf8f83530ef221a4e9401840d1bead5137c8a2ea")
, (B.pack [1..25], rep 50 0xcd, x"36d60c8aa1d0be856e10804cf836e821e8733cbafeae87630589fd0b9b0a2f4c")
, (rep 20 0x0c, "Test With Truncation", x"337f526924766971bf72b82ad19c2c825301791e3ae2d8bb4ec03817dd821f46")
, (rep 131 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"87123c45f7c537a404f8f47cdbedda1fc9bec60eeb971982ce7ef10e774e6539")
, (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"6ea83f8e7315072c0bdaa33b93a26fc1659974637a9db8a887d06c05a7f35a66")
]
_ -> []
where
x = B16.decodeLenient
rep n c = B.replicate n c
rfc4231Tests :: Int -> [TestTree]
rfc4231Tests t = zipWith makeTest [1::Int ..] (rfc4231Vectors t)
where
makeTest i (key, msg, mac) = testGroup ("vec"++show i) $
[ testCase "hmac" (hex mac @=? hex (IUT.hmac t key msg))
, testCase "hmaclazy" (hex mac @=? hex (IUT.hmaclazy t 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)++"}"
main :: IO ()
main = defaultMain $ testGroup "cryptohash-sha512t"
[ testGroup "SHA512/224"
[ testGroup "KATs" (katTests 224)
, testGroup "RFC4231" (rfc4231Tests 224)
]
, testGroup "SHA512/256"
[ testGroup "KATs" (katTests 256)
, testGroup "RFC4231" (rfc4231Tests 256)
]
, testGroup "SHA512/100" [ testGroup "KATs" (katTests 100) ]
, testGroup "SHA512/128" [ testGroup "KATs" (katTests 128) ]
, testGroup "SHA512/160" [ testGroup "KATs" (katTests 160) ]
, testGroup "SHA512/192" [ testGroup "KATs" (katTests 192) ]
]