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