1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488
|
{-# LANGUAGE ViewPatterns #-}
module BlockCipher
( KAT_ECB(..)
, KAT_CBC(..)
, KAT_CFB(..)
, KAT_CTR(..)
, KAT_XTS(..)
, KAT_AEAD(..)
, KATs(..)
, defaultKATs
, testBlockCipher
, CipherInfo
) where
import Imports
import Data.Maybe
import Crypto.Error
import Crypto.Cipher.Types
import Data.ByteArray as B hiding (pack, null, length)
import qualified Data.ByteString as B hiding (all, take, replicate)
------------------------------------------------------------------------
-- KAT
------------------------------------------------------------------------
type BlockSize = Int
type KeySize = Int
type CipherInfo a = (BlockSize, KeySize, ByteString -> a)
instance Show (IV c) where
show _ = "IV"
-- | ECB KAT
data KAT_ECB = KAT_ECB
{ ecbKey :: ByteString -- ^ Key
, ecbPlaintext :: ByteString -- ^ Plaintext
, ecbCiphertext :: ByteString -- ^ Ciphertext
} deriving (Show,Eq)
-- | CBC KAT
data KAT_CBC = KAT_CBC
{ cbcKey :: ByteString -- ^ Key
, cbcIV :: ByteString -- ^ IV
, cbcPlaintext :: ByteString -- ^ Plaintext
, cbcCiphertext :: ByteString -- ^ Ciphertext
} deriving (Show,Eq)
-- | CFB KAT
data KAT_CFB = KAT_CFB
{ cfbKey :: ByteString -- ^ Key
, cfbIV :: ByteString -- ^ IV
, cfbPlaintext :: ByteString -- ^ Plaintext
, cfbCiphertext :: ByteString -- ^ Ciphertext
} deriving (Show,Eq)
-- | CTR KAT
data KAT_CTR = KAT_CTR
{ ctrKey :: ByteString -- ^ Key
, ctrIV :: ByteString -- ^ IV (usually represented as a 128 bits integer)
, ctrPlaintext :: ByteString -- ^ Plaintext
, ctrCiphertext :: ByteString -- ^ Ciphertext
} deriving (Show,Eq)
-- | XTS KAT
data KAT_XTS = KAT_XTS
{ xtsKey1 :: ByteString -- ^ 1st XTS key
, xtsKey2 :: ByteString -- ^ 2nd XTS key
, xtsIV :: ByteString -- ^ XTS IV
, xtsPlaintext :: ByteString -- ^ plaintext
, xtsCiphertext :: ByteString -- ^ Ciphertext
} deriving (Show,Eq)
-- | AEAD KAT
data KAT_AEAD = KAT_AEAD
{ aeadMode :: AEADMode
, aeadKey :: ByteString -- ^ Key
, aeadIV :: ByteString -- ^ IV for initialization
, aeadHeader :: ByteString -- ^ Authenticated Header
, aeadPlaintext :: ByteString -- ^ Plaintext
, aeadCiphertext :: ByteString -- ^ Ciphertext
, aeadTaglen :: Int -- ^ aead tag len
, aeadTag :: ByteString -- ^ expected tag
} deriving (Show,Eq)
-- | all the KATs. use defaultKATs to prevent compilation error
-- from future expansion of this data structure
data KATs = KATs
{ kat_ECB :: [KAT_ECB]
, kat_CBC :: [KAT_CBC]
, kat_CFB :: [KAT_CFB]
, kat_CTR :: [KAT_CTR]
, kat_XTS :: [KAT_XTS]
, kat_AEAD :: [KAT_AEAD]
} deriving (Show,Eq)
defaultKATs = KATs [] [] [] [] [] []
{-
testECB (_, _, cipherInit) ecbEncrypt ecbDecrypt kats =
testGroup "ECB" (concatMap katTest (zip is kats) {- ++ propTests-})
where katTest (i,d) =
[ testCase ("E" ++ show i) (ecbEncrypt ctx (ecbPlaintext d) @?= ecbCiphertext d)
, testCase ("D" ++ show i) (ecbDecrypt ctx (ecbCiphertext d) @?= ecbPlaintext d)
]
where ctx = cipherInit (ecbKey d)
--propTest = testProperty "decrypt.encrypt" (ECBUnit key plaintext) =
--testProperty_ECB (ECBUnit (cipherInit -> ctx) (toBytes -> plaintext)) =
-- plaintext `assertEq` ecbDecrypt ctx (ecbEncrypt ctx plaintext)
testKatCBC cbcInit cbcEncrypt cbcDecrypt (i,d) =
[ testCase ("E" ++ show i) (cbcEncrypt ctx iv (cbcPlaintext d) @?= cbcCiphertext d)
, testCase ("D" ++ show i) (cbcDecrypt ctx iv (cbcCiphertext d) @?= cbcPlaintext d)
]
where ctx = cbcInit $ cbcKey d
iv = cbcIV d
testKatCFB cfbInit cfbEncrypt cfbDecrypt (i,d) =
[ testCase ("E" ++ show i) (cfbEncrypt ctx iv (cfbPlaintext d) @?= cfbCiphertext d)
, testCase ("D" ++ show i) (cfbDecrypt ctx iv (cfbCiphertext d) @?= cfbPlaintext d)
]
where ctx = cfbInit $ cfbKey d
iv = cfbIV d
testKatCTR ctrInit ctrCombine (i,d) =
[ testCase ("E" ++ i) (ctrCombine ctx iv (ctrPlaintext d) @?= ctrCiphertext d)
, testCase ("D" ++ i) (ctrCombine ctx iv (ctrCiphertext d) @?= ctrPlaintext d)
]
where ctx = ctrInit $ ctrKey d
iv = ctrIV d
testKatXTS xtsInit xtsEncrypt xtsDecrypt (i,d) =
[ testCase ("E" ++ i) (xtsEncrypt ctx iv 0 (xtsPlaintext d) @?= xtsCiphertext d)
, testCase ("D" ++ i) (xtsDecrypt ctx iv 0 (xtsCiphertext d) @?= xtsPlaintext d)
]
where ctx = xtsInit (xtsKey1 d, xtsKey2 d)
iv = xtsIV d
testKatAEAD cipherInit aeadInit aeadAppendHeader aeadEncrypt aeadDecrypt aeadFinalize (i,d) =
[ testCase ("AE" ++ i) (etag @?= aeadTag d)
, testCase ("AD" ++ i) (dtag @?= aeadTag d)
, testCase ("E" ++ i) (ebs @?= aeadCiphertext d)
, testCase ("D" ++ i) (dbs @?= aeadPlaintext d)
]
where ctx = cipherInit $ aeadKey d
(Just aead) = aeadInit ctx (aeadIV d)
aeadHeaded = aeadAppendHeader aead (aeadHeader d)
(ebs,aeadEFinal) = aeadEncrypt aeadHeaded (aeadPlaintext d)
(dbs,aeadDFinal) = aeadDecrypt aeadHeaded (aeadCiphertext d)
etag = aeadFinalize aeadEFinal (aeadTaglen d)
dtag = aeadFinalize aeadDFinal (aeadTaglen d)
-}
testKATs :: BlockCipher cipher
=> KATs
-> cipher
-> TestTree
testKATs kats cipher = testGroup "KAT"
( maybeGroup makeECBTest "ECB" (kat_ECB kats)
++ maybeGroup makeCBCTest "CBC" (kat_CBC kats)
++ maybeGroup makeCFBTest "CFB" (kat_CFB kats)
++ maybeGroup makeCTRTest "CTR" (kat_CTR kats)
-- ++ maybeGroup makeXTSTest "XTS" (kat_XTS kats)
++ maybeGroup makeAEADTest "AEAD" (kat_AEAD kats)
)
where makeECBTest i d =
[ testCase ("E" ++ i) (ecbEncrypt ctx (ecbPlaintext d) @?= ecbCiphertext d)
, testCase ("D" ++ i) (ecbDecrypt ctx (ecbCiphertext d) @?= ecbPlaintext d)
]
where ctx = cipherInitNoErr (cipherMakeKey cipher $ ecbKey d)
makeCBCTest i d =
[ testCase ("E" ++ i) (cbcEncrypt ctx iv (cbcPlaintext d) @?= cbcCiphertext d)
, testCase ("D" ++ i) (cbcDecrypt ctx iv (cbcCiphertext d) @?= cbcPlaintext d)
]
where ctx = cipherInitNoErr (cipherMakeKey cipher $ cbcKey d)
iv = cipherMakeIV cipher $ cbcIV d
makeCFBTest i d =
[ testCase ("E" ++ i) (cfbEncrypt ctx iv (cfbPlaintext d) @?= cfbCiphertext d)
, testCase ("D" ++ i) (cfbDecrypt ctx iv (cfbCiphertext d) @?= cfbPlaintext d)
]
where ctx = cipherInitNoErr (cipherMakeKey cipher $ cfbKey d)
iv = cipherMakeIV cipher $ cfbIV d
makeCTRTest i d =
[ testCase ("E" ++ i) (ctrCombine ctx iv (ctrPlaintext d) @?= ctrCiphertext d)
, testCase ("D" ++ i) (ctrCombine ctx iv (ctrCiphertext d) @?= ctrPlaintext d)
]
where ctx = cipherInitNoErr (cipherMakeKey cipher $ ctrKey d)
iv = cipherMakeIV cipher $ ctrIV d
{-
makeXTSTest i d =
[ testCase ("E" ++ i) (xtsEncrypt ctx iv 0 (xtsPlaintext d) @?= xtsCiphertext d)
, testCase ("D" ++ i) (xtsDecrypt ctx iv 0 (xtsCiphertext d) @?= xtsPlaintext d)
]
where ctx1 = cipherInitNoErr (cipherMakeKey cipher $ xtsKey1 d)
ctx2 = cipherInitNoErr (cipherMakeKey cipher $ xtsKey2 d)
ctx = (ctx1, ctx2)
iv = cipherMakeIV cipher $ xtsIV d
-}
makeAEADTest i d =
[ testCase ("AE" ++ i) (etag @?= AuthTag (B.convert (aeadTag d)))
, testCase ("AD" ++ i) (dtag @?= AuthTag (B.convert (aeadTag d)))
, testCase ("E" ++ i) (ebs @?= aeadCiphertext d)
, testCase ("D" ++ i) (dbs @?= aeadPlaintext d)
]
where ctx = cipherInitNoErr (cipherMakeKey cipher $ aeadKey d)
aead = aeadInitNoErr (aeadMode d) ctx (aeadIV d)
aeadHeaded = aeadAppendHeader aead (aeadHeader d)
(ebs,aeadEFinal) = aeadEncrypt aeadHeaded (aeadPlaintext d)
(dbs,aeadDFinal) = aeadDecrypt aeadHeaded (aeadCiphertext d)
etag = aeadFinalize aeadEFinal (aeadTaglen d)
dtag = aeadFinalize aeadDFinal (aeadTaglen d)
cipherInitNoErr :: BlockCipher c => Key c -> c
cipherInitNoErr (Key k) =
case cipherInit k of
CryptoPassed a -> a
CryptoFailed e -> error (show e)
aeadInitNoErr :: (ByteArrayAccess iv, BlockCipher cipher) => AEADMode -> cipher -> iv -> AEAD cipher
aeadInitNoErr mode ct iv =
case aeadInit mode ct iv of
CryptoPassed a -> a
CryptoFailed _ -> error $ "cipher doesn't support aead mode: " ++ show mode
------------------------------------------------------------------------
-- Properties
------------------------------------------------------------------------
-- | any sized bytestring
newtype Plaintext a = Plaintext { unPlaintext :: B.ByteString }
deriving (Show,Eq)
-- | A multiple of blocksize bytestring
newtype PlaintextBS a = PlaintextBS { unPlaintextBS :: B.ByteString }
deriving (Show,Eq)
newtype Key a = Key ByteString
deriving (Show,Eq)
-- | a ECB unit test
data ECBUnit a = ECBUnit (Key a) (PlaintextBS a)
deriving (Eq)
-- | a CBC unit test
data CBCUnit a = CBCUnit (Key a) (IV a) (PlaintextBS a)
deriving (Eq)
-- | a CBC unit test
data CFBUnit a = CFBUnit (Key a) (IV a) (PlaintextBS a)
deriving (Eq)
-- | a CFB unit test
data CFB8Unit a = CFB8Unit (Key a) (IV a) (Plaintext a)
deriving (Eq)
-- | a CTR unit test
data CTRUnit a = CTRUnit (Key a) (IV a) (Plaintext a)
deriving (Eq)
-- | a XTS unit test
data XTSUnit a = XTSUnit (Key a) (Key a) (IV a) (PlaintextBS a)
deriving (Eq)
-- | a AEAD unit test
data AEADUnit a = AEADUnit (Key a) B.ByteString (Plaintext a) (Plaintext a)
deriving (Eq)
-- | Stream cipher unit test
data StreamUnit a = StreamUnit (Key a) (Plaintext a)
deriving (Eq)
instance Show (ECBUnit a) where
show (ECBUnit key b) = "ECB(key=" ++ show key ++ ",input=" ++ show b ++ ")"
instance Show (CBCUnit a) where
show (CBCUnit key iv b) = "CBC(key=" ++ show key ++ ",iv=" ++ show iv ++ ",input=" ++ show b ++ ")"
instance Show (CFBUnit a) where
show (CFBUnit key iv b) = "CFB(key=" ++ show key ++ ",iv=" ++ show iv ++ ",input=" ++ show b ++ ")"
instance Show (CFB8Unit a) where
show (CFB8Unit key iv b) = "CFB8(key=" ++ show key ++ ",iv=" ++ show iv ++ ",input=" ++ show b ++ ")"
instance Show (CTRUnit a) where
show (CTRUnit key iv b) = "CTR(key=" ++ show key ++ ",iv=" ++ show iv ++ ",input=" ++ show b ++ ")"
instance Show (XTSUnit a) where
show (XTSUnit key1 key2 iv b) = "XTS(key1=" ++ show key1 ++ ",key2=" ++ show key2 ++ ",iv=" ++ show iv ++ ",input=" ++ show b ++ ")"
instance Show (AEADUnit a) where
show (AEADUnit key iv aad b) = "AEAD(key=" ++ show key ++ ",iv=" ++ show iv ++ ",aad=" ++ show (unPlaintext aad) ++ ",input=" ++ show b ++ ")"
instance Show (StreamUnit a) where
show (StreamUnit key b) = "Stream(key=" ++ show key ++ ",input=" ++ show b ++ ")"
-- | Generate an arbitrary valid key for a specific block cipher
generateKey :: Cipher a => Gen (Key a)
generateKey = keyFromCipher undefined
where keyFromCipher :: Cipher a => a -> Gen (Key a)
keyFromCipher cipher = do
sz <- case cipherKeySize cipher of
KeySizeRange low high -> choose (low, high)
KeySizeFixed v -> return v
KeySizeEnum l -> elements l
Key . B.pack <$> replicateM sz arbitrary
-- | Generate an arbitrary valid IV for a specific block cipher
generateIv :: BlockCipher a => Gen (IV a)
generateIv = ivFromCipher undefined
where ivFromCipher :: BlockCipher a => a -> Gen (IV a)
ivFromCipher cipher = fromJust . makeIV . B.pack <$> replicateM (blockSize cipher) arbitrary
-- | Generate an arbitrary valid IV for AEAD for a specific block cipher
generateIvAEAD :: Gen B.ByteString
generateIvAEAD = choose (12,90) >>= \sz -> (B.pack <$> replicateM sz arbitrary)
-- | Generate a plaintext multiple of blocksize bytes
generatePlaintextMultipleBS :: BlockCipher a => Gen (PlaintextBS a)
generatePlaintextMultipleBS = choose (1,128) >>= \size -> replicateM (size * 16) arbitrary >>= return . PlaintextBS . B.pack
-- | Generate any sized plaintext
generatePlaintext :: Gen (Plaintext a)
generatePlaintext = choose (0,324) >>= \size -> replicateM size arbitrary >>= return . Plaintext . B.pack
instance BlockCipher a => Arbitrary (ECBUnit a) where
arbitrary = ECBUnit <$> generateKey
<*> generatePlaintextMultipleBS
instance BlockCipher a => Arbitrary (CBCUnit a) where
arbitrary = CBCUnit <$> generateKey
<*> generateIv
<*> generatePlaintextMultipleBS
instance BlockCipher a => Arbitrary (CFBUnit a) where
arbitrary = CFBUnit <$> generateKey
<*> generateIv
<*> generatePlaintextMultipleBS
instance BlockCipher a => Arbitrary (CFB8Unit a) where
arbitrary = CFB8Unit <$> generateKey <*> generateIv <*> generatePlaintext
instance BlockCipher a => Arbitrary (CTRUnit a) where
arbitrary = CTRUnit <$> generateKey
<*> generateIv
<*> generatePlaintext
instance BlockCipher a => Arbitrary (XTSUnit a) where
arbitrary = XTSUnit <$> generateKey
<*> generateKey
<*> generateIv
<*> generatePlaintextMultipleBS
instance BlockCipher a => Arbitrary (AEADUnit a) where
arbitrary = AEADUnit <$> generateKey
<*> generateIvAEAD
<*> generatePlaintext
<*> generatePlaintext
instance StreamCipher a => Arbitrary (StreamUnit a) where
arbitrary = StreamUnit <$> generateKey
<*> generatePlaintext
testBlockCipherBasic :: BlockCipher a => a -> [TestTree]
testBlockCipherBasic cipher = [ testProperty "ECB" ecbProp ]
where ecbProp = toTests cipher
toTests :: BlockCipher a => a -> (ECBUnit a -> Bool)
toTests _ = testProperty_ECB
testProperty_ECB (ECBUnit key (unPlaintextBS -> plaintext)) = withCtx key $ \ctx ->
plaintext `assertEq` ecbDecrypt ctx (ecbEncrypt ctx plaintext)
testBlockCipherModes :: BlockCipher a => a -> [TestTree]
testBlockCipherModes cipher =
[ testProperty "CBC" cbcProp
, testProperty "CFB" cfbProp
--, testProperty "CFB8" cfb8Prop
, testProperty "CTR" ctrProp
]
where (cbcProp,cfbProp,ctrProp) = toTests cipher
toTests :: BlockCipher a
=> a
-> ((CBCUnit a -> Bool), (CFBUnit a -> Bool), {-(CFB8Unit a -> Bool),-} (CTRUnit a -> Bool))
toTests _ = (testProperty_CBC
,testProperty_CFB
--,testProperty_CFB8
,testProperty_CTR
)
testProperty_CBC (CBCUnit key testIV (unPlaintextBS -> plaintext)) = withCtx key $ \ctx ->
plaintext `assertEq` cbcDecrypt ctx testIV (cbcEncrypt ctx testIV plaintext)
testProperty_CFB (CFBUnit key testIV (unPlaintextBS -> plaintext)) = withCtx key $ \ctx ->
plaintext `assertEq` cfbDecrypt ctx testIV (cfbEncrypt ctx testIV plaintext)
{-
testProperty_CFB8 (CFB8Unit (cipherInit -> ctx) testIV (unPlaintext -> plaintext)) =
plaintext `assertEq` cfb8Decrypt ctx testIV (cfb8Encrypt ctx testIV plaintext)
-}
testProperty_CTR (CTRUnit key testIV (unPlaintext -> plaintext)) = withCtx key $ \ctx ->
plaintext `assertEq` ctrCombine ctx testIV (ctrCombine ctx testIV plaintext)
testBlockCipherAEAD :: BlockCipher a => a -> [TestTree]
testBlockCipherAEAD cipher =
[ testProperty "OCB" (aeadProp AEAD_OCB)
, testProperty "CCM" (aeadProp (AEAD_CCM 0 CCM_M16 CCM_L2))
, testProperty "EAX" (aeadProp AEAD_EAX)
, testProperty "CWC" (aeadProp AEAD_CWC)
, testProperty "GCM" (aeadProp AEAD_GCM)
]
where aeadProp = toTests cipher
toTests :: BlockCipher a => a -> (AEADMode -> AEADUnit a -> Bool)
toTests _ = testProperty_AEAD
testProperty_AEAD mode (AEADUnit key testIV (unPlaintext -> aad) (unPlaintext -> plaintext)) = withCtx key $ \ctx ->
case aeadInit mode' ctx iv' of
CryptoPassed iniAead ->
let aead = aeadAppendHeader iniAead aad
(eText, aeadE) = aeadEncrypt aead plaintext
(dText, aeadD) = aeadDecrypt aead eText
eTag = aeadFinalize aeadE (blockSize ctx)
dTag = aeadFinalize aeadD (blockSize ctx)
in (plaintext `assertEq` dText) && (eTag `B.eq` dTag)
CryptoFailed err
| err == CryptoError_AEADModeNotSupported -> True
| otherwise -> error ("testProperty_AEAD: " ++ show err)
where (mode', iv') = updateCcmInputSize mode (B.length plaintext) testIV
updateCcmInputSize aeadmode k iv = case aeadmode of
AEAD_CCM _ m l -> (AEAD_CCM k m l, B.take 13 (iv <> (B.replicate 15 0)))
aeadOther -> (aeadOther, iv)
withCtx :: Cipher c => Key c -> (c -> a) -> a
withCtx (Key key) f =
case cipherInit key of
CryptoFailed e -> error ("init failed: " ++ show e)
CryptoPassed ctx -> f ctx
{-
testBlockCipherXTS :: BlockCipher a => a -> [TestTree]
testBlockCipherXTS cipher = [testProperty "XTS" xtsProp]
where xtsProp = toTests cipher
toTests :: BlockCipher a => a -> (XTSUnit a -> Bool)
toTests _ = testProperty_XTS
testProperty_XTS (XTSUnit (cipherInit -> ctx1) (cipherInit -> ctx2) testIV (toBytes -> plaintext))
| blockSize ctx1 == 16 = plaintext `assertEq` xtsDecrypt (ctx1, ctx2) testIV 0 (xtsEncrypt (ctx1, ctx2) testIV 0 plaintext)
| otherwise = True
-}
-- | Test a generic block cipher for properties
-- related to block cipher modes.
testModes :: BlockCipher a => a -> [TestTree]
testModes cipher =
[ testGroup "decrypt.encrypt==id"
-- (testBlockCipherBasic cipher ++ testBlockCipherModes cipher ++ testBlockCipherAEAD cipher ++ testBlockCipherXTS cipher)
(testBlockCipherBasic cipher ++ testBlockCipherModes cipher ++ testBlockCipherAEAD cipher)
]
-- | Test IV arithmetic (based on the cipher block size)
testIvArith :: BlockCipher a => a -> [TestTree]
testIvArith cipher =
[ testCase "nullIV is null" $
True @=? B.all (== 0) (ivNull cipher)
, testProperty "ivAdd is linear" $ \a b -> do
iv <- generateIvFromCipher cipher
return $ ivAdd iv (a + b) `propertyEq` ivAdd (ivAdd iv a) b
]
where
ivNull :: BlockCipher a => a -> IV a
ivNull = const nullIV
-- uses IV pattern <00 .. 00 FF .. FF> to test carry propagation
generateIvFromCipher :: BlockCipher a => a -> Gen (IV a)
generateIvFromCipher c = do
let n = blockSize c
i <- choose (0, n)
let zeros = Prelude.replicate (n - i) 0x00
ones = Prelude.replicate i 0xFF
return $ cipherMakeIV c (B.pack $ zeros ++ ones)
-- | Return tests for a specific blockcipher and a list of KATs
testBlockCipher :: BlockCipher a => KATs -> a -> TestTree
testBlockCipher kats cipher = testGroup (cipherName cipher)
( (if kats == defaultKATs then [] else [testKATs kats cipher])
++ testModes cipher ++ testIvArith cipher
)
cipherMakeKey :: Cipher cipher => cipher -> ByteString -> Key cipher
cipherMakeKey _ bs = Key bs
cipherMakeIV :: BlockCipher cipher => cipher -> ByteString -> IV cipher
cipherMakeIV _ bs = fromJust $ makeIV bs
maybeGroup :: (String -> t -> [TestTree]) -> TestName -> [t] -> [TestTree]
maybeGroup mkTest groupName l
| null l = []
| otherwise = [testGroup groupName (concatMap (\(i, d) -> mkTest (show i) d) $ zip nbs l)]
where nbs :: [Int]
nbs = [0..]
|