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 PipeChan
|
||||||
import Connection
|
import Connection
|
||||||
import Marshalling
|
import Marshalling
|
||||||
|
import Ciphers
|
||||||
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
|
@ -160,6 +161,7 @@ assertEq expected got = unless (expected == got) $ error ("got " ++ show got ++
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = defaultMain
|
main = defaultMain
|
||||||
[ tests_marshalling
|
[ tests_marshalling
|
||||||
|
, tests_ciphers
|
||||||
, tests_handshake
|
, tests_handshake
|
||||||
]
|
]
|
||||||
where -- lowlevel tests to check the packet marshalling.
|
where -- lowlevel tests to check the packet marshalling.
|
||||||
|
@ -167,6 +169,8 @@ main = defaultMain
|
||||||
[ testProperty "Header" prop_header_marshalling_id
|
[ testProperty "Header" prop_header_marshalling_id
|
||||||
, testProperty "Handshake" prop_handshake_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.
|
-- high level tests between a client and server with fake ciphers.
|
||||||
tests_handshake = testGroup "Handshakes"
|
tests_handshake = testGroup "Handshakes"
|
||||||
|
|
Loading…
Reference in a new issue