1-- Disable this warning so we can still test deprecated functionality.
2{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
3module Ciphers
4    ( propertyBulkFunctional
5    ) where
6
7import Control.Applicative ((<$>), (<*>))
8
9import Test.Tasty.QuickCheck
10
11import qualified Data.ByteString as B
12import Network.TLS.Cipher
13import Network.TLS.Extra.Cipher
14
15arbitraryKey :: Bulk -> Gen B.ByteString
16arbitraryKey bulk = B.pack `fmap` vector (bulkKeySize bulk)
17
18arbitraryIV :: Bulk -> Gen B.ByteString
19arbitraryIV bulk = B.pack `fmap` vector (bulkIVSize bulk + bulkExplicitIV bulk)
20
21arbitraryText :: Bulk -> Gen B.ByteString
22arbitraryText bulk = B.pack `fmap` vector (bulkBlockSize bulk)
23
24data BulkTest = BulkTest Bulk B.ByteString B.ByteString B.ByteString B.ByteString
25    deriving (Show,Eq)
26
27instance Arbitrary BulkTest where
28    arbitrary = do
29        bulk <- cipherBulk `fmap` elements ciphersuite_all
30        BulkTest bulk <$> arbitraryKey bulk <*> arbitraryIV bulk <*> arbitraryText bulk <*> arbitraryText bulk
31
32propertyBulkFunctional :: BulkTest -> Bool
33propertyBulkFunctional (BulkTest bulk key iv t additional) =
34    let enc = bulkInit bulk BulkEncrypt key
35        dec = bulkInit bulk BulkDecrypt key
36     in case (enc, dec) of
37        (BulkStateBlock encF, BulkStateBlock decF)   -> block encF decF
38        (BulkStateAEAD encF, BulkStateAEAD decF)     -> aead encF decF
39        (BulkStateStream (BulkStream encF), BulkStateStream (BulkStream decF)) -> stream encF decF
40        _                                            -> True
41  where
42        block e d =
43            let (etxt, e_iv) = e iv t
44                (dtxt, d_iv) = d iv etxt
45             in dtxt == t && d_iv == e_iv
46        stream e d = (fst . d . fst . e) t == t
47        aead e d =
48            let (encrypted, at)  = e iv t additional
49                (decrypted, at2) = d iv encrypted additional
50             in decrypted == t && at == at2
51