cleanup tests, and improve testing of hash algorithms
This commit is contained in:
parent
881d167cb5
commit
80b379c98d
@ -140,36 +140,29 @@ expected = [
|
||||
"28e361fe8c56e617caa56c28c7c36e5c13be552b77081be82b642f08bb7ef085b9a81910fe98269386b9aacfd2349076c9506126e198f6f6ad44c12017ca77b1" ])
|
||||
]
|
||||
|
||||
runhash :: HashAlg -> ByteString -> ByteString
|
||||
runhash (HashAlg hashAlg) v = B.convertToBase B.Base16 $ hashWith hashAlg $ v
|
||||
|
||||
runhashinc :: HashAlg -> [ByteString] -> ByteString
|
||||
runhashinc (HashAlg hashAlg) v = B.convertToBase B.Base16 $ hashinc $ v
|
||||
where hashinc = hashFinalize . foldl hashUpdate (hashInitWith hashAlg)
|
||||
|
||||
makeTestAlg (name, hashAlg, results) =
|
||||
testGroup name $ concatMap maketest (zip3 is vectors results)
|
||||
where
|
||||
runtest :: ByteString -> ByteString
|
||||
runtest v = runhash hashAlg v
|
||||
|
||||
is :: [Int]
|
||||
is = [0..]
|
||||
|
||||
runtestinc :: Int -> ByteString -> ByteString
|
||||
runtestinc i v = runhashinc hashAlg $ splitB i v
|
||||
is = [1..]
|
||||
|
||||
maketest (i, v, r) =
|
||||
[ 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)
|
||||
[ testCase (show i) (r @=? runhash hashAlg v)
|
||||
]
|
||||
|
||||
katTests :: [TestTree]
|
||||
katTests = map makeTestAlg expected
|
||||
makeTestChunk (hashName, hashAlg, _) =
|
||||
[ testProperty hashName $ \ckLen (ArbitraryBS0_2901 inp) ->
|
||||
runhash hashAlg inp `propertyEq` runhashinc hashAlg (chunkS ckLen inp)
|
||||
]
|
||||
|
||||
tests = testGroup "hash"
|
||||
[ testGroup "KATs" katTests
|
||||
[ testGroup "KATs" (map makeTestAlg expected)
|
||||
, testGroup "Chunking" (concatMap makeTestChunk expected)
|
||||
]
|
||||
|
||||
@ -24,22 +24,30 @@ import qualified KAT_TripleDES
|
||||
import qualified KAT_AFIS
|
||||
|
||||
tests = testGroup "cryptonite"
|
||||
[ ChaCha.tests
|
||||
, Salsa.tests
|
||||
, Hash.tests
|
||||
, Poly1305.tests
|
||||
, KAT_HMAC.tests
|
||||
[ Hash.tests
|
||||
, testGroup "MAC"
|
||||
[ Poly1305.tests
|
||||
, KAT_HMAC.tests
|
||||
]
|
||||
, KAT_Curve25519.tests
|
||||
, KAT_Ed25519.tests
|
||||
, KAT_PubKey.tests
|
||||
, KAT_PBKDF2.tests
|
||||
, KAT_Scrypt.tests
|
||||
, KAT_AES.tests
|
||||
, KAT_Blowfish.tests
|
||||
, KAT_Camellia.tests
|
||||
, KAT_DES.tests
|
||||
, KAT_TripleDES.tests
|
||||
, KAT_RC4.tests
|
||||
, testGroup "KDF"
|
||||
[ KAT_PBKDF2.tests
|
||||
, KAT_Scrypt.tests
|
||||
]
|
||||
, testGroup "block-cipher"
|
||||
[ KAT_AES.tests
|
||||
, KAT_Blowfish.tests
|
||||
, KAT_Camellia.tests
|
||||
, KAT_DES.tests
|
||||
, KAT_TripleDES.tests
|
||||
]
|
||||
, testGroup "stream-cipher"
|
||||
[ KAT_RC4.tests
|
||||
, ChaCha.tests
|
||||
, Salsa.tests
|
||||
]
|
||||
, KAT_AFIS.tests
|
||||
]
|
||||
|
||||
|
||||
@ -14,6 +14,12 @@ newtype ChunkingLen = ChunkingLen [Int]
|
||||
instance Arbitrary ChunkingLen where
|
||||
arbitrary = ChunkingLen `fmap` replicateM 16 (choose (0,14))
|
||||
|
||||
newtype ArbitraryBS0_2901 = ArbitraryBS0_2901 ByteString
|
||||
deriving (Show,Eq,Ord)
|
||||
|
||||
instance Arbitrary ArbitraryBS0_2901 where
|
||||
arbitrary = ArbitraryBS0_2901 `fmap` arbitraryBSof 0 2901
|
||||
|
||||
arbitraryBS :: Int -> Gen ByteString
|
||||
arbitraryBS n = B.pack `fmap` replicateM n arbitrary
|
||||
|
||||
@ -65,3 +71,6 @@ assertBytesEq b1 b2 | b1 /= b2 = error ("expected: " ++ show b1 ++ " got: " ++
|
||||
assertEq :: (Show a, Eq a) => a -> a -> Bool
|
||||
assertEq b1 b2 | b1 /= b2 = error ("expected: " ++ show b1 ++ " got: " ++ show b2)
|
||||
| otherwise = True
|
||||
|
||||
propertyEq :: (Show a, Eq a) => a -> a -> Bool
|
||||
propertyEq = assertEq
|
||||
|
||||
Loading…
Reference in New Issue
Block a user