crypto-cipher-tests-0.0.11/0000755000000000000000000000000012232130462013702 5ustar0000000000000000crypto-cipher-tests-0.0.11/LICENSE0000644000000000000000000000272212232130462014712 0ustar0000000000000000Copyright (c) 2013 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. crypto-cipher-tests-0.0.11/crypto-cipher-tests.cabal0000644000000000000000000000357512232130462020630 0ustar0000000000000000Name: crypto-cipher-tests Version: 0.0.11 Synopsis: Generic cryptography cipher tests Description: Generic cryptography cipher tests License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: vincent@snarc.org Category: Cryptography Stability: experimental Build-Type: Simple Homepage: http://github.com/vincenthz/hs-crypto-cipher Cabal-Version: >=1.8 Library Exposed-modules: Crypto.Cipher.Tests Other-modules: Crypto.Cipher.Tests.KATs Crypto.Cipher.Tests.Properties Build-depends: base >= 3 && < 5 , QuickCheck >= 2 , mtl , HUnit , test-framework , test-framework-quickcheck2 , test-framework-hunit , bytestring , byteable >= 0.1.1 && < 0.2 , securemem >= 0.1.1 && < 0.2 , crypto-cipher-types >= 0.0.8 && < 0.1 ghc-options: -Wall -fwarn-tabs Test-Suite test-crypto-cipher-dummy type: exitcode-stdio-1.0 hs-source-dirs: tests Main-is: Tests.hs Build-Depends: base >= 3 && < 5 , bytestring , byteable , crypto-cipher-types , crypto-cipher-tests , mtl , QuickCheck >= 2 , HUnit , test-framework , test-framework-quickcheck2 , test-framework-hunit ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures source-repository head type: git location: git://github.com/vincenthz/hs-crypto-cipher subdir: tests crypto-cipher-tests-0.0.11/Setup.hs0000644000000000000000000000005612232130462015337 0ustar0000000000000000import Distribution.Simple main = defaultMain crypto-cipher-tests-0.0.11/tests/0000755000000000000000000000000012232130462015044 5ustar0000000000000000crypto-cipher-tests-0.0.11/tests/Tests.hs0000644000000000000000000000241012232130462016477 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} module Main where import Test.Framework (defaultMain) import Crypto.Cipher.Types import Crypto.Cipher.Types.Unsafe import Crypto.Cipher.Tests import qualified Data.ByteString as B import Data.Bits (xor) -- | the XOR cipher is so awesome that it doesn't need any key or state. -- Also it's a stream and block cipher at the same time. data XorCipher = XorCipher instance Cipher XorCipher where cipherInit _ = XorCipher cipherName _ = "xor" cipherKeySize _ = KeySizeRange 1 32 instance BlockCipher XorCipher where blockSize _ = 16 ecbEncrypt _ s = xorBS s ecbDecrypt _ s = xorBS s instance BlockCipherIO XorCipher where ecbEncryptMutable cipher d s len = onBlock cipher xorBS d s len ecbDecryptMutable cipher d s len = onBlock cipher xorBS d s len instance StreamCipher XorCipher where streamCombine _ b = (B.pack $ B.zipWith xor (B.replicate (B.length b) 0x12) b, XorCipher) xorBS :: B.ByteString -> B.ByteString xorBS b = B.pack $ B.zipWith xor (B.replicate (B.length b) 0xa5) b tests = [ testBlockCipher defaultKATs cipher , testBlockCipherIO defaultKATs cipher , testStreamCipher defaultStreamKATs cipher ] where cipher :: XorCipher cipher = undefined main = defaultMain tests crypto-cipher-tests-0.0.11/Crypto/0000755000000000000000000000000012232130462015162 5ustar0000000000000000crypto-cipher-tests-0.0.11/Crypto/Cipher/0000755000000000000000000000000012232130462016374 5ustar0000000000000000crypto-cipher-tests-0.0.11/Crypto/Cipher/Tests.hs0000644000000000000000000000274112232130462020036 0ustar0000000000000000-- | -- Module : Crypto.Cipher.Tests -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : Stable -- Portability : Excellent -- {-# LANGUAGE ViewPatterns #-} module Crypto.Cipher.Tests ( testBlockCipher , testBlockCipherIO , testStreamCipher -- * KATs , defaultKATs , defaultStreamKATs , KATs(..) , KAT_Stream(..) , KAT_ECB(..) , KAT_CBC(..) , KAT_CFB(..) , KAT_CTR(..) , KAT_XTS(..) , KAT_AEAD(..) ) where import Test.Framework (Test, testGroup) import Crypto.Cipher.Types import Crypto.Cipher.Types.Unsafe import Crypto.Cipher.Tests.KATs import Crypto.Cipher.Tests.Properties -- | Return tests for a specific blockcipher and a list of KATs testBlockCipher :: BlockCipher a => KATs -> a -> Test testBlockCipher kats cipher = testGroup (cipherName cipher) ( (if kats == defaultKATs then [] else [testKATs kats cipher]) ++ testModes cipher ) -- | Return test for a specific blockcipher and a list of KATs testBlockCipherIO :: BlockCipherIO a => KATs -> a -> Test testBlockCipherIO _ cipher = testGroup ("mutable " ++ cipherName cipher) ( [] ++ testIOModes cipher ) -- | Return tests for a specific streamcipher and a list of KATs testStreamCipher :: StreamCipher a => [KAT_Stream] -> a -> Test testStreamCipher kats cipher = testGroup (cipherName cipher) ( (if kats == defaultStreamKATs then [] else [testStreamKATs kats cipher]) ++ testStream cipher ) crypto-cipher-tests-0.0.11/Crypto/Cipher/Tests/0000755000000000000000000000000012232130462017476 5ustar0000000000000000crypto-cipher-tests-0.0.11/Crypto/Cipher/Tests/Properties.hs0000644000000000000000000002637312232130462022201 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} module Crypto.Cipher.Tests.Properties where import Control.Applicative import Control.Monad import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck import Crypto.Cipher.Types import Crypto.Cipher.Types.Unsafe import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B import Data.Byteable import Data.Maybe -- | any sized bytestring newtype Plaintext a = Plaintext B.ByteString deriving (Show,Eq) instance Byteable (Plaintext a) where toBytes (Plaintext b) = b -- | A multiple of blocksize bytestring newtype PlaintextBS a = PlaintextBS B.ByteString deriving (Show,Eq) instance Byteable (PlaintextBS a) where toBytes (PlaintextBS b) = b -- | 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 (toBytes key) ++ ",input=" ++ show b ++ ")" instance Show (CBCUnit a) where show (CBCUnit key iv b) = "CBC(key=" ++ show (toBytes key) ++ ",iv=" ++ show (toBytes iv) ++ ",input=" ++ show b ++ ")" instance Show (CFBUnit a) where show (CFBUnit key iv b) = "CFB(key=" ++ show (toBytes key) ++ ",iv=" ++ show (toBytes iv) ++ ",input=" ++ show b ++ ")" instance Show (CFB8Unit a) where show (CFB8Unit key iv b) = "CFB8(key=" ++ show (toBytes key) ++ ",iv=" ++ show (toBytes iv) ++ ",input=" ++ show b ++ ")" instance Show (CTRUnit a) where show (CTRUnit key iv b) = "CTR(key=" ++ show (toBytes key) ++ ",iv=" ++ show (toBytes iv) ++ ",input=" ++ show b ++ ")" instance Show (XTSUnit a) where show (XTSUnit key1 key2 iv b) = "XTS(key1=" ++ show (toBytes key1) ++ ",key2=" ++ show (toBytes key2) ++ ",iv=" ++ show (toBytes iv) ++ ",input=" ++ show b ++ ")" instance Show (AEADUnit a) where show (AEADUnit key iv aad b) = "AEAD(key=" ++ show (toBytes key) ++ ",iv=" ++ show iv ++ ",aad=" ++ show (toBytes aad) ++ ",input=" ++ show b ++ ")" instance Show (StreamUnit a) where show (StreamUnit key b) = "Stream(key=" ++ show (toBytes 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 either (error . show) id . makeKey . 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 -> [Test] testBlockCipherBasic cipher = [ testProperty "ECB" ecbProp ] where ecbProp = toTests cipher toTests :: BlockCipher a => a -> (ECBUnit a -> Bool) toTests _ = testProperty_ECB testProperty_ECB (ECBUnit (cipherInit -> ctx) (toBytes -> plaintext)) = plaintext `assertEq` ecbDecrypt ctx (ecbEncrypt ctx plaintext) testBlockCipherModes :: BlockCipher a => a -> [Test] testBlockCipherModes cipher = [ testProperty "CBC" cbcProp , testProperty "CFB" cfbProp , testProperty "CFB8" cfb8Prop , testProperty "CTR" ctrProp ] where (cbcProp,cfbProp,cfb8Prop,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 (cipherInit -> ctx) testIV (toBytes -> plaintext)) = plaintext `assertEq` cbcDecrypt ctx testIV (cbcEncrypt ctx testIV plaintext) testProperty_CFB (CFBUnit (cipherInit -> ctx) testIV (toBytes -> plaintext)) = plaintext `assertEq` cfbDecrypt ctx testIV (cfbEncrypt ctx testIV plaintext) testProperty_CFB8 (CFB8Unit (cipherInit -> ctx) testIV (toBytes -> plaintext)) = plaintext `assertEq` cfb8Decrypt ctx testIV (cfb8Encrypt ctx testIV plaintext) testProperty_CTR (CTRUnit (cipherInit -> ctx) testIV (toBytes -> plaintext)) = plaintext `assertEq` ctrCombine ctx testIV (ctrCombine ctx testIV plaintext) testBlockCipherAEAD :: BlockCipher a => a -> [Test] testBlockCipherAEAD cipher = [ testProperty "OCB" (aeadProp AEAD_OCB) , testProperty "CCM" (aeadProp AEAD_CCM) , 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 (cipherInit -> ctx) testIV (toBytes -> aad) (toBytes -> plaintext)) = case aeadInit mode ctx testIV of Just 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) && (toBytes eTag `assertEq` toBytes dTag) Nothing -> True testBlockCipherXTS :: BlockCipher a => a -> [Test] 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 -> [Test] testModes cipher = [ testGroup "decrypt.encrypt==id" (testBlockCipherBasic cipher ++ testBlockCipherModes cipher ++ testBlockCipherAEAD cipher ++ testBlockCipherXTS cipher) ] -- | Test a generic block cipher for properties -- related to BlockCipherIO cipher modes. testIOModes :: BlockCipherIO a => a -> [Test] testIOModes cipher = [ testGroup "mutable" [ testProperty "ECB" (testProperty_ECB cipher) , testProperty "CBC" (testProperty_CBC cipher) ] ] where testProperty_ECB :: BlockCipherIO a => a -> (ECBUnit a) -> Bool testProperty_ECB _ (ECBUnit (cipherInit -> ctx) (toBytes -> plaintext)) = plaintext == B.unsafeCreate (B.length plaintext) encryptDecryptMutable where encryptDecryptMutable buf = withBytePtr plaintext $ \src -> do ecbEncryptMutable ctx buf src (fromIntegral $ B.length plaintext) ecbDecryptMutable ctx buf buf (fromIntegral $ B.length plaintext) testProperty_CBC :: BlockCipherIO a => a -> (CBCUnit a) -> Bool testProperty_CBC _ (CBCUnit (cipherInit -> ctx) testIV (toBytes -> plaintext)) = plaintext == B.unsafeCreate (B.length plaintext) encryptDecryptMutable where encryptDecryptMutable buf = void $ B.create (B.length plaintext) $ \tmp -> withBytePtr plaintext $ \src -> withBytePtr testIV $ \iv -> do cbcEncryptMutable ctx iv tmp src (fromIntegral $ B.length plaintext) cbcDecryptMutable ctx iv buf tmp (fromIntegral $ B.length plaintext) -- | Test stream mode testStream :: StreamCipher a => a -> [Test] testStream cipher = [testProperty "combine.combine==id" (testStreamUnit cipher)] where testStreamUnit :: StreamCipher a => a -> (StreamUnit a -> Bool) testStreamUnit _ (StreamUnit (cipherInit -> ctx) (toBytes -> plaintext)) = let cipherText = fst $ streamCombine ctx plaintext in fst (streamCombine ctx cipherText) `assertEq` plaintext assertEq :: B.ByteString -> B.ByteString -> Bool assertEq b1 b2 | b1 /= b2 = error ("b1: " ++ show b1 ++ " b2: " ++ show b2) | otherwise = True crypto-cipher-tests-0.0.11/Crypto/Cipher/Tests/KATs.hs0000644000000000000000000001545612232130462020647 0ustar0000000000000000module Crypto.Cipher.Tests.KATs where import Data.ByteString (ByteString) import Test.Framework (Test, testGroup, TestName) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit ((@?=)) import Crypto.Cipher.Types import Data.Maybe -- | 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 -- ^ AEAD mode to use , aeadKey :: ByteString -- ^ Key , aeadIV :: ByteString -- ^ IV for initialization , aeadHeader :: ByteString -- ^ Authentificated Header , aeadPlaintext :: ByteString -- ^ Plaintext , aeadCiphertext :: ByteString -- ^ Ciphertext , aeadTaglen :: Int -- ^ aead tag len , aeadTag :: AuthTag -- ^ 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) -- | KAT for Stream cipher data KAT_Stream = KAT_Stream { streamKey :: ByteString , streamPlaintext :: ByteString , streamCiphertext :: ByteString } deriving (Show,Eq) -- | the empty KATs defaultKATs :: KATs defaultKATs = KATs { kat_ECB = [] , kat_CBC = [] , kat_CFB = [] , kat_CTR = [] , kat_XTS = [] , kat_AEAD = [] } -- | the empty KATs for stream defaultStreamKATs :: [KAT_Stream] defaultStreamKATs = [] -- | tests related to KATs testKATs :: BlockCipher cipher => KATs -> cipher -> Test 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 = cipherInit (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 = cipherInit (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 = cipherInit (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 = cipherInit (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 = cipherInit (cipherMakeKey cipher $ xtsKey1 d) ctx2 = cipherInit (cipherMakeKey cipher $ xtsKey2 d) ctx = (ctx1, ctx2) iv = cipherMakeIV cipher $ xtsIV d makeAEADTest 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 (cipherMakeKey cipher $ aeadKey d) (Just aead) = aeadInit (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) testStreamKATs :: StreamCipher cipher => [KAT_Stream] -> cipher -> Test testStreamKATs kats cipher = testGroup "KAT" $ maybeGroup makeStreamTest "Stream" kats where makeStreamTest i d = [ testCase ("E" ++ i) (fst (streamCombine ctx (streamPlaintext d)) @?= streamCiphertext d) , testCase ("D" ++ i) (fst (streamCombine ctx (streamCiphertext d)) @?= streamPlaintext d) ] where ctx = cipherInit (cipherMakeKey cipher $ streamKey d) cipherMakeKey :: Cipher cipher => cipher -> ByteString -> Key cipher cipherMakeKey c bs = case makeKey bs of Left e -> error ("invalid key " ++ show bs ++ " for " ++ show (cipherName c) ++ " " ++ show e) Right k -> k cipherMakeIV :: BlockCipher cipher => cipher -> ByteString -> IV cipher cipherMakeIV _ bs = fromJust $ makeIV bs maybeGroup :: (String -> t -> [Test]) -> TestName -> [t] -> [Test] maybeGroup mkTest groupName l | null l = [] | otherwise = [testGroup groupName (concatMap (\(i, d) -> mkTest (show i) d) $ zip nbs l)] where nbs :: [Int] nbs = [0..]