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