From d6ab57bf6fc3ea52bdce37f481193bc2a213582e Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Sun, 21 Jul 2013 07:24:51 +0100 Subject: [PATCH] move marshalling test in own module --- core/Tests/Marshalling.hs | 108 ++++++++++++++++++++++++++++++++++++++ core/Tests/Tests.hs | 99 +--------------------------------- 2 files changed, 109 insertions(+), 98 deletions(-) create mode 100644 core/Tests/Marshalling.hs diff --git a/core/Tests/Marshalling.hs b/core/Tests/Marshalling.hs new file mode 100644 index 0000000..a814f3f --- /dev/null +++ b/core/Tests/Marshalling.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE CPP #-} +module Marshalling where + +import Control.Monad +import Control.Applicative +import Test.QuickCheck +import Test.QuickCheck.Monadic +import Network.TLS.Internal +import Network.TLS + +import qualified Data.ByteString as B +import Data.Word +import Data.X509 +import Certificate + +genByteString :: Int -> Gen B.ByteString +genByteString i = B.pack <$> vector i + +instance Arbitrary Version where + arbitrary = elements [ SSL2, SSL3, TLS10, TLS11, TLS12 ] + +instance Arbitrary ProtocolType where + arbitrary = elements + [ ProtocolType_ChangeCipherSpec + , ProtocolType_Alert + , ProtocolType_Handshake + , ProtocolType_AppData ] + +#if MIN_VERSION_QuickCheck(2,3,0) +#else +instance Arbitrary Word8 where + arbitrary = fromIntegral <$> (choose (0,255) :: Gen Int) + +instance Arbitrary Word16 where + arbitrary = fromIntegral <$> (choose (0,65535) :: Gen Int) +#endif + +instance Arbitrary Header where + arbitrary = Header <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary ClientRandom where + arbitrary = ClientRandom <$> (genByteString 32) + +instance Arbitrary ServerRandom where + arbitrary = ServerRandom <$> (genByteString 32) + +instance Arbitrary Session where + arbitrary = do + i <- choose (1,2) :: Gen Int + case i of + 2 -> liftM (Session . Just) (genByteString 32) + _ -> return $ Session Nothing + +instance Arbitrary CertVerifyData where + arbitrary = liftM CertVerifyData (genByteString 128) + +arbitraryCiphersIDs :: Gen [Word16] +arbitraryCiphersIDs = choose (0,200) >>= vector + +arbitraryCompressionIDs :: Gen [Word8] +arbitraryCompressionIDs = choose (0,200) >>= vector + +someWords8 :: Int -> Gen [Word8] +someWords8 i = replicateM i (fromIntegral <$> (choose (0,255) :: Gen Int)) + +instance Arbitrary CertificateType where + arbitrary = elements + [ CertificateType_RSA_Sign, CertificateType_DSS_Sign + , CertificateType_RSA_Fixed_DH, CertificateType_DSS_Fixed_DH + , CertificateType_RSA_Ephemeral_DH, CertificateType_DSS_Ephemeral_DH + , CertificateType_fortezza_dms ] + +instance Arbitrary Handshake where + arbitrary = oneof + [ ClientHello + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitraryCiphersIDs + <*> arbitraryCompressionIDs + <*> (return []) + <*> (return Nothing) + , ServerHello + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> (return []) + , liftM Certificates (CertificateChain <$> (resize 2 $ listOf $ arbitraryX509)) + , pure HelloRequest + , pure ServerHelloDone + , ClientKeyXchg <$> genByteString 48 + --, liftM ServerKeyXchg + , liftM3 CertRequest arbitrary (return Nothing) (return []) + , liftM2 CertVerify (return Nothing) arbitrary + , Finished <$> (genByteString 12) + ] + +{- quickcheck property -} + +prop_header_marshalling_id :: Header -> Bool +prop_header_marshalling_id x = (decodeHeader $ encodeHeader x) == Right x + +prop_handshake_marshalling_id :: Handshake -> Bool +prop_handshake_marshalling_id x = (decodeHs $ encodeHandshake x) == Right x + where decodeHs b = either (Left . id) (uncurry (decodeHandshake cp) . head) $ decodeHandshakes b + cp = CurrentParams { cParamsVersion = TLS10, cParamsKeyXchgType = CipherKeyExchange_RSA, cParamsSupportNPN = True } diff --git a/core/Tests/Tests.hs b/core/Tests/Tests.hs index 93daf8e..03ba8b2 100644 --- a/core/Tests/Tests.hs +++ b/core/Tests/Tests.hs @@ -5,18 +5,16 @@ import Test.QuickCheck.Monadic import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) -import Certificate import PipeChan import Connection +import Marshalling import Data.Maybe -import Data.Word import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as L import Network.TLS -import Network.TLS.Internal import Control.Applicative import Control.Concurrent import Control.Exception (throw, SomeException) @@ -24,101 +22,6 @@ import qualified Control.Exception as E import Control.Monad import Data.IORef -import Data.X509 - -genByteString :: Int -> Gen B.ByteString -genByteString i = B.pack <$> vector i - -instance Arbitrary Version where - arbitrary = elements [ SSL2, SSL3, TLS10, TLS11, TLS12 ] - -instance Arbitrary ProtocolType where - arbitrary = elements - [ ProtocolType_ChangeCipherSpec - , ProtocolType_Alert - , ProtocolType_Handshake - , ProtocolType_AppData ] - -#if MIN_VERSION_QuickCheck(2,3,0) -#else -instance Arbitrary Word8 where - arbitrary = fromIntegral <$> (choose (0,255) :: Gen Int) - -instance Arbitrary Word16 where - arbitrary = fromIntegral <$> (choose (0,65535) :: Gen Int) -#endif - -instance Arbitrary Header where - arbitrary = Header <$> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary ClientRandom where - arbitrary = ClientRandom <$> (genByteString 32) - -instance Arbitrary ServerRandom where - arbitrary = ServerRandom <$> (genByteString 32) - -instance Arbitrary Session where - arbitrary = do - i <- choose (1,2) :: Gen Int - case i of - 2 -> liftM (Session . Just) (genByteString 32) - _ -> return $ Session Nothing - -instance Arbitrary CertVerifyData where - arbitrary = liftM CertVerifyData (genByteString 128) - -arbitraryCiphersIDs :: Gen [Word16] -arbitraryCiphersIDs = choose (0,200) >>= vector - -arbitraryCompressionIDs :: Gen [Word8] -arbitraryCompressionIDs = choose (0,200) >>= vector - -someWords8 :: Int -> Gen [Word8] -someWords8 i = replicateM i (fromIntegral <$> (choose (0,255) :: Gen Int)) - -instance Arbitrary CertificateType where - arbitrary = elements - [ CertificateType_RSA_Sign, CertificateType_DSS_Sign - , CertificateType_RSA_Fixed_DH, CertificateType_DSS_Fixed_DH - , CertificateType_RSA_Ephemeral_DH, CertificateType_DSS_Ephemeral_DH - , CertificateType_fortezza_dms ] - -instance Arbitrary Handshake where - arbitrary = oneof - [ ClientHello - <$> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitraryCiphersIDs - <*> arbitraryCompressionIDs - <*> (return []) - <*> (return Nothing) - , ServerHello - <$> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> (return []) - , liftM Certificates (CertificateChain <$> (resize 2 $ listOf $ arbitraryX509)) - , pure HelloRequest - , pure ServerHelloDone - , ClientKeyXchg <$> genByteString 48 - --, liftM ServerKeyXchg - , liftM3 CertRequest arbitrary (return Nothing) (return []) - , liftM2 CertVerify (return Nothing) arbitrary - , Finished <$> (genByteString 12) - ] - -{- quickcheck property -} - -prop_header_marshalling_id :: Header -> Bool -prop_header_marshalling_id x = (decodeHeader $ encodeHeader x) == Right x - -prop_handshake_marshalling_id :: Handshake -> Bool -prop_handshake_marshalling_id x = (decodeHs $ encodeHandshake x) == Right x - where decodeHs b = either (Left . id) (uncurry (decodeHandshake cp) . head) $ decodeHandshakes b - cp = CurrentParams { cParamsVersion = TLS10, cParamsKeyXchgType = CipherKeyExchange_RSA, cParamsSupportNPN = True } prop_pipe_work :: PropertyM IO () prop_pipe_work = do