add ciphers tests.
This commit is contained in:
parent
182ef6a096
commit
4905fb1ecb
2 changed files with 42 additions and 0 deletions
38
core/Tests/Ciphers.hs
Normal file
38
core/Tests/Ciphers.hs
Normal file
|
@ -0,0 +1,38 @@
|
|||
module Ciphers
|
||||
( propertyBulkFunctional
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
|
||||
import Test.QuickCheck
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import Network.TLS.Cipher
|
||||
import Network.TLS.Extra.Cipher
|
||||
|
||||
arbitraryKey :: Bulk -> Gen B.ByteString
|
||||
arbitraryKey bulk = B.pack `fmap` vector (fromIntegral $ bulkKeySize bulk)
|
||||
|
||||
arbitraryIV :: Bulk -> Gen B.ByteString
|
||||
arbitraryIV bulk = B.pack `fmap` vector (fromIntegral $ bulkIVSize bulk)
|
||||
|
||||
arbitraryText :: Bulk -> Gen B.ByteString
|
||||
arbitraryText bulk = B.pack `fmap` vector (fromIntegral $ bulkBlockSize bulk)
|
||||
|
||||
data BulkTest = BulkTest Bulk B.ByteString B.ByteString B.ByteString
|
||||
deriving (Show,Eq)
|
||||
|
||||
instance Arbitrary BulkTest where
|
||||
arbitrary = do
|
||||
bulk <- cipherBulk `fmap` elements ciphersuite_all
|
||||
BulkTest bulk <$> arbitraryKey bulk <*> arbitraryIV bulk <*> arbitraryText bulk
|
||||
|
||||
propertyBulkFunctional :: BulkTest -> Bool
|
||||
propertyBulkFunctional (BulkTest bulk key iv t) =
|
||||
case bulkF bulk of
|
||||
BulkBlockF enc dec -> block enc dec
|
||||
BulkStreamF ktoi enc dec -> stream ktoi enc dec
|
||||
where
|
||||
block e d = (d key iv . e key iv) t == t
|
||||
stream ktoi e d = (fst . d siv . fst . e siv) t == t
|
||||
where siv = ktoi key
|
|
@ -8,6 +8,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
|
|||
import PipeChan
|
||||
import Connection
|
||||
import Marshalling
|
||||
import Ciphers
|
||||
|
||||
import Data.Maybe
|
||||
|
||||
|
@ -160,6 +161,7 @@ assertEq expected got = unless (expected == got) $ error ("got " ++ show got ++
|
|||
main :: IO ()
|
||||
main = defaultMain
|
||||
[ tests_marshalling
|
||||
, tests_ciphers
|
||||
, tests_handshake
|
||||
]
|
||||
where -- lowlevel tests to check the packet marshalling.
|
||||
|
@ -167,6 +169,8 @@ main = defaultMain
|
|||
[ testProperty "Header" prop_header_marshalling_id
|
||||
, testProperty "Handshake" prop_handshake_marshalling_id
|
||||
]
|
||||
tests_ciphers = testGroup "Ciphers"
|
||||
[ testProperty "Bulk" propertyBulkFunctional ]
|
||||
|
||||
-- high level tests between a client and server with fake ciphers.
|
||||
tests_handshake = testGroup "Handshakes"
|
||||
|
|
Loading…
Reference in a new issue