Ciphers.hs

import Test.Framework (defaultMain, testGroup, Test(..))
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck (Gen(..), choose, label, conjoin)

import Crypto.Nettle.Ciphers
import Crypto.Cipher.Types

import qualified Data.ByteString as B
import Data.Word (Word8)
import qualified Numeric as N
import Data.Maybe (fromJust)

import Ciphers.PropertyTests
import Ciphers.Utils
import KAT.AES
import KAT.SM4
import KAT.Utils

genBlockTest :: BlockCipher c => c -> Test
genBlockTest = genBlockTest' . genCipher

genBlockTest' :: BlockCipher c => Gen c -> Test
genBlockTest' = go undefined where
	go :: BlockCipher c => c -> Gen c -> Test
	go c' genci = testProperty ("generated " ++ cipherName c' ++ " block cipher test") $ do
		c <- genci
		iv <- genIV c
		block1 <- genBlockCipherInput c 1
		block10 <- genBlockCipherInput c 10
		input <- choose (1, B.length block10) >>= genByteString
		return $ conjoin
			[ label "ecbEncrypt + ecbDecrypt 1 block"   $ (ecbDecrypt c    . ecbEncrypt c   ) block1  == block1
			, label "ecbDecrypt + ecbEncrypt 1 block"   $ (ecbEncrypt c    . ecbDecrypt c   ) block1  == block1
			, label "ecbEncrypt + ecbDecrypt 10 blocks" $ (ecbDecrypt c    . ecbEncrypt c   ) block10 == block10
			, label "ecbDecrypt + ecbEncrypt 10 blocks" $ (ecbEncrypt c    . ecbDecrypt c   ) block10 == block10
			, label "cbcEncrypt + cbcDecrypt 1 block"   $ (cbcDecrypt c iv . cbcEncrypt c iv) block1  == block1
			, label "cbcDecrypt + cbcEncrypt 1 block"   $ (cbcEncrypt c iv . cbcDecrypt c iv) block1  == block1
			, label "cbcEncrypt + cbcDecrypt 10 blocks" $ (cbcDecrypt c iv . cbcEncrypt c iv) block10 == block10
			, label "cbcDecrypt + cbcEncrypt 10 blocks" $ (cbcEncrypt c iv . cbcDecrypt c iv) block10 == block10
			, label "cfbEncrypt + cfbDecrypt 1 block"   $ (cfbDecrypt c iv . cfbEncrypt c iv) block1  == block1
			, label "cfbDecrypt + cfbEncrypt 1 block"   $ (cfbEncrypt c iv . cfbDecrypt c iv) block1  == block1
			, label "cfbEncrypt + cfbDecrypt 10 blocks" $ (cfbDecrypt c iv . cfbEncrypt c iv) block10 == block10
			, label "cfbDecrypt + cfbEncrypt 10 blocks" $ (cfbEncrypt c iv . cfbDecrypt c iv) block10 == block10
			, label "ctrCombine + ctrCombine 1 block"   $ (ctrCombine c iv . ctrCombine c iv) block1  == block1
			, label "ctrCombine + ctrCombine 10 blocks" $ (ctrCombine c iv . ctrCombine c iv) block10 == block10
			, label "ctrCombine + ctrCombine unaligned" $ (ctrCombine c iv . ctrCombine c iv) input   == input
			]

{-# ANN module "HLint: ignore Reduce duplication" #-}
genStreamTest :: StreamCipher c => c -> Test
genStreamTest c' = testProperty ("generated " ++ cipherName c' ++ " stream cipher test") $ do
	c <- genCipher c'
	let run i = fst $ streamCombine c i
	let run2 (i1, i2) = fst $ let (o1, c') = streamCombine c i1; (o2, c'') = streamCombine c' i2 in (B.append o1 o2, c'')
	input1 <- choose (1, 256) >>= genByteString
	input2 <- choose (1, 256) >>= genByteString
	return $ conjoin
		[ label "streamCombine one block" $ run (run input1) == input1
		, label "streamCombine two blocks" $ run (run2 (input1, input2)) == B.append input1 input2
		]

genStreamNonceTest :: StreamNonceCipher c => c -> Test
genStreamNonceTest c' = testProperty ("generated " ++ cipherName c' ++ " stream cipher with nonce test") $ do
	c'' <- genCipher c'
	nonce <- genKey' (streamNonceSize c')
	let c = fromJust $ streamSetNonce c'' nonce
	let run i = fst $ streamCombine c i
	let run2 (i1, i2) = fst $ let (o1, c') = streamCombine c i1; (o2, c'') = streamCombine c' i2 in (B.append o1 o2, c'')
	input1 <- choose (1, 256) >>= genByteString
	input2 <- choose (1, 256) >>= genByteString
	return $ conjoin
		[ label "streamCombine one block with nonce" $ run (run input1) == input1
		, label "streamCombine two blocks with nonce" $ run (run2 (input1, input2)) == B.append input1 input2
		]

genStreamNonceWord64Test :: StreamNonceCipher c => c -> Test
genStreamNonceWord64Test c' = testProperty ("generated " ++ cipherName c' ++ " stream cipher with word64 nonce test") $ do
	c'' <- genCipher c'
	nonce <- choose (minBound,maxBound)
	let c = fromJust $ streamSetNonceWord64 c'' nonce
	let run i = fst $ streamCombine c i
	let run2 (i1, i2) = fst $ let (o1, c') = streamCombine c i1; (o2, c'') = streamCombine c' i2 in (B.append o1 o2, c'')
	input1 <- choose (1, 256) >>= genByteString
	input2 <- choose (1, 256) >>= genByteString
	return $ conjoin
		[ label "streamCombine one block with Word64 nonce" $ run (run input1) == input1
		, label "streamCombine two blocks with Word64 nonce" $ run (run2 (input1, input2)) == B.append input1 input2
		]

genArctwoInitEKB :: Gen ARCTWO
genArctwoInitEKB = do
	k <- genKey (undefined :: ARCTWO)
	ekb <- choose (0, 1024)
	return $ runCryptoFailable $ arctwoInitEKB k ekb

genArctwoInitGutmann :: Gen ARCTWO
genArctwoInitGutmann = do
	k <- genKey (undefined :: ARCTWO)
	return $ runCryptoFailable $ arctwoInitGutmann k

main = defaultMain
-- own KATs + generated tests (from crypto-cipher-tests)
	[ testBlockCipher katAES      (undefined :: AES)
	, testBlockCipher katAES128   (undefined :: AES128)
	, testBlockCipher katAES192   (undefined :: AES192)
	, testBlockCipher katAES256   (undefined :: AES256)
	, testBlockCipher defaultKATs (undefined :: ARCTWO)
	, testBlockCipher defaultKATs (undefined :: BLOWFISH)
	, testBlockCipher defaultKATs (undefined :: Camellia)
	, testBlockCipher defaultKATs (undefined :: Camellia128)
	, testBlockCipher defaultKATs (undefined :: Camellia192)
	, testBlockCipher defaultKATs (undefined :: Camellia256)
	, testBlockCipher defaultKATs (undefined :: CAST128)
	, testBlockCipher defaultKATs (undefined :: DES)
	, testBlockCipher defaultKATs (undefined :: DES_EDE3)
	, testBlockCipher defaultKATs (undefined :: TWOFISH)
	, testBlockCipher defaultKATs (undefined :: SERPENT)
	, testBlockCipher katSM4 (undefined :: SM4)
	, testStreamCipher defaultStreamKATs (undefined :: ARCFOUR)
	, testStreamCipher defaultStreamKATs (undefined :: CHACHA)
	, testStreamCipher defaultStreamKATs (undefined :: SALSA20)
	, testStreamCipher defaultStreamKATs (undefined :: ESTREAM_SALSA20)

-- more generated tests: these checks just make sure the api isn't broken horribly
	, genBlockTest (undefined :: AES)
	, genBlockTest (undefined :: AES128)
	, genBlockTest (undefined :: AES192)
	, genBlockTest (undefined :: AES256)
	, genBlockTest (undefined :: ARCTWO)
	, genBlockTest' genArctwoInitEKB
	, genBlockTest' genArctwoInitGutmann
	, genBlockTest (undefined :: BLOWFISH)
	, genBlockTest (undefined :: Camellia)
	, genBlockTest (undefined :: Camellia128)
	, genBlockTest (undefined :: Camellia192)
	, genBlockTest (undefined :: Camellia256)
	, genBlockTest (undefined :: CAST128)
	, genBlockTest (undefined :: DES)
	, genBlockTest (undefined :: DES_EDE3)
	, genBlockTest (undefined :: TWOFISH)
	, genBlockTest (undefined :: SERPENT)
	, genBlockTest (undefined :: SM4)
	, genStreamTest (undefined :: ARCFOUR)
	, genStreamTest (undefined :: CHACHA)
	, genStreamTest (undefined :: SALSA20)
	, genStreamTest (undefined :: ESTREAM_SALSA20)
	, genStreamNonceTest (undefined :: CHACHA)
	, genStreamNonceTest (undefined :: SALSA20)
	, genStreamNonceTest (undefined :: ESTREAM_SALSA20)
	, genStreamNonceWord64Test (undefined :: CHACHA)
	, genStreamNonceWord64Test (undefined :: SALSA20)
	, genStreamNonceWord64Test (undefined :: ESTREAM_SALSA20)
	]