packages feed

tls 1.0.3 → 1.1.0

raw patch · 18 files changed

+473/−477 lines, 18 filesdep +crypto-pubkeydep +crypto-random-apidep +tlsdep −crypto-apidep −cryptocipherdep ~certificatedep ~cprng-aesPVP ok

version bump matches the API change (PVP)

Dependencies added: crypto-pubkey, crypto-random-api, tls

Dependencies removed: crypto-api, cryptocipher

Dependency ranges changed: certificate, cprng-aes

API changes (from Hackage documentation)

- Network.TLS: Error_Internal_Packet_ByteProcessed :: Int -> Int -> Int -> TLSError
- Network.TLS: Error_Packet_Size_Mismatch :: (Int, Int) -> TLSError
- Network.TLS: Error_Random :: String -> TLSError
- Network.TLS: Error_Unknown_Type :: String -> TLSError
- Network.TLS: Error_Unknown_Version :: Word8 -> Word8 -> TLSError
+ Network.TLS: Terminated :: Bool -> String -> TLSError -> Terminated
+ Network.TLS: data Terminated
- Network.TLS: ServerParams :: Bool -> [X509] -> ([X509] -> IO CertificateUsage) -> (Maybe KxError -> IO Bool) -> (Version -> [Cipher] -> Cipher) -> ServerParams
+ Network.TLS: ServerParams :: Bool -> [X509] -> ([X509] -> IO CertificateUsage) -> IO Bool -> (Version -> [Cipher] -> Cipher) -> ServerParams
- Network.TLS: contextNew :: (MonadIO m, CryptoRandomGen rng) => Backend -> Params -> rng -> m Context
+ Network.TLS: contextNew :: (MonadIO m, CPRG rng) => Backend -> Params -> rng -> m Context
- Network.TLS: contextNewOnHandle :: (MonadIO m, CryptoRandomGen rng) => Handle -> Params -> rng -> m Context
+ Network.TLS: contextNewOnHandle :: (MonadIO m, CPRG rng) => Handle -> Params -> rng -> m Context
- Network.TLS: onUnverifiedClientCert :: ServerParams -> Maybe KxError -> IO Bool
+ Network.TLS: onUnverifiedClientCert :: ServerParams -> IO Bool

Files

Network/TLS.hs view
@@ -91,6 +91,7 @@     , AlertDescription(..)      -- * Exceptions+    , Terminated(..)     , HandshakeFailed(..)     , ConnectionNotEstablished(..)     ) where
Network/TLS/Context.hs view
@@ -85,7 +85,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B -import Crypto.Random+import Crypto.Random.API  import Control.Concurrent.MVar import Control.Monad.State@@ -146,7 +146,7 @@           -- cannot be verified.  A 'Nothing' argument indicates a           -- wrong signature, a 'Just e' message signals a crypto           -- error.-        , onUnverifiedClientCert :: Maybe KxError -> IO Bool+        , onUnverifiedClientCert :: IO Bool          , onCipherChoosing        :: Version -> [Cipher] -> Cipher -- ^ callback on server to modify the cipher chosen.         }@@ -221,7 +221,7 @@                    , onCipherChoosing       = \_ -> head                    , serverCACertificates   = []                    , onClientCertificate    = \ _ -> return $ CertificateUsageReject $ CertificateRejectOther "no client certificates expected"-                   , onUnverifiedClientCert = \ _ -> return False+                   , onUnverifiedClientCert = return False                    }  updateRoleParams :: (ClientParams -> ClientParams) -> (ServerParams -> ServerParams) -> Params -> Params@@ -333,8 +333,8 @@ ctxLogging = pLogging . ctxParams  -- | create a new context using the backend and parameters specified.-contextNew :: (MonadIO m, CryptoRandomGen rng)-           => Backend   -- ^ Backend abstraction with specific method to interacat with the connection type.+contextNew :: (MonadIO m, CPRG rng)+           => Backend   -- ^ Backend abstraction with specific method to interact with the connection type.            -> Params    -- ^ Parameters of the context.            -> rng       -- ^ Random number generator associated with this context.            -> m Context@@ -362,7 +362,7 @@                 }  -- | create a new context on an handle.-contextNewOnHandle :: (MonadIO m, CryptoRandomGen rng)+contextNewOnHandle :: (MonadIO m, CPRG rng)                    => Handle -- ^ Handle of the connection.                    -> Params -- ^ Parameters of the context.                    -> rng    -- ^ Random number generator associated with this context.
Network/TLS/Core.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ScopedTypeVariables #-} -- | -- Module      : Network.TLS.Core -- License     : BSD-style@@ -23,6 +23,7 @@         , getNegotiatedProtocol          -- * High level API+        , Terminated(..)         , sendData         , recvData         , recvData'@@ -30,15 +31,25 @@  import Network.TLS.Context import Network.TLS.Struct+import Network.TLS.State (getSession) import Network.TLS.IO+import Network.TLS.Session import Network.TLS.Handshake+import Data.Typeable import qualified Network.TLS.State as S import qualified Data.ByteString as B import Data.ByteString.Char8 () import qualified Data.ByteString.Lazy as L+import qualified Control.Exception as E  import Control.Monad.State +-- | Early termination exception with the reason and the TLS error associated+data Terminated = Terminated Bool String TLSError+                deriving (Eq,Show,Typeable)++instance E.Exception Terminated+ -- | notify the context that this side wants to close connection. -- this is important that it is called before closing the handle, otherwise -- the session might not be resumable (for version < TLS1.2).@@ -66,35 +77,49 @@ -- | recvData get data out of Data packet, and automatically renegotiate if -- a Handshake ClientHello is received recvData :: MonadIO m => Context -> m B.ByteString-recvData ctx = do-        checkValid ctx-        pkt <- recvPacket ctx-        case pkt of-                -- on server context receiving a client hello == renegotiation-                Right (Handshake [(ClientHello _ _ _ _ _ _ (Just _))]) ->-                        -- reject renegotiation with SSLv2 header-                        case roleParams $ ctxParams ctx of-                            Server _  -> error "assert, deprecated hello request in server context"-                            Client {} -> error "assert, unexpected client hello in client context"-                Right (Handshake [ch@(ClientHello {})]) ->-                        case roleParams $ ctxParams ctx of-                            Server sparams -> handshakeServerWith sparams ctx ch >> recvData ctx-                            Client {}      -> error "assert, unexpected client hello in client context"-                -- on client context, receiving a hello request == renegotiation-                Right (Handshake [HelloRequest]) ->-                        case roleParams $ ctxParams ctx of-                            Server {}      -> error "assert, unexpected hello request in server context"-                            Client cparams -> handshakeClient cparams ctx >> recvData ctx-                Right (Alert [(AlertLevel_Fatal, _)]) -> do-                        setEOF ctx-                        return B.empty-                Right (Alert [(AlertLevel_Warning, CloseNotify)]) -> do-                        setEOF ctx-                        return B.empty-                Right (AppData "") -> recvData ctx-                Right (AppData x)  -> return x-                Right p            -> error ("error unexpected packet: " ++ show p)-                Left err           -> error ("error received: " ++ show err)+recvData ctx = checkValid ctx >> recvPacket ctx >>= either onError process+    where onError err@(Error_Protocol (reason,fatal,desc)) =+            terminate err (if fatal then AlertLevel_Fatal else AlertLevel_Warning) desc reason+          onError err =+            terminate err AlertLevel_Fatal InternalError (show err)++          process (Handshake [ch@(ClientHello {})]) =+            -- on server context receiving a client hello == renegotiation+            case roleParams $ ctxParams ctx of+                Server sparams -> handshakeServerWith sparams ctx ch >> recvData ctx+                Client {}      -> let reason = "unexpected client hello in client context" in+                                  terminate (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason+          process (Handshake [HelloRequest]) =+            -- on client context, receiving a hello request == renegotiation+            case roleParams $ ctxParams ctx of+                Server {}      -> let reason = "unexpected hello request in server context" in+                                  terminate (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason+                Client cparams -> handshakeClient cparams ctx >> recvData ctx++          process (Alert [(AlertLevel_Warning, CloseNotify)]) = tryBye >> setEOF ctx >> return B.empty+          process (Alert [(AlertLevel_Fatal, desc)]) = do+            setEOF ctx+            liftIO $ E.throwIO (Terminated True ("received fatal error: " ++ show desc) (Error_Protocol ("remote side fatal error", True, desc)))++          -- when receiving empty appdata, we just retry to get some data.+          process (AppData "") = recvData ctx+          process (AppData x)  = return x+          process p            = let reason = "unexpected message " ++ show p in+                                 terminate (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason++          terminate :: MonadIO m => TLSError -> AlertLevel -> AlertDescription -> String -> m a+          terminate err level desc reason = do+            session <- usingState_ ctx getSession+            case session of+                Session Nothing    -> return ()+                Session (Just sid) -> withSessionManager (ctxParams ctx) (\s -> liftIO $ sessionInvalidate s sid)+            liftIO $ E.catch (sendPacket ctx $ Alert [(level, desc)]) (\(_ :: E.SomeException) -> return ())+            setEOF ctx+            liftIO $ E.throwIO (Terminated False reason err)++          -- the other side could have close the connection already, so wrap+          -- this in a try and ignore all exceptions+          tryBye = liftIO $ E.catch (bye ctx) (\(_ :: E.SomeException) -> return ())  {-# DEPRECATED recvData' "use recvData that returns strict bytestring" #-} -- | same as recvData but returns a lazy bytestring.
Network/TLS/Crypto.hs view
@@ -14,6 +14,7 @@         -- * key exchange generic interface         , PublicKey(..)         , PrivateKey(..)+        , HashDescr(..)         , kxEncrypt         , kxDecrypt         , kxSign@@ -26,8 +27,10 @@ import qualified Crypto.Hash.MD5 as MD5 import qualified Data.ByteString as B import Data.ByteString (ByteString)-import qualified Crypto.Cipher.RSA as RSA-import Crypto.Random (CryptoRandomGen)+import Crypto.PubKey.HashDescr+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.RSA.PKCS15 as RSA+import Crypto.Random.API  data PublicKey = PubRSA RSA.PublicKey @@ -42,10 +45,6 @@ data KxError = RSAError RSA.Error         deriving (Show) -data KeyXchg =-          KxRSA RSA.PublicKey RSA.PrivateKey-        deriving (Show)- class HashCtxC a where         hashCName      :: a -> String         hashCInit      :: a -> a@@ -96,25 +95,26 @@ hashSHA256  = HashCtx (HashSHA256 SHA256.init)  {- key exchange methods encrypt and decrypt for each supported algorithm -}-generalizeRSAError :: Either RSA.Error a -> Either KxError a-generalizeRSAError (Left e)  = Left (RSAError e)-generalizeRSAError (Right x) = Right x -kxEncrypt :: CryptoRandomGen g => g -> PublicKey -> ByteString -> Either KxError (ByteString, g)-kxEncrypt g (PubRSA pk) b = generalizeRSAError $ RSA.encrypt g pk b+generalizeRSAWithRNG :: CPRG g => (Either RSA.Error a, g) -> (Either KxError a, g)+generalizeRSAWithRNG (Left e, g) = (Left (RSAError e), g)+generalizeRSAWithRNG (Right x, g) = (Right x, g) -kxDecrypt :: PrivateKey -> ByteString -> Either KxError ByteString-kxDecrypt (PrivRSA pk) b  = generalizeRSAError $ RSA.decrypt pk b+kxEncrypt :: CPRG g => g -> PublicKey -> ByteString -> (Either KxError ByteString, g)+kxEncrypt g (PubRSA pk) b = generalizeRSAWithRNG $ RSA.encrypt g pk b +kxDecrypt :: CPRG g => g -> PrivateKey -> ByteString -> (Either KxError ByteString, g)+kxDecrypt g (PrivRSA pk) b = generalizeRSAWithRNG $ RSA.decryptSafer g pk b+ -- Verify that the signature matches the given message, using the -- public key. ---kxVerify :: PublicKey -> (ByteString -> ByteString, ByteString) -> ByteString -> ByteString -> Either KxError Bool-kxVerify (PubRSA pk) (hashF, hashASN1) msg sign =-    generalizeRSAError $ RSA.verify hashF hashASN1 pk msg sign+kxVerify :: PublicKey -> HashDescr -> ByteString -> ByteString -> Bool+kxVerify (PubRSA pk) hashDescr msg sign =+    RSA.verify hashDescr pk msg sign  -- Sign the given message using the private key. ---kxSign :: PrivateKey -> (ByteString -> ByteString, ByteString) -> ByteString -> Either KxError ByteString-kxSign (PrivRSA pk) (hashF, hashASN1) msg  =-    generalizeRSAError $ RSA.sign hashF hashASN1 pk msg+kxSign :: CPRG g => g -> PrivateKey -> HashDescr -> ByteString -> (Either KxError ByteString, g)+kxSign g (PrivRSA pk) hashDescr msg  =+    generalizeRSAWithRNG $ RSA.signSafer g hashDescr pk msg
Network/TLS/Handshake/Client.hs view
@@ -231,14 +231,14 @@                             SSL3 -> do                                 Just masterSecret <- usingState_ ctx $ getMasterSecret                                 let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit hashMD5SHA1) msgs)-                                    hsh = (id, "")+                                    hsh = HashDescr id id                                  sigDig <- usingState_ ctx $ signRSA hsh digest                                 sendPacket ctx $ Handshake [CertVerify Nothing (CertVerifyData sigDig)]                              x | x == TLS10 || x == TLS11 -> do                                 let hashf bs = hashFinal (hashUpdate (hashInit hashMD5SHA1) bs)-                                    hsh = (hashf, "")+                                    hsh = HashDescr hashf id                                  sigDig <- usingState_ ctx $ signRSA hsh msgs                                 sendPacket ctx $ Handshake [CertVerify Nothing (CertVerifyData sigDig)]
Network/TLS/Handshake/Server.hs view
@@ -258,12 +258,12 @@                         SSL3 -> do                             Just masterSecret <- usingState_ ctx $ getMasterSecret                             let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit hashMD5SHA1) msgs)-                                hsh = (id, "")+                                hsh = HashDescr id id                             return (digest, hsh)                          x | x == TLS10 || x == TLS11 -> do                             let hashf bs' = hashFinal (hashUpdate (hashInit hashMD5SHA1) bs')-                                hsh = (hashf, "")+                                hsh = HashDescr hashf id                             return (msgs,hsh)                         _ -> do                             let Just sentHashSig = mbHashSig@@ -274,7 +274,7 @@                     verif <- usingState_ ctx $ verifyRSA hsh signature bs                      case verif of-                        Right True -> do+                        True -> do                             -- When verification succeeds, commit the                             -- client certificate chain to the context.                             --@@ -282,16 +282,13 @@                             usingState_ ctx $ setClientCertificateChain certs                             return () -                        _ -> do+                        False -> do                             -- Either verification failed because of an                             -- invalid format (with an error message), or                             -- the signature is wrong.  In either case,                             -- ask the application if it wants to                             -- proceed, we will do that.-                            let arg = case verif of-                                    Left err -> Just err-                                    _        -> Nothing-                            res <- liftIO $ onUnverifiedClientCert sparams arg+                            res <- liftIO $ onUnverifiedClientCert sparams                             if res                                 then do                                     -- When verification fails, but the@@ -300,10 +297,7 @@                                     -- chain to the context.                                     Just certs <- usingState_ ctx $ getClientCertChain                                     usingState_ ctx $ setClientCertificateChain certs-                                else do-                                    case verif of-                                        Left err -> throwCore $ Error_Protocol (show err, True, DecryptError)-                                        _        -> throwCore $ Error_Protocol ("verification failed", True, BadCertificate)+                                else throwCore $ Error_Protocol ("verification failed", True, BadCertificate)                     return $ RecvStateNext expectChangeCipher                  processCertificateVerify p = do
Network/TLS/Handshake/Signature.hs view
@@ -10,30 +10,20 @@     ( getHashAndASN1     ) where -import qualified Crypto.Hash.SHA224 as SHA224-import qualified Crypto.Hash.SHA256 as SHA256-import qualified Crypto.Hash.SHA384 as SHA384-import qualified Crypto.Hash.SHA512 as SHA512-+import Crypto.PubKey.HashDescr import Network.TLS.Context import Network.TLS.Struct  import Control.Monad.State -import qualified Data.ByteString as B--getHashAndASN1 :: MonadIO m => (HashAlgorithm, SignatureAlgorithm) -> m (B.ByteString -> B.ByteString, B.ByteString)+getHashAndASN1 :: MonadIO m => (HashAlgorithm, SignatureAlgorithm) -> m HashDescr getHashAndASN1 hashSig = do   case hashSig of-    (HashSHA224, SignatureRSA) ->-      return (SHA224.hash, "\x30\x2d\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x04\x05\x00\x04\x1c")-    (HashSHA256, SignatureRSA) ->-      return (SHA256.hash, "\x30\x31\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x01\x05\x00\x04\x20")-    (HashSHA384, SignatureRSA) ->-      return (SHA384.hash, "\x30\x41\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x02\x05\x00\x04\x30")-    (HashSHA512, SignatureRSA) ->-      return (SHA512.hash, "\x30\x51\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x03\x05\x00\x04\x40")-    _ ->-      throwCore $ Error_Misc "unsupported hash/sig algorithm"+    (HashSHA1,   SignatureRSA) -> return hashDescrSHA1+    (HashSHA224, SignatureRSA) -> return hashDescrSHA224+    (HashSHA256, SignatureRSA) -> return hashDescrSHA256+    (HashSHA384, SignatureRSA) -> return hashDescrSHA384+    (HashSHA512, SignatureRSA) -> return hashDescrSHA512+    _                          -> throwCore $ Error_Misc "unsupported hash/sig algorithm"  
Network/TLS/Receiving.hs view
@@ -93,11 +93,15 @@  decryptRSA :: ByteString -> TLSSt (Either KxError ByteString) decryptRSA econtent = do+        st  <- get         ver <- stVersion <$> get         rsapriv <- fromJust "rsa private key" . hstRSAPrivateKey . fromJust "handshake" . stHandshake <$> get-        return $ kxDecrypt rsapriv (if ver < TLS10 then econtent else B.drop 2 econtent)+        let cipher = if ver < TLS10 then econtent else B.drop 2 econtent+        let (mmsg,rng') = withTLSRNG (stRandomGen st) (\g -> kxDecrypt g rsapriv cipher)+        put (st { stRandomGen = rng' })+        return mmsg -verifyRSA :: (ByteString -> ByteString, ByteString) -> ByteString -> ByteString -> TLSSt (Either KxError Bool)+verifyRSA :: HashDescr -> ByteString -> ByteString -> TLSSt Bool verifyRSA hsh econtent sign = do         rsapriv <- fromJust "rsa client public key" . hstRSAClientPublicKey . fromJust "handshake" . stHandshake <$> get         return $ kxVerify rsapriv hsh econtent sign
Network/TLS/Sending.hs view
@@ -84,15 +84,19 @@ encryptRSA content = do         st <- get         let rsakey = fromJust "rsa public key" $ hstRSAPublicKey $ fromJust "handshake" $ stHandshake st-        case withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content) of-                Left err               -> fail ("rsa encrypt failed: " ++ show err)-                Right (econtent, rng') -> put (st { stRandomGen = rng' }) >> return econtent+            (v,rng') = withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content)+         in do put (st { stRandomGen = rng' })+               case v of+                    Left err       -> fail ("rsa encrypt failed: " ++ show err)+                    Right econtent -> return econtent -signRSA :: (ByteString -> ByteString, ByteString) -> ByteString -> TLSSt ByteString+signRSA :: HashDescr -> ByteString -> TLSSt ByteString signRSA hsh content = do         st <- get         let rsakey = fromJust "rsa client private key" $ hstRSAClientPrivateKey $ fromJust "handshake" $ stHandshake st-        case kxSign rsakey hsh content of+        let (r, rng') = withTLSRNG (stRandomGen st) (\g -> kxSign g rsakey hsh content)+        put (st { stRandomGen = rng' })+        case r of                 Left err       -> fail ("rsa sign failed: " ++ show err)                 Right econtent -> return econtent 
Network/TLS/State.hs view
@@ -89,7 +89,7 @@ import Control.Monad import Control.Monad.State import Control.Monad.Error-import Crypto.Random+import Crypto.Random.API import Data.Certificate.X509  assert :: Monad m => String -> [(String,Bool)] -> m ()@@ -127,7 +127,7 @@         , hstClientCertChain :: !(Maybe [X509])         } deriving (Show) -data StateRNG = forall g . CryptoRandomGen g => StateRNG g+data StateRNG = forall g . CPRG g => StateRNG g  instance Show StateRNG where         show _ = "rng[..]"@@ -178,7 +178,7 @@ runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState) runTLSState f st = runState (runErrorT (runTLSSt f)) st -newTLSState :: CryptoRandomGen g => g -> TLSState+newTLSState :: CPRG g => g -> TLSState newTLSState rng = TLSState         { stClientContext       = False         , stVersion             = TLS10@@ -209,10 +209,9 @@         , stClientCertificateChain = Nothing         } -withTLSRNG :: StateRNG -> (forall g . CryptoRandomGen g => g -> Either e (a,g)) -> Either e (a, StateRNG)-withTLSRNG (StateRNG rng) f = case f rng of-        Left err        -> Left err-        Right (a, rng') -> Right (a, StateRNG rng')+withTLSRNG :: StateRNG -> (forall g . CPRG g => g -> (a,g)) -> (a, StateRNG)+withTLSRNG (StateRNG rng) f = let (a, rng') = f rng+                               in (a, StateRNG rng')  withCompression :: (Compression -> (Compression, a)) -> TLSSt a withCompression f = do@@ -224,9 +223,8 @@ genTLSRandom :: (MonadState TLSState m, MonadError TLSError m) => Int -> m Bytes genTLSRandom n = do         st <- get-        case withTLSRNG (stRandomGen st) (genBytes n) of-                Left err            -> throwError $ Error_Random $ show err-                Right (bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes+        case withTLSRNG (stRandomGen st) (genRandomBytes n) of+                (bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes  makeDigest :: MonadState TLSState m => Bool -> Header -> Bytes -> m Bytes makeDigest w hdr content = do@@ -381,6 +379,7 @@ needEmptyPacket :: MonadState TLSState m => m Bool needEmptyPacket = gets f     where f st = (stVersion st <= TLS10)+              && stClientContext st               && (maybe False (\c -> bulkBlockSize (cipherBulk c) > 0) (stActiveTxCipher st))  setKeyBlock :: MonadState TLSState m => m ()
Network/TLS/Struct.hs view
@@ -117,15 +117,10 @@         | Error_Protocol (String, Bool, AlertDescription)         | Error_Certificate String         | Error_HandshakePolicy String -- ^ handshake policy failed.-        | Error_Random String         | Error_EOF         | Error_Packet String-        | Error_Packet_Size_Mismatch (Int, Int)         | Error_Packet_unexpected String String         | Error_Packet_Parsing String-        | Error_Internal_Packet_ByteProcessed Int Int Int-        | Error_Unknown_Version Word8 Word8-        | Error_Unknown_Type String         deriving (Eq, Show, Typeable)  instance Error TLSError where
− Tests.hs
@@ -1,331 +0,0 @@-{-# LANGUAGE CPP #-}--import Test.QuickCheck-import Test.QuickCheck.Monadic-import Test.Framework (defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)--import Tests.Certificate-import Tests.PipeChan-import Tests.Connection--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.Struct-import Network.TLS.Packet-import Control.Applicative-import Control.Concurrent-import Control.Exception (throw, SomeException)-import qualified Control.Exception as E-import Control.Monad--import Data.IORef--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 = do-                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 (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-        pipe <- run newPipe-        _ <- run (runPipe pipe)--        let bSize = 16-        n <- pick (choose (1, 32))--        let d1 = B.replicate (bSize * n) 40-        let d2 = B.replicate (bSize * n) 45--        d1' <- run (writePipeA pipe d1 >> readPipeB pipe (B.length d1))-        d1 `assertEq` d1'--        d2' <- run (writePipeB pipe d2 >> readPipeA pipe (B.length d2))-        d2 `assertEq` d2'--        return ()--establish_data_pipe params tlsServer tlsClient = do-        -- initial setup-        pipe        <- newPipe-        _           <- (runPipe pipe)-        startQueue  <- newChan-        resultQueue <- newChan--        (cCtx, sCtx) <- newPairContext pipe params--        _ <- forkIO $ E.catch (tlsServer sCtx resultQueue) (printAndRaise "server")-        _ <- forkIO $ E.catch (tlsClient startQueue cCtx) (printAndRaise "client")--        return (startQueue, resultQueue)-        where-                printAndRaise :: String -> SomeException -> IO ()-                printAndRaise s e = putStrLn (s ++ " exception: " ++ show e) >> throw e--recvDataNonNull ctx = recvData ctx >>= \l -> if B.null l then recvDataNonNull ctx else return l--prop_handshake_initiate :: PropertyM IO ()-prop_handshake_initiate = do-        params       <- pick arbitraryPairParams-        (startQueue, resultQueue) <- run (establish_data_pipe params tlsServer tlsClient)--        {- the test involves writing data on one side of the data "pipe" and-         - then checking we received them on the other side of the data "pipe" -}-        d <- B.pack <$> pick (someWords8 256)-        run $ writeChan startQueue d--        dres <- run $ readChan resultQueue-        d `assertEq` dres--        return ()-        where-                tlsServer ctx queue = do-                        handshake ctx-                        d <- recvDataNonNull ctx-                        writeChan queue d-                        return ()-                tlsClient queue ctx = do-                        handshake ctx-                        d <- readChan queue-                        sendData ctx (L.fromChunks [d])-                        bye ctx-                        return ()--prop_handshake_npn_initiate :: PropertyM IO ()-prop_handshake_npn_initiate = do-        (clientParam,serverParam) <- pick arbitraryPairParams-        let clientParam' = clientParam { onNPNServerSuggest = Just $ \protos -> return (head protos) }-            serverParam' = serverParam { onSuggestNextProtocols = return $ Just [C8.pack "spdy/2", C8.pack "http/1.1"] }-            params' = (clientParam',serverParam')-        (startQueue, resultQueue) <- run (establish_data_pipe params' tlsServer tlsClient)--        {- the test involves writing data on one side of the data "pipe" and-         - then checking we received them on the other side of the data "pipe" -}-        d <- B.pack <$> pick (someWords8 256)-        run $ writeChan startQueue d--        dres <- run $ readChan resultQueue-        d `assertEq` dres--        return ()-        where-                tlsServer ctx queue = do-                        handshake ctx-                        proto <- getNegotiatedProtocol ctx-                        Just (C8.pack "spdy/2") `assertEq` proto-                        d <- recvDataNonNull ctx-                        writeChan queue d-                        return ()-                tlsClient queue ctx = do-                        handshake ctx-                        proto <- getNegotiatedProtocol ctx-                        Just (C8.pack "spdy/2") `assertEq` proto-                        d <- readChan queue-                        sendData ctx (L.fromChunks [d])-                        bye ctx-                        return ()--prop_handshake_renegociation :: PropertyM IO ()-prop_handshake_renegociation = do-        params       <- pick arbitraryPairParams-        (startQueue, resultQueue) <- run (establish_data_pipe params tlsServer tlsClient)--        {- the test involves writing data on one side of the data "pipe" and-         - then checking we received them on the other side of the data "pipe" -}-        d <- B.pack <$> pick (someWords8 256)-        run $ writeChan startQueue d--        dres <- run $ readChan resultQueue-        d `assertEq` dres--        return ()-        where-                tlsServer ctx queue = do-                        handshake ctx-                        d <- recvDataNonNull ctx-                        writeChan queue d-                        return ()-                tlsClient queue ctx = do-                        handshake ctx-                        handshake ctx-                        d <- readChan queue-                        sendData ctx (L.fromChunks [d])-                        bye ctx-                        return ()---- | simple session manager to store one session id and session data for a single thread.--- a Real concurrent session manager would use an MVar and have multiples items.-data OneSessionManager = OneSessionManager (IORef (Maybe (SessionID, SessionData)))--instance SessionManager OneSessionManager where-    sessionInvalidate _ _ = return ()-    sessionEstablish (OneSessionManager ref) myId dat = writeIORef ref $ Just (myId, dat)-    sessionResume (OneSessionManager ref) myId = readIORef ref >>= maybeResume-        where maybeResume Nothing = return Nothing-              maybeResume (Just (sid, sdata)) = return (if sid == myId then Just sdata else Nothing)--prop_handshake_session_resumption :: PropertyM IO ()-prop_handshake_session_resumption = do-        sessionRef <- run $ newIORef Nothing-        let sessionManager = OneSessionManager sessionRef--        plainParams <- pick arbitraryPairParams-        let params = setPairParamsSessionManager sessionManager plainParams--        -- establish a session.-        (s1, r1) <- run (establish_data_pipe params tlsServer tlsClient)--        d <- B.pack <$> pick (someWords8 256)-        run $ writeChan s1 d-        dres <- run $ readChan r1-        d `assertEq` dres--        -- and resume-        sessionParams <- run $ readIORef sessionRef-        assert (isJust sessionParams)-        let params2 = setPairParamsSessionResuming (fromJust sessionParams) params--        -- resume-        (startQueue, resultQueue) <- run (establish_data_pipe params2 tlsServer tlsClient)--        {- the test involves writing data on one side of the data "pipe" and-         - then checking we received them on the other side of the data "pipe" -}-        d2 <- B.pack <$> pick (someWords8 256)-        run $ writeChan startQueue d2--        dres2 <- run $ readChan resultQueue-        d2 `assertEq` dres2--        return ()-        where-                tlsServer ctx queue = do-                        handshake ctx-                        d <- recvDataNonNull ctx-                        writeChan queue d-                        return ()-                tlsClient queue ctx = do-                        handshake ctx-                        d <- readChan queue-                        sendData ctx (L.fromChunks [d])-                        bye ctx-                        return ()--assertEq :: (Show a, Monad m, Eq a) => a -> a -> m ()-assertEq expected got = unless (expected == got) $ error ("got " ++ show got ++ " but was expecting " ++ show expected)--main :: IO ()-main = defaultMain-        [ tests_marshalling-        , tests_handshake-        ]-        where-                -- lowlevel tests to check the packet marshalling.-                tests_marshalling = testGroup "Marshalling"-                        [ testProperty "Header" prop_header_marshalling_id-                        , testProperty "Handshake" prop_handshake_marshalling_id-                        ]--                -- high level tests between a client and server with fake ciphers.-                tests_handshake = testGroup "Handshakes"-                        [ testProperty "setup" (monadicIO prop_pipe_work)-                        , testProperty "initiate" (monadicIO prop_handshake_initiate)-                        , testProperty "initiate with npn" (monadicIO prop_handshake_npn_initiate)-                        , testProperty "renegociation" (monadicIO prop_handshake_renegociation)-                        , testProperty "resumption" (monadicIO prop_handshake_session_resumption)-                        ]
Tests/Certificate.hs view
@@ -1,4 +1,4 @@-module Tests.Certificate+module Certificate         ( arbitraryX509         , arbitraryX509WithPublicKey         ) where@@ -9,7 +9,7 @@ import Data.Time.Calendar (fromGregorian) import Data.Time.Clock (secondsToDiffTime) -import Tests.PubKey+import PubKey  arbitraryDN = return $ Cert.DistinguishedName [] 
Tests/Connection.hs view
@@ -1,4 +1,4 @@-module Tests.Connection+module Connection         ( newPairContext         , arbitraryPairParams         , setPairParamsSessionManager@@ -6,9 +6,9 @@         ) where  import Test.QuickCheck-import Tests.Certificate-import Tests.PubKey-import Tests.PipeChan+import Certificate+import PubKey+import PipeChan import Network.TLS  import qualified Crypto.Random.AESCtr as RNG
Tests/PipeChan.hs view
@@ -1,5 +1,5 @@ -- create a similar concept than a unix pipe.-module Tests.PipeChan+module PipeChan         ( PipeChan(..)         , newPipe         , runPipe
Tests/PubKey.hs view
@@ -1,4 +1,4 @@-module Tests.PubKey+module PubKey         ( arbitraryRSAPair         , globalRSAPair         , getGlobalRSAPair@@ -7,7 +7,7 @@ import Test.QuickCheck  import qualified Crypto.Random.AESCtr as RNG-import qualified Crypto.Cipher.RSA as RSA+import qualified Crypto.PubKey.RSA as RSA  import qualified Data.ByteString as B @@ -19,9 +19,7 @@         rng <- (maybe (error "making rng") id . RNG.make . B.pack) `fmap` vector 64         arbitraryRSAPairWithRNG rng -arbitraryRSAPairWithRNG rng = case RSA.generate rng 128 65537 of-        Left _             -> error "couldn't generate RSA"-        Right (keypair, _) -> return keypair+arbitraryRSAPairWithRNG rng = return $ fst $ RSA.generate rng 128 0x10001  {-# NOINLINE globalRSAPair #-} globalRSAPair :: MVar (RSA.PublicKey, RSA.PrivateKey)
+ Tests/Tests.hs view
@@ -0,0 +1,330 @@+{-# LANGUAGE CPP #-}++import Test.QuickCheck+import Test.QuickCheck.Monadic+import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Certificate+import PipeChan+import Connection++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)+import qualified Control.Exception as E+import Control.Monad++import Data.IORef++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 = do+                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 (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+        pipe <- run newPipe+        _ <- run (runPipe pipe)++        let bSize = 16+        n <- pick (choose (1, 32))++        let d1 = B.replicate (bSize * n) 40+        let d2 = B.replicate (bSize * n) 45++        d1' <- run (writePipeA pipe d1 >> readPipeB pipe (B.length d1))+        d1 `assertEq` d1'++        d2' <- run (writePipeB pipe d2 >> readPipeA pipe (B.length d2))+        d2 `assertEq` d2'++        return ()++establish_data_pipe params tlsServer tlsClient = do+        -- initial setup+        pipe        <- newPipe+        _           <- (runPipe pipe)+        startQueue  <- newChan+        resultQueue <- newChan++        (cCtx, sCtx) <- newPairContext pipe params++        _ <- forkIO $ E.catch (tlsServer sCtx resultQueue) (printAndRaise "server")+        _ <- forkIO $ E.catch (tlsClient startQueue cCtx) (printAndRaise "client")++        return (startQueue, resultQueue)+        where+                printAndRaise :: String -> SomeException -> IO ()+                printAndRaise s e = putStrLn (s ++ " exception: " ++ show e) >> throw e++recvDataNonNull ctx = recvData ctx >>= \l -> if B.null l then recvDataNonNull ctx else return l++prop_handshake_initiate :: PropertyM IO ()+prop_handshake_initiate = do+        params       <- pick arbitraryPairParams+        (startQueue, resultQueue) <- run (establish_data_pipe params tlsServer tlsClient)++        {- the test involves writing data on one side of the data "pipe" and+         - then checking we received them on the other side of the data "pipe" -}+        d <- B.pack <$> pick (someWords8 256)+        run $ writeChan startQueue d++        dres <- run $ readChan resultQueue+        d `assertEq` dres++        return ()+        where+                tlsServer ctx queue = do+                        handshake ctx+                        d <- recvDataNonNull ctx+                        writeChan queue d+                        return ()+                tlsClient queue ctx = do+                        handshake ctx+                        d <- readChan queue+                        sendData ctx (L.fromChunks [d])+                        bye ctx+                        return ()++prop_handshake_npn_initiate :: PropertyM IO ()+prop_handshake_npn_initiate = do+        (clientParam,serverParam) <- pick arbitraryPairParams+        let clientParam' = clientParam { onNPNServerSuggest = Just $ \protos -> return (head protos) }+            serverParam' = serverParam { onSuggestNextProtocols = return $ Just [C8.pack "spdy/2", C8.pack "http/1.1"] }+            params' = (clientParam',serverParam')+        (startQueue, resultQueue) <- run (establish_data_pipe params' tlsServer tlsClient)++        {- the test involves writing data on one side of the data "pipe" and+         - then checking we received them on the other side of the data "pipe" -}+        d <- B.pack <$> pick (someWords8 256)+        run $ writeChan startQueue d++        dres <- run $ readChan resultQueue+        d `assertEq` dres++        return ()+        where+                tlsServer ctx queue = do+                        handshake ctx+                        proto <- getNegotiatedProtocol ctx+                        Just (C8.pack "spdy/2") `assertEq` proto+                        d <- recvDataNonNull ctx+                        writeChan queue d+                        return ()+                tlsClient queue ctx = do+                        handshake ctx+                        proto <- getNegotiatedProtocol ctx+                        Just (C8.pack "spdy/2") `assertEq` proto+                        d <- readChan queue+                        sendData ctx (L.fromChunks [d])+                        bye ctx+                        return ()++prop_handshake_renegociation :: PropertyM IO ()+prop_handshake_renegociation = do+        params       <- pick arbitraryPairParams+        (startQueue, resultQueue) <- run (establish_data_pipe params tlsServer tlsClient)++        {- the test involves writing data on one side of the data "pipe" and+         - then checking we received them on the other side of the data "pipe" -}+        d <- B.pack <$> pick (someWords8 256)+        run $ writeChan startQueue d++        dres <- run $ readChan resultQueue+        d `assertEq` dres++        return ()+        where+                tlsServer ctx queue = do+                        handshake ctx+                        d <- recvDataNonNull ctx+                        writeChan queue d+                        return ()+                tlsClient queue ctx = do+                        handshake ctx+                        handshake ctx+                        d <- readChan queue+                        sendData ctx (L.fromChunks [d])+                        bye ctx+                        return ()++-- | simple session manager to store one session id and session data for a single thread.+-- a Real concurrent session manager would use an MVar and have multiples items.+data OneSessionManager = OneSessionManager (IORef (Maybe (SessionID, SessionData)))++instance SessionManager OneSessionManager where+    sessionInvalidate _ _ = return ()+    sessionEstablish (OneSessionManager ref) myId dat = writeIORef ref $ Just (myId, dat)+    sessionResume (OneSessionManager ref) myId = readIORef ref >>= maybeResume+        where maybeResume Nothing = return Nothing+              maybeResume (Just (sid, sdata)) = return (if sid == myId then Just sdata else Nothing)++prop_handshake_session_resumption :: PropertyM IO ()+prop_handshake_session_resumption = do+        sessionRef <- run $ newIORef Nothing+        let sessionManager = OneSessionManager sessionRef++        plainParams <- pick arbitraryPairParams+        let params = setPairParamsSessionManager sessionManager plainParams++        -- establish a session.+        (s1, r1) <- run (establish_data_pipe params tlsServer tlsClient)++        d <- B.pack <$> pick (someWords8 256)+        run $ writeChan s1 d+        dres <- run $ readChan r1+        d `assertEq` dres++        -- and resume+        sessionParams <- run $ readIORef sessionRef+        assert (isJust sessionParams)+        let params2 = setPairParamsSessionResuming (fromJust sessionParams) params++        -- resume+        (startQueue, resultQueue) <- run (establish_data_pipe params2 tlsServer tlsClient)++        {- the test involves writing data on one side of the data "pipe" and+         - then checking we received them on the other side of the data "pipe" -}+        d2 <- B.pack <$> pick (someWords8 256)+        run $ writeChan startQueue d2++        dres2 <- run $ readChan resultQueue+        d2 `assertEq` dres2++        return ()+        where+                tlsServer ctx queue = do+                        handshake ctx+                        d <- recvDataNonNull ctx+                        writeChan queue d+                        return ()+                tlsClient queue ctx = do+                        handshake ctx+                        d <- readChan queue+                        sendData ctx (L.fromChunks [d])+                        bye ctx+                        return ()++assertEq :: (Show a, Monad m, Eq a) => a -> a -> m ()+assertEq expected got = unless (expected == got) $ error ("got " ++ show got ++ " but was expecting " ++ show expected)++main :: IO ()+main = defaultMain+        [ tests_marshalling+        , tests_handshake+        ]+        where+                -- lowlevel tests to check the packet marshalling.+                tests_marshalling = testGroup "Marshalling"+                        [ testProperty "Header" prop_header_marshalling_id+                        , testProperty "Handshake" prop_handshake_marshalling_id+                        ]++                -- high level tests between a client and server with fake ciphers.+                tests_handshake = testGroup "Handshakes"+                        [ testProperty "setup" (monadicIO prop_pipe_work)+                        , testProperty "initiate" (monadicIO prop_handshake_initiate)+                        , testProperty "initiate with npn" (monadicIO prop_handshake_npn_initiate)+                        , testProperty "renegociation" (monadicIO prop_handshake_renegociation)+                        , testProperty "resumption" (monadicIO prop_handshake_session_resumption)+                        ]
tls.cabal view
@@ -1,5 +1,5 @@ Name:                tls-Version:             1.0.3+Version:             1.1.0 Description:    Native Haskell TLS and SSL protocol implementation for server and client.    .@@ -26,14 +26,6 @@ Homepage:            http://github.com/vincenthz/hs-tls extra-source-files:  Tests/*.hs -Flag test-  Description:       Build unit test-  Default:           False--Flag executable-  Description:       Build the executable-  Default:           False- Flag compat   Description:       Accept SSLv2 compatible handshake   Default:           True@@ -45,8 +37,8 @@                    , cereal >= 0.3                    , bytestring                    , network-                   , crypto-api >= 0.5-                   , cryptocipher >= 0.3.0 && < 0.4.0+                   , crypto-random-api >= 0.2 && < 0.3+                   , crypto-pubkey                    , certificate >= 1.3.0 && < 1.4.0   Exposed-modules:   Network.TLS                      Network.TLS.Cipher@@ -85,29 +77,24 @@   if flag(compat)     cpp-options:     -DSSLV2_COMPATIBLE -executable           Tests+Test-Suite test-tls+  type:              exitcode-stdio-1.0+  hs-source-dirs:    Tests   Main-is:           Tests.hs-  if flag(test)-    Buildable:       True-    Build-Depends:   base >= 3 && < 5+  Build-Depends:     base >= 3 && < 5                    , mtl                    , cereal >= 0.3                    , QuickCheck >= 2                    , test-framework                    , test-framework-quickcheck2+                   , cprng-aes+                   , crypto-pubkey                    , bytestring+                   , certificate+                   , tls                    , time-                   , cryptocipher >= 0.3.0 && < 0.4.0-                   , network-                   , cprng-aes >= 0.3.0-                   , cryptohash >= 0.6-                   , certificate >= 1.3.0 && < 1.4.0-                   , crypto-api >= 0.5-  else-    Buildable:       False+                   , crypto-random-api   ghc-options:       -Wall -fno-warn-orphans -fno-warn-missing-signatures -fhpc-  if flag(compat)-    cpp-options:     -DSSLV2_COMPATIBLE  source-repository head   type: git