{-# 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 (Int -> Plaintext a -> ShowS
[Plaintext a] -> ShowS
Plaintext a -> String
(Int -> Plaintext a -> ShowS)
-> (Plaintext a -> String)
-> ([Plaintext a] -> ShowS)
-> Show (Plaintext a)
forall a. Int -> Plaintext a -> ShowS
forall a. [Plaintext a] -> ShowS
forall a. Plaintext a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Plaintext a] -> ShowS
$cshowList :: forall a. [Plaintext a] -> ShowS
show :: Plaintext a -> String
$cshow :: forall a. Plaintext a -> String
showsPrec :: Int -> Plaintext a -> ShowS
$cshowsPrec :: forall a. Int -> Plaintext a -> ShowS
Show,Plaintext a -> Plaintext a -> Bool
(Plaintext a -> Plaintext a -> Bool)
-> (Plaintext a -> Plaintext a -> Bool) -> Eq (Plaintext a)
forall a. Plaintext a -> Plaintext a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Plaintext a -> Plaintext a -> Bool
$c/= :: forall a. Plaintext a -> Plaintext a -> Bool
== :: Plaintext a -> Plaintext a -> Bool
$c== :: forall a. Plaintext a -> Plaintext a -> Bool
Eq)

instance Byteable (Plaintext a) where
    toBytes :: Plaintext a -> ByteString
toBytes (Plaintext b :: ByteString
b) = ByteString
b

-- | A multiple of blocksize bytestring
newtype PlaintextBS a = PlaintextBS B.ByteString
    deriving (Int -> PlaintextBS a -> ShowS
[PlaintextBS a] -> ShowS
PlaintextBS a -> String
(Int -> PlaintextBS a -> ShowS)
-> (PlaintextBS a -> String)
-> ([PlaintextBS a] -> ShowS)
-> Show (PlaintextBS a)
forall a. Int -> PlaintextBS a -> ShowS
forall a. [PlaintextBS a] -> ShowS
forall a. PlaintextBS a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlaintextBS a] -> ShowS
$cshowList :: forall a. [PlaintextBS a] -> ShowS
show :: PlaintextBS a -> String
$cshow :: forall a. PlaintextBS a -> String
showsPrec :: Int -> PlaintextBS a -> ShowS
$cshowsPrec :: forall a. Int -> PlaintextBS a -> ShowS
Show,PlaintextBS a -> PlaintextBS a -> Bool
(PlaintextBS a -> PlaintextBS a -> Bool)
-> (PlaintextBS a -> PlaintextBS a -> Bool) -> Eq (PlaintextBS a)
forall a. PlaintextBS a -> PlaintextBS a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaintextBS a -> PlaintextBS a -> Bool
$c/= :: forall a. PlaintextBS a -> PlaintextBS a -> Bool
== :: PlaintextBS a -> PlaintextBS a -> Bool
$c== :: forall a. PlaintextBS a -> PlaintextBS a -> Bool
Eq)

instance Byteable (PlaintextBS a) where
    toBytes :: PlaintextBS a -> ByteString
toBytes (PlaintextBS b :: ByteString
b) = ByteString
b

-- | a ECB unit test
data ECBUnit a = ECBUnit (Key a) (PlaintextBS a)
    deriving (ECBUnit a -> ECBUnit a -> Bool
(ECBUnit a -> ECBUnit a -> Bool)
-> (ECBUnit a -> ECBUnit a -> Bool) -> Eq (ECBUnit a)
forall a. ECBUnit a -> ECBUnit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ECBUnit a -> ECBUnit a -> Bool
$c/= :: forall a. ECBUnit a -> ECBUnit a -> Bool
== :: ECBUnit a -> ECBUnit a -> Bool
$c== :: forall a. ECBUnit a -> ECBUnit a -> Bool
Eq)

-- | a CBC unit test
data CBCUnit a = CBCUnit (Key a) (IV a) (PlaintextBS a)
    deriving (CBCUnit a -> CBCUnit a -> Bool
(CBCUnit a -> CBCUnit a -> Bool)
-> (CBCUnit a -> CBCUnit a -> Bool) -> Eq (CBCUnit a)
forall a. CBCUnit a -> CBCUnit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CBCUnit a -> CBCUnit a -> Bool
$c/= :: forall a. CBCUnit a -> CBCUnit a -> Bool
== :: CBCUnit a -> CBCUnit a -> Bool
$c== :: forall a. CBCUnit a -> CBCUnit a -> Bool
Eq)

-- | a CBC unit test
data CFBUnit a = CFBUnit (Key a) (IV a) (PlaintextBS a)
    deriving (CFBUnit a -> CFBUnit a -> Bool
(CFBUnit a -> CFBUnit a -> Bool)
-> (CFBUnit a -> CFBUnit a -> Bool) -> Eq (CFBUnit a)
forall a. CFBUnit a -> CFBUnit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFBUnit a -> CFBUnit a -> Bool
$c/= :: forall a. CFBUnit a -> CFBUnit a -> Bool
== :: CFBUnit a -> CFBUnit a -> Bool
$c== :: forall a. CFBUnit a -> CFBUnit a -> Bool
Eq)

-- | a CFB unit test
data CFB8Unit a = CFB8Unit (Key a) (IV a) (Plaintext a)
    deriving (CFB8Unit a -> CFB8Unit a -> Bool
(CFB8Unit a -> CFB8Unit a -> Bool)
-> (CFB8Unit a -> CFB8Unit a -> Bool) -> Eq (CFB8Unit a)
forall a. CFB8Unit a -> CFB8Unit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFB8Unit a -> CFB8Unit a -> Bool
$c/= :: forall a. CFB8Unit a -> CFB8Unit a -> Bool
== :: CFB8Unit a -> CFB8Unit a -> Bool
$c== :: forall a. CFB8Unit a -> CFB8Unit a -> Bool
Eq)

-- | a CTR unit test
data CTRUnit a = CTRUnit (Key a) (IV a) (Plaintext a)
    deriving (CTRUnit a -> CTRUnit a -> Bool
(CTRUnit a -> CTRUnit a -> Bool)
-> (CTRUnit a -> CTRUnit a -> Bool) -> Eq (CTRUnit a)
forall a. CTRUnit a -> CTRUnit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CTRUnit a -> CTRUnit a -> Bool
$c/= :: forall a. CTRUnit a -> CTRUnit a -> Bool
== :: CTRUnit a -> CTRUnit a -> Bool
$c== :: forall a. CTRUnit a -> CTRUnit a -> Bool
Eq)

-- | a XTS unit test
data XTSUnit a = XTSUnit (Key a) (Key a) (IV a) (PlaintextBS a)
    deriving (XTSUnit a -> XTSUnit a -> Bool
(XTSUnit a -> XTSUnit a -> Bool)
-> (XTSUnit a -> XTSUnit a -> Bool) -> Eq (XTSUnit a)
forall a. XTSUnit a -> XTSUnit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XTSUnit a -> XTSUnit a -> Bool
$c/= :: forall a. XTSUnit a -> XTSUnit a -> Bool
== :: XTSUnit a -> XTSUnit a -> Bool
$c== :: forall a. XTSUnit a -> XTSUnit a -> Bool
Eq)

-- | a AEAD unit test
data AEADUnit a = AEADUnit (Key a) B.ByteString (Plaintext a) (Plaintext a)
    deriving (AEADUnit a -> AEADUnit a -> Bool
(AEADUnit a -> AEADUnit a -> Bool)
-> (AEADUnit a -> AEADUnit a -> Bool) -> Eq (AEADUnit a)
forall a. AEADUnit a -> AEADUnit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AEADUnit a -> AEADUnit a -> Bool
$c/= :: forall a. AEADUnit a -> AEADUnit a -> Bool
== :: AEADUnit a -> AEADUnit a -> Bool
$c== :: forall a. AEADUnit a -> AEADUnit a -> Bool
Eq)

-- | Stream cipher unit test
data StreamUnit a = StreamUnit (Key a) (Plaintext a)
    deriving (StreamUnit a -> StreamUnit a -> Bool
(StreamUnit a -> StreamUnit a -> Bool)
-> (StreamUnit a -> StreamUnit a -> Bool) -> Eq (StreamUnit a)
forall a. StreamUnit a -> StreamUnit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamUnit a -> StreamUnit a -> Bool
$c/= :: forall a. StreamUnit a -> StreamUnit a -> Bool
== :: StreamUnit a -> StreamUnit a -> Bool
$c== :: forall a. StreamUnit a -> StreamUnit a -> Bool
Eq)

instance Show (ECBUnit a) where
    show :: ECBUnit a -> String
show (ECBUnit key :: Key a
key b :: PlaintextBS a
b) = "ECB(key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Key a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key a
key) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",input=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PlaintextBS a -> String
forall a. Show a => a -> String
show PlaintextBS a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Show (CBCUnit a) where
    show :: CBCUnit a -> String
show (CBCUnit key :: Key a
key iv :: IV a
iv b :: PlaintextBS a
b) = "CBC(key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Key a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key a
key) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",iv=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (IV a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes IV a
iv) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",input=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PlaintextBS a -> String
forall a. Show a => a -> String
show PlaintextBS a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Show (CFBUnit a) where
    show :: CFBUnit a -> String
show (CFBUnit key :: Key a
key iv :: IV a
iv b :: PlaintextBS a
b) = "CFB(key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Key a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key a
key) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",iv=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (IV a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes IV a
iv) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",input=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PlaintextBS a -> String
forall a. Show a => a -> String
show PlaintextBS a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Show (CFB8Unit a) where
    show :: CFB8Unit a -> String
show (CFB8Unit key :: Key a
key iv :: IV a
iv b :: Plaintext a
b) = "CFB8(key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Key a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key a
key) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",iv=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (IV a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes IV a
iv) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",input=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Plaintext a -> String
forall a. Show a => a -> String
show Plaintext a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Show (CTRUnit a) where
    show :: CTRUnit a -> String
show (CTRUnit key :: Key a
key iv :: IV a
iv b :: Plaintext a
b) = "CTR(key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Key a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key a
key) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",iv=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (IV a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes IV a
iv) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",input=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Plaintext a -> String
forall a. Show a => a -> String
show Plaintext a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Show (XTSUnit a) where
    show :: XTSUnit a -> String
show (XTSUnit key1 :: Key a
key1 key2 :: Key a
key2 iv :: IV a
iv b :: PlaintextBS a
b) = "XTS(key1=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Key a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key a
key1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",key2=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Key a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key a
key2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",iv=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (IV a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes IV a
iv) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",input=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PlaintextBS a -> String
forall a. Show a => a -> String
show PlaintextBS a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Show (AEADUnit a) where
    show :: AEADUnit a -> String
show (AEADUnit key :: Key a
key iv :: ByteString
iv aad :: Plaintext a
aad b :: Plaintext a
b) = "AEAD(key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Key a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key a
key) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",iv=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
iv String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",aad=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Plaintext a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Plaintext a
aad) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",input=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Plaintext a -> String
forall a. Show a => a -> String
show Plaintext a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Show (StreamUnit a) where
    show :: StreamUnit a -> String
show (StreamUnit key :: Key a
key b :: Plaintext a
b) = "Stream(key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Key a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key a
key) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ",input=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Plaintext a -> String
forall a. Show a => a -> String
show Plaintext a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"

-- | Generate an arbitrary valid key for a specific block cipher
generateKey :: Cipher a => Gen (Key a)
generateKey :: Gen (Key a)
generateKey = a -> Gen (Key a)
forall a. Cipher a => a -> Gen (Key a)
keyFromCipher a
forall a. HasCallStack => a
undefined
  where keyFromCipher :: Cipher a => a -> Gen (Key a)
        keyFromCipher :: a -> Gen (Key a)
keyFromCipher cipher :: a
cipher = do
            Int
sz <- case a -> KeySizeSpecifier
forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
cipherKeySize a
cipher of
                         KeySizeRange low :: Int
low high :: Int
high -> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
low, Int
high)
                         KeySizeFixed v :: Int
v -> Int -> Gen Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
v
                         KeySizeEnum l :: [Int]
l  -> [Int] -> Gen Int
forall a. [a] -> Gen a
elements [Int]
l
            (KeyError -> Key a)
-> (Key a -> Key a) -> Either KeyError (Key a) -> Key a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Key a
forall a. HasCallStack => String -> a
error (String -> Key a) -> (KeyError -> String) -> KeyError -> Key a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyError -> String
forall a. Show a => a -> String
show) Key a -> Key a
forall a. a -> a
id (Either KeyError (Key a) -> Key a)
-> ([Word8] -> Either KeyError (Key a)) -> [Word8] -> Key a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either KeyError (Key a)
forall b c.
(ToSecureMem b, Cipher c) =>
b -> Either KeyError (Key c)
makeKey (ByteString -> Either KeyError (Key a))
-> ([Word8] -> ByteString) -> [Word8] -> Either KeyError (Key a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack ([Word8] -> Key a) -> Gen [Word8] -> Gen (Key a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
sz Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Generate an arbitrary valid IV for a specific block cipher
generateIv :: BlockCipher a => Gen (IV a)
generateIv :: Gen (IV a)
generateIv = a -> Gen (IV a)
forall a. BlockCipher a => a -> Gen (IV a)
ivFromCipher a
forall a. HasCallStack => a
undefined
  where ivFromCipher :: BlockCipher a => a -> Gen (IV a)
        ivFromCipher :: a -> Gen (IV a)
ivFromCipher cipher :: a
cipher = Maybe (IV a) -> IV a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (IV a) -> IV a)
-> ([Word8] -> Maybe (IV a)) -> [Word8] -> IV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (IV a)
forall b c. (Byteable b, BlockCipher c) => b -> Maybe (IV c)
makeIV (ByteString -> Maybe (IV a))
-> ([Word8] -> ByteString) -> [Word8] -> Maybe (IV a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack ([Word8] -> IV a) -> Gen [Word8] -> Gen (IV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (a -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize a
cipher) Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Generate an arbitrary valid IV for AEAD for a specific block cipher
generateIvAEAD :: Gen B.ByteString
generateIvAEAD :: Gen ByteString
generateIvAEAD = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (12,90) Gen Int -> (Int -> Gen ByteString) -> Gen ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \sz :: Int
sz -> ([Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
sz Gen Word8
forall a. Arbitrary a => Gen a
arbitrary)

-- | Generate a plaintext multiple of blocksize bytes
generatePlaintextMultipleBS :: BlockCipher a => Gen (PlaintextBS a)
generatePlaintextMultipleBS :: Gen (PlaintextBS a)
generatePlaintextMultipleBS = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1,128) Gen Int -> (Int -> Gen (PlaintextBS a)) -> Gen (PlaintextBS a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \size :: Int
size -> Int -> Gen Word8 -> Gen [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) Gen Word8
forall a. Arbitrary a => Gen a
arbitrary Gen [Word8]
-> ([Word8] -> Gen (PlaintextBS a)) -> Gen (PlaintextBS a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PlaintextBS a -> Gen (PlaintextBS a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaintextBS a -> Gen (PlaintextBS a))
-> ([Word8] -> PlaintextBS a) -> [Word8] -> Gen (PlaintextBS a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PlaintextBS a
forall a. ByteString -> PlaintextBS a
PlaintextBS (ByteString -> PlaintextBS a)
-> ([Word8] -> ByteString) -> [Word8] -> PlaintextBS a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack

-- | Generate any sized plaintext
generatePlaintext :: Gen (Plaintext a)
generatePlaintext :: Gen (Plaintext a)
generatePlaintext = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (0,324) Gen Int -> (Int -> Gen (Plaintext a)) -> Gen (Plaintext a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \size :: Int
size -> Int -> Gen Word8 -> Gen [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
size Gen Word8
forall a. Arbitrary a => Gen a
arbitrary Gen [Word8] -> ([Word8] -> Gen (Plaintext a)) -> Gen (Plaintext a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Plaintext a -> Gen (Plaintext a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Plaintext a -> Gen (Plaintext a))
-> ([Word8] -> Plaintext a) -> [Word8] -> Gen (Plaintext a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Plaintext a
forall a. ByteString -> Plaintext a
Plaintext (ByteString -> Plaintext a)
-> ([Word8] -> ByteString) -> [Word8] -> Plaintext a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack

instance BlockCipher a => Arbitrary (ECBUnit a) where
    arbitrary :: Gen (ECBUnit a)
arbitrary = Key a -> PlaintextBS a -> ECBUnit a
forall a. Key a -> PlaintextBS a -> ECBUnit a
ECBUnit (Key a -> PlaintextBS a -> ECBUnit a)
-> Gen (Key a) -> Gen (PlaintextBS a -> ECBUnit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Key a)
forall a. Cipher a => Gen (Key a)
generateKey
                        Gen (PlaintextBS a -> ECBUnit a)
-> Gen (PlaintextBS a) -> Gen (ECBUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (PlaintextBS a)
forall a. BlockCipher a => Gen (PlaintextBS a)
generatePlaintextMultipleBS

instance BlockCipher a => Arbitrary (CBCUnit a) where
    arbitrary :: Gen (CBCUnit a)
arbitrary = Key a -> IV a -> PlaintextBS a -> CBCUnit a
forall a. Key a -> IV a -> PlaintextBS a -> CBCUnit a
CBCUnit (Key a -> IV a -> PlaintextBS a -> CBCUnit a)
-> Gen (Key a) -> Gen (IV a -> PlaintextBS a -> CBCUnit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Key a)
forall a. Cipher a => Gen (Key a)
generateKey
                        Gen (IV a -> PlaintextBS a -> CBCUnit a)
-> Gen (IV a) -> Gen (PlaintextBS a -> CBCUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (IV a)
forall a. BlockCipher a => Gen (IV a)
generateIv
                        Gen (PlaintextBS a -> CBCUnit a)
-> Gen (PlaintextBS a) -> Gen (CBCUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (PlaintextBS a)
forall a. BlockCipher a => Gen (PlaintextBS a)
generatePlaintextMultipleBS

instance BlockCipher a => Arbitrary (CFBUnit a) where
    arbitrary :: Gen (CFBUnit a)
arbitrary = Key a -> IV a -> PlaintextBS a -> CFBUnit a
forall a. Key a -> IV a -> PlaintextBS a -> CFBUnit a
CFBUnit (Key a -> IV a -> PlaintextBS a -> CFBUnit a)
-> Gen (Key a) -> Gen (IV a -> PlaintextBS a -> CFBUnit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Key a)
forall a. Cipher a => Gen (Key a)
generateKey
                        Gen (IV a -> PlaintextBS a -> CFBUnit a)
-> Gen (IV a) -> Gen (PlaintextBS a -> CFBUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (IV a)
forall a. BlockCipher a => Gen (IV a)
generateIv
                        Gen (PlaintextBS a -> CFBUnit a)
-> Gen (PlaintextBS a) -> Gen (CFBUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (PlaintextBS a)
forall a. BlockCipher a => Gen (PlaintextBS a)
generatePlaintextMultipleBS

instance BlockCipher a => Arbitrary (CFB8Unit a) where
    arbitrary :: Gen (CFB8Unit a)
arbitrary = Key a -> IV a -> Plaintext a -> CFB8Unit a
forall a. Key a -> IV a -> Plaintext a -> CFB8Unit a
CFB8Unit (Key a -> IV a -> Plaintext a -> CFB8Unit a)
-> Gen (Key a) -> Gen (IV a -> Plaintext a -> CFB8Unit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Key a)
forall a. Cipher a => Gen (Key a)
generateKey Gen (IV a -> Plaintext a -> CFB8Unit a)
-> Gen (IV a) -> Gen (Plaintext a -> CFB8Unit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (IV a)
forall a. BlockCipher a => Gen (IV a)
generateIv Gen (Plaintext a -> CFB8Unit a)
-> Gen (Plaintext a) -> Gen (CFB8Unit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Plaintext a)
forall a. Gen (Plaintext a)
generatePlaintext

instance BlockCipher a => Arbitrary (CTRUnit a) where
    arbitrary :: Gen (CTRUnit a)
arbitrary = Key a -> IV a -> Plaintext a -> CTRUnit a
forall a. Key a -> IV a -> Plaintext a -> CTRUnit a
CTRUnit (Key a -> IV a -> Plaintext a -> CTRUnit a)
-> Gen (Key a) -> Gen (IV a -> Plaintext a -> CTRUnit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Key a)
forall a. Cipher a => Gen (Key a)
generateKey
                        Gen (IV a -> Plaintext a -> CTRUnit a)
-> Gen (IV a) -> Gen (Plaintext a -> CTRUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (IV a)
forall a. BlockCipher a => Gen (IV a)
generateIv
                        Gen (Plaintext a -> CTRUnit a)
-> Gen (Plaintext a) -> Gen (CTRUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Plaintext a)
forall a. Gen (Plaintext a)
generatePlaintext

instance BlockCipher a => Arbitrary (XTSUnit a) where
    arbitrary :: Gen (XTSUnit a)
arbitrary = Key a -> Key a -> IV a -> PlaintextBS a -> XTSUnit a
forall a. Key a -> Key a -> IV a -> PlaintextBS a -> XTSUnit a
XTSUnit (Key a -> Key a -> IV a -> PlaintextBS a -> XTSUnit a)
-> Gen (Key a) -> Gen (Key a -> IV a -> PlaintextBS a -> XTSUnit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Key a)
forall a. Cipher a => Gen (Key a)
generateKey
                        Gen (Key a -> IV a -> PlaintextBS a -> XTSUnit a)
-> Gen (Key a) -> Gen (IV a -> PlaintextBS a -> XTSUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Key a)
forall a. Cipher a => Gen (Key a)
generateKey
                        Gen (IV a -> PlaintextBS a -> XTSUnit a)
-> Gen (IV a) -> Gen (PlaintextBS a -> XTSUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (IV a)
forall a. BlockCipher a => Gen (IV a)
generateIv
                        Gen (PlaintextBS a -> XTSUnit a)
-> Gen (PlaintextBS a) -> Gen (XTSUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (PlaintextBS a)
forall a. BlockCipher a => Gen (PlaintextBS a)
generatePlaintextMultipleBS

instance BlockCipher a => Arbitrary (AEADUnit a) where
    arbitrary :: Gen (AEADUnit a)
arbitrary = Key a -> ByteString -> Plaintext a -> Plaintext a -> AEADUnit a
forall a.
Key a -> ByteString -> Plaintext a -> Plaintext a -> AEADUnit a
AEADUnit (Key a -> ByteString -> Plaintext a -> Plaintext a -> AEADUnit a)
-> Gen (Key a)
-> Gen (ByteString -> Plaintext a -> Plaintext a -> AEADUnit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Key a)
forall a. Cipher a => Gen (Key a)
generateKey
                         Gen (ByteString -> Plaintext a -> Plaintext a -> AEADUnit a)
-> Gen ByteString -> Gen (Plaintext a -> Plaintext a -> AEADUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
generateIvAEAD
                         Gen (Plaintext a -> Plaintext a -> AEADUnit a)
-> Gen (Plaintext a) -> Gen (Plaintext a -> AEADUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Plaintext a)
forall a. Gen (Plaintext a)
generatePlaintext
                         Gen (Plaintext a -> AEADUnit a)
-> Gen (Plaintext a) -> Gen (AEADUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Plaintext a)
forall a. Gen (Plaintext a)
generatePlaintext

instance StreamCipher a => Arbitrary (StreamUnit a) where
    arbitrary :: Gen (StreamUnit a)
arbitrary = Key a -> Plaintext a -> StreamUnit a
forall a. Key a -> Plaintext a -> StreamUnit a
StreamUnit (Key a -> Plaintext a -> StreamUnit a)
-> Gen (Key a) -> Gen (Plaintext a -> StreamUnit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Key a)
forall a. Cipher a => Gen (Key a)
generateKey
                           Gen (Plaintext a -> StreamUnit a)
-> Gen (Plaintext a) -> Gen (StreamUnit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Plaintext a)
forall a. Gen (Plaintext a)
generatePlaintext

testBlockCipherBasic :: BlockCipher a => a -> [Test]
testBlockCipherBasic :: a -> [Test]
testBlockCipherBasic cipher :: a
cipher = [ String -> (ECBUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "ECB" ECBUnit a -> Bool
ecbProp ]
  where ecbProp :: ECBUnit a -> Bool
ecbProp = a -> ECBUnit a -> Bool
forall a. BlockCipher a => a -> ECBUnit a -> Bool
toTests a
cipher
        toTests :: BlockCipher a => a -> (ECBUnit a -> Bool)
        toTests :: a -> ECBUnit a -> Bool
toTests _ = ECBUnit a -> Bool
forall cipher. BlockCipher cipher => ECBUnit cipher -> Bool
testProperty_ECB
        testProperty_ECB :: ECBUnit cipher -> Bool
testProperty_ECB (ECBUnit (Key cipher -> cipher
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> cipher
ctx) (PlaintextBS cipher -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext)) =
            ByteString
plaintext ByteString -> ByteString -> Bool
`assertEq` cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbDecrypt cipher
ctx (cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> ByteString -> ByteString
ecbEncrypt cipher
ctx ByteString
plaintext)

testBlockCipherModes :: BlockCipher a => a -> [Test]
testBlockCipherModes :: a -> [Test]
testBlockCipherModes cipher :: a
cipher =
    [ String -> (CBCUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "CBC" CBCUnit a -> Bool
cbcProp
    , String -> (CFBUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "CFB" CFBUnit a -> Bool
cfbProp
    , String -> (CFB8Unit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "CFB8" CFB8Unit a -> Bool
cfb8Prop
    , String -> (CTRUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "CTR" CTRUnit a -> Bool
ctrProp
    ]
  where (cbcProp :: CBCUnit a -> Bool
cbcProp,cfbProp :: CFBUnit a -> Bool
cfbProp,cfb8Prop :: CFB8Unit a -> Bool
cfb8Prop,ctrProp :: CTRUnit a -> Bool
ctrProp) = a
-> (CBCUnit a -> Bool, CFBUnit a -> Bool, CFB8Unit a -> Bool,
    CTRUnit a -> Bool)
forall a.
BlockCipher a =>
a
-> (CBCUnit a -> Bool, CFBUnit a -> Bool, CFB8Unit a -> Bool,
    CTRUnit a -> Bool)
toTests a
cipher
        toTests :: BlockCipher a
                => a
                -> ((CBCUnit a -> Bool), (CFBUnit a -> Bool), (CFB8Unit a -> Bool), (CTRUnit a -> Bool))
        toTests :: a
-> (CBCUnit a -> Bool, CFBUnit a -> Bool, CFB8Unit a -> Bool,
    CTRUnit a -> Bool)
toTests _ = (CBCUnit a -> Bool
forall cipher. BlockCipher cipher => CBCUnit cipher -> Bool
testProperty_CBC
                    ,CFBUnit a -> Bool
forall cipher. BlockCipher cipher => CFBUnit cipher -> Bool
testProperty_CFB
                    ,CFB8Unit a -> Bool
forall a. BlockCipher a => CFB8Unit a -> Bool
testProperty_CFB8
                    ,CTRUnit a -> Bool
forall cipher. BlockCipher cipher => CTRUnit cipher -> Bool
testProperty_CTR
                    )
        testProperty_CBC :: CBCUnit cipher -> Bool
testProperty_CBC (CBCUnit (Key cipher -> cipher
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> cipher
ctx) testIV :: IV cipher
testIV (PlaintextBS cipher -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext)) =
            ByteString
plaintext ByteString -> ByteString -> Bool
`assertEq` cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cbcDecrypt cipher
ctx IV cipher
testIV (cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cbcEncrypt cipher
ctx IV cipher
testIV ByteString
plaintext)

        testProperty_CFB :: CFBUnit cipher -> Bool
testProperty_CFB (CFBUnit (Key cipher -> cipher
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> cipher
ctx) testIV :: IV cipher
testIV (PlaintextBS cipher -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext)) =
            ByteString
plaintext ByteString -> ByteString -> Bool
`assertEq` cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbDecrypt cipher
ctx IV cipher
testIV (cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfbEncrypt cipher
ctx IV cipher
testIV ByteString
plaintext)

        testProperty_CFB8 :: CFB8Unit a -> Bool
testProperty_CFB8 (CFB8Unit (Key a -> a
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> a
ctx) testIV :: IV a
testIV (Plaintext a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext)) =
            ByteString
plaintext ByteString -> ByteString -> Bool
`assertEq` a -> IV a -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfb8Decrypt a
ctx IV a
testIV (a -> IV a -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
cfb8Encrypt a
ctx IV a
testIV ByteString
plaintext)

        testProperty_CTR :: CTRUnit cipher -> Bool
testProperty_CTR (CTRUnit (Key cipher -> cipher
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> cipher
ctx) testIV :: IV cipher
testIV (Plaintext cipher -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext)) =
            ByteString
plaintext ByteString -> ByteString -> Bool
`assertEq` cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
ctrCombine cipher
ctx IV cipher
testIV (cipher -> IV cipher -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
cipher -> IV cipher -> ByteString -> ByteString
ctrCombine cipher
ctx IV cipher
testIV ByteString
plaintext)

testBlockCipherAEAD :: BlockCipher a => a -> [Test]
testBlockCipherAEAD :: a -> [Test]
testBlockCipherAEAD cipher :: a
cipher =
    [ String -> (AEADUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "OCB" (AEADMode -> AEADUnit a -> Bool
aeadProp AEADMode
AEAD_OCB)
    , String -> (AEADUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "CCM" (AEADMode -> AEADUnit a -> Bool
aeadProp AEADMode
AEAD_CCM)
    , String -> (AEADUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "EAX" (AEADMode -> AEADUnit a -> Bool
aeadProp AEADMode
AEAD_EAX)
    , String -> (AEADUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "CWC" (AEADMode -> AEADUnit a -> Bool
aeadProp AEADMode
AEAD_CWC)
    , String -> (AEADUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "GCM" (AEADMode -> AEADUnit a -> Bool
aeadProp AEADMode
AEAD_GCM)
    ]
  where aeadProp :: AEADMode -> AEADUnit a -> Bool
aeadProp = a -> AEADMode -> AEADUnit a -> Bool
forall a. BlockCipher a => a -> AEADMode -> AEADUnit a -> Bool
toTests a
cipher
        toTests :: BlockCipher a => a -> (AEADMode -> AEADUnit a -> Bool)
        toTests :: a -> AEADMode -> AEADUnit a -> Bool
toTests _ = AEADMode -> AEADUnit a -> Bool
forall cipher.
BlockCipher cipher =>
AEADMode -> AEADUnit cipher -> Bool
testProperty_AEAD
        testProperty_AEAD :: AEADMode -> AEADUnit cipher -> Bool
testProperty_AEAD mode :: AEADMode
mode (AEADUnit (Key cipher -> cipher
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> cipher
ctx) testIV :: ByteString
testIV (Plaintext cipher -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
aad) (Plaintext cipher -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext)) =
            case AEADMode -> cipher -> ByteString -> Maybe (AEAD cipher)
forall cipher iv.
(BlockCipher cipher, Byteable iv) =>
AEADMode -> cipher -> iv -> Maybe (AEAD cipher)
aeadInit AEADMode
mode cipher
ctx ByteString
testIV of
                Just iniAead :: AEAD cipher
iniAead ->
                    let aead :: AEAD cipher
aead           = AEAD cipher -> ByteString -> AEAD cipher
forall a. BlockCipher a => AEAD a -> ByteString -> AEAD a
aeadAppendHeader AEAD cipher
iniAead ByteString
aad
                        (eText :: ByteString
eText, aeadE :: AEAD cipher
aeadE) = AEAD cipher -> ByteString -> (ByteString, AEAD cipher)
forall a.
BlockCipher a =>
AEAD a -> ByteString -> (ByteString, AEAD a)
aeadEncrypt AEAD cipher
aead ByteString
plaintext
                        (dText :: ByteString
dText, aeadD :: AEAD cipher
aeadD) = AEAD cipher -> ByteString -> (ByteString, AEAD cipher)
forall a.
BlockCipher a =>
AEAD a -> ByteString -> (ByteString, AEAD a)
aeadDecrypt AEAD cipher
aead ByteString
eText
                        eTag :: AuthTag
eTag           = AEAD cipher -> Int -> AuthTag
forall a. BlockCipher a => AEAD a -> Int -> AuthTag
aeadFinalize AEAD cipher
aeadE (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
ctx)
                        dTag :: AuthTag
dTag           = AEAD cipher -> Int -> AuthTag
forall a. BlockCipher a => AEAD a -> Int -> AuthTag
aeadFinalize AEAD cipher
aeadD (cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
ctx)
                     in (ByteString
plaintext ByteString -> ByteString -> Bool
`assertEq` ByteString
dText) Bool -> Bool -> Bool
&& (AuthTag -> ByteString
forall a. Byteable a => a -> ByteString
toBytes AuthTag
eTag ByteString -> ByteString -> Bool
`assertEq` AuthTag -> ByteString
forall a. Byteable a => a -> ByteString
toBytes AuthTag
dTag)
                Nothing -> Bool
True

testBlockCipherXTS :: BlockCipher a => a -> [Test]
testBlockCipherXTS :: a -> [Test]
testBlockCipherXTS cipher :: a
cipher = [String -> (XTSUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "XTS" XTSUnit a -> Bool
xtsProp]
  where xtsProp :: XTSUnit a -> Bool
xtsProp = a -> XTSUnit a -> Bool
forall a. BlockCipher a => a -> XTSUnit a -> Bool
toTests a
cipher
        toTests :: BlockCipher a => a -> (XTSUnit a -> Bool)
        toTests :: a -> XTSUnit a -> Bool
toTests _ = XTSUnit a -> Bool
forall cipher. BlockCipher cipher => XTSUnit cipher -> Bool
testProperty_XTS

        testProperty_XTS :: XTSUnit cipher -> Bool
testProperty_XTS (XTSUnit (Key cipher -> cipher
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> cipher
ctx1) (Key cipher -> cipher
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> cipher
ctx2) testIV :: IV cipher
testIV (PlaintextBS cipher -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext))
            | cipher -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize cipher
ctx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 16 = ByteString
plaintext ByteString -> ByteString -> Bool
`assertEq` (cipher, cipher)
-> IV cipher -> DataUnitOffset -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
(cipher, cipher)
-> IV cipher -> DataUnitOffset -> ByteString -> ByteString
xtsDecrypt (cipher
ctx1, cipher
ctx2) IV cipher
testIV 0 ((cipher, cipher)
-> IV cipher -> DataUnitOffset -> ByteString -> ByteString
forall cipher.
BlockCipher cipher =>
(cipher, cipher)
-> IV cipher -> DataUnitOffset -> ByteString -> ByteString
xtsEncrypt (cipher
ctx1, cipher
ctx2) IV cipher
testIV 0 ByteString
plaintext)
            | Bool
otherwise            = Bool
True

-- | Test a generic block cipher for properties
-- related to block cipher modes.
testModes :: BlockCipher a => a -> [Test]
testModes :: a -> [Test]
testModes cipher :: a
cipher =
    [ String -> [Test] -> Test
testGroup "decrypt.encrypt==id"
        (a -> [Test]
forall a. BlockCipher a => a -> [Test]
testBlockCipherBasic a
cipher [Test] -> [Test] -> [Test]
forall a. [a] -> [a] -> [a]
++ a -> [Test]
forall a. BlockCipher a => a -> [Test]
testBlockCipherModes a
cipher [Test] -> [Test] -> [Test]
forall a. [a] -> [a] -> [a]
++ a -> [Test]
forall a. BlockCipher a => a -> [Test]
testBlockCipherAEAD a
cipher [Test] -> [Test] -> [Test]
forall a. [a] -> [a] -> [a]
++ a -> [Test]
forall a. BlockCipher a => a -> [Test]
testBlockCipherXTS a
cipher)
    ]

-- | Test a generic block cipher for properties
-- related to BlockCipherIO cipher modes.
testIOModes :: BlockCipherIO a => a -> [Test]
testIOModes :: a -> [Test]
testIOModes cipher :: a
cipher =
    [ String -> [Test] -> Test
testGroup "mutable"
        [ String -> (ECBUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "ECB" (a -> ECBUnit a -> Bool
forall a. BlockCipherIO a => a -> ECBUnit a -> Bool
testProperty_ECB a
cipher)
        , String -> (CBCUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "CBC" (a -> CBCUnit a -> Bool
forall a. BlockCipherIO a => a -> CBCUnit a -> Bool
testProperty_CBC a
cipher) ]
    ]
  where testProperty_ECB :: BlockCipherIO a => a -> (ECBUnit a) -> Bool
        testProperty_ECB :: a -> ECBUnit a -> Bool
testProperty_ECB _ (ECBUnit (Key a -> a
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> a
ctx) (PlaintextBS a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext)) =
            ByteString
plaintext ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate (ByteString -> Int
B.length ByteString
plaintext) Ptr Word8 -> IO ()
encryptDecryptMutable
          where encryptDecryptMutable :: Ptr Word8 -> IO ()
encryptDecryptMutable buf :: Ptr Word8
buf = ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Byteable a => a -> (Ptr Word8 -> IO b) -> IO b
withBytePtr ByteString
plaintext ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \src :: Ptr Word8
src -> do
                    a -> Ptr Word8 -> Ptr Word8 -> DataUnitOffset -> IO ()
forall cipher.
BlockCipherIO cipher =>
cipher -> Ptr Word8 -> Ptr Word8 -> DataUnitOffset -> IO ()
ecbEncryptMutable a
ctx Ptr Word8
buf Ptr Word8
src (Int -> DataUnitOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> DataUnitOffset) -> Int -> DataUnitOffset
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
plaintext)
                    a -> Ptr Word8 -> Ptr Word8 -> DataUnitOffset -> IO ()
forall cipher.
BlockCipherIO cipher =>
cipher -> Ptr Word8 -> Ptr Word8 -> DataUnitOffset -> IO ()
ecbDecryptMutable a
ctx Ptr Word8
buf Ptr Word8
buf (Int -> DataUnitOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> DataUnitOffset) -> Int -> DataUnitOffset
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
plaintext)

        testProperty_CBC :: BlockCipherIO a => a -> (CBCUnit a) -> Bool
        testProperty_CBC :: a -> CBCUnit a -> Bool
testProperty_CBC _ (CBCUnit (Key a -> a
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> a
ctx) testIV :: IV a
testIV (PlaintextBS a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext)) =
            ByteString
plaintext ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate (ByteString -> Int
B.length ByteString
plaintext) Ptr Word8 -> IO ()
encryptDecryptMutable
          where encryptDecryptMutable :: Ptr Word8 -> IO ()
encryptDecryptMutable buf :: Ptr Word8
buf =
                    IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ByteString -> IO ()) -> IO ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (ByteString -> Int
B.length ByteString
plaintext) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \tmp :: Ptr Word8
tmp ->
                    ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Byteable a => a -> (Ptr Word8 -> IO b) -> IO b
withBytePtr ByteString
plaintext ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \src :: Ptr Word8
src ->
                    IV a -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Byteable a => a -> (Ptr Word8 -> IO b) -> IO b
withBytePtr IV a
testIV ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \iv :: Ptr Word8
iv -> do
                        a -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> DataUnitOffset -> IO ()
forall cipher.
BlockCipherIO cipher =>
cipher
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> DataUnitOffset -> IO ()
cbcEncryptMutable a
ctx Ptr Word8
iv Ptr Word8
tmp Ptr Word8
src (Int -> DataUnitOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> DataUnitOffset) -> Int -> DataUnitOffset
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
plaintext)
                        a -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> DataUnitOffset -> IO ()
forall cipher.
BlockCipherIO cipher =>
cipher
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> DataUnitOffset -> IO ()
cbcDecryptMutable a
ctx Ptr Word8
iv Ptr Word8
buf Ptr Word8
tmp (Int -> DataUnitOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> DataUnitOffset) -> Int -> DataUnitOffset
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
plaintext)
                    
-- | Test stream mode
testStream :: StreamCipher a => a -> [Test]
testStream :: a -> [Test]
testStream cipher :: a
cipher = [String -> (StreamUnit a -> Bool) -> Test
forall a. Testable a => String -> a -> Test
testProperty "combine.combine==id" (a -> StreamUnit a -> Bool
forall a. StreamCipher a => a -> StreamUnit a -> Bool
testStreamUnit a
cipher)]
  where testStreamUnit :: StreamCipher a => a -> (StreamUnit a -> Bool)
        testStreamUnit :: a -> StreamUnit a -> Bool
testStreamUnit _ (StreamUnit (Key a -> a
forall cipher. Cipher cipher => Key cipher -> cipher
cipherInit -> a
ctx) (Plaintext a -> ByteString
forall a. Byteable a => a -> ByteString
toBytes -> ByteString
plaintext)) =
            let cipherText :: ByteString
cipherText = (ByteString, a) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, a) -> ByteString) -> (ByteString, a) -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString -> (ByteString, a)
forall cipher.
StreamCipher cipher =>
cipher -> ByteString -> (ByteString, cipher)
streamCombine a
ctx ByteString
plaintext
             in (ByteString, a) -> ByteString
forall a b. (a, b) -> a
fst (a -> ByteString -> (ByteString, a)
forall cipher.
StreamCipher cipher =>
cipher -> ByteString -> (ByteString, cipher)
streamCombine a
ctx ByteString
cipherText) ByteString -> ByteString -> Bool
`assertEq` ByteString
plaintext

assertEq :: B.ByteString -> B.ByteString -> Bool
assertEq :: ByteString -> ByteString -> Bool
assertEq b1 :: ByteString
b1 b2 :: ByteString
b2 | ByteString
b1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
b2  = String -> Bool
forall a. HasCallStack => String -> a
error ("b1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
b1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ " b2: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
b2)
               | Bool
otherwise = Bool
True