Hello community, here is the log from the commit of package ghc-tls for openSUSE:Factory checked in at 2017-04-14 13:38:49 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tls (Old) and /work/SRC/openSUSE:Factory/.ghc-tls.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-tls" Fri Apr 14 13:38:49 2017 rev:11 rq:485164 version:1.3.10 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tls/ghc-tls.changes 2017-02-03 17:40:18.222598923 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-tls.new/ghc-tls.changes 2017-04-14 13:38:50.793847363 +0200 @@ -1,0 +2,5 @@ +Mon Mar 27 12:38:43 UTC 2017 - [email protected] + +- Update to version 1.3.10 revision 1 with cabal2obs. + +------------------------------------------------------------------- Old: ---- tls-1.3.9.tar.gz New: ---- tls-1.3.10.tar.gz tls.cabal ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tls.spec ++++++ --- /var/tmp/diff_new_pack.p8UVUD/_old 2017-04-14 13:38:52.237643311 +0200 +++ /var/tmp/diff_new_pack.p8UVUD/_new 2017-04-14 13:38:52.241642746 +0200 @@ -19,13 +19,14 @@ %global pkg_name tls %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.3.9 +Version: 1.3.10 Release: 0 Summary: TLS/SSL protocol native implementation (Server and Client) License: BSD-3-Clause Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-asn1-encoding-devel BuildRequires: ghc-asn1-types-devel @@ -77,6 +78,7 @@ %prep %setup -q -n %{pkg_name}-%{version} +cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ tls-1.3.9.tar.gz -> tls-1.3.10.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Backend.hs new/tls-1.3.10/Network/TLS/Backend.hs --- old/tls-1.3.9/Network/TLS/Backend.hs 2016-07-30 12:11:49.000000000 +0200 +++ new/tls-1.3.10/Network/TLS/Backend.hs 2016-12-20 08:24:41.000000000 +0100 @@ -27,7 +27,7 @@ #ifdef INCLUDE_NETWORK import Control.Monad -import qualified Network.Socket as Network (Socket, sClose) +import qualified Network.Socket as Network (Socket, close) import qualified Network.Socket.ByteString as Network #endif @@ -72,7 +72,7 @@ #ifdef INCLUDE_NETWORK instance HasBackend Network.Socket where initializeBackend _ = return () - getBackend sock = Backend (return ()) (Network.sClose sock) (Network.sendAll sock) recvAll + getBackend sock = Backend (return ()) (Network.close sock) (Network.sendAll sock) recvAll where recvAll n = B.concat `fmap` loop n where loop 0 = return [] loop left = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Cipher.hs new/tls-1.3.10/Network/TLS/Cipher.hs --- old/tls-1.3.9/Network/TLS/Cipher.hs 2016-12-17 12:09:25.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Cipher.hs 2017-03-14 07:12:25.000000000 +0100 @@ -32,8 +32,7 @@ ) where import Crypto.Cipher.Types (AuthTag) -import Network.TLS.Types (CipherID) -import Network.TLS.Struct (Version(..)) +import Network.TLS.Types (CipherID, Version(..)) import Network.TLS.Crypto (Hash(..), hashDigestSize) import qualified Data.ByteString as B diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Core.hs new/tls-1.3.10/Network/TLS/Core.hs --- old/tls-1.3.9/Network/TLS/Core.hs 2016-12-04 07:54:32.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Core.hs 2016-12-20 08:24:41.000000000 +0100 @@ -88,10 +88,10 @@ where doRecv = do pkt <- withReadLock ctx $ recvPacket ctx either onError process pkt - + safeHandleError_EOF Error_EOF = Just () safeHandleError_EOF _ = Nothing - + onError err@(Error_Protocol (reason,fatal,desc)) = terminate err (if fatal then AlertLevel_Fatal else AlertLevel_Warning) desc reason onError err = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Credentials.hs new/tls-1.3.10/Network/TLS/Credentials.hs --- old/tls-1.3.9/Network/TLS/Credentials.hs 2015-01-16 20:44:32.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Credentials.hs 2017-03-14 07:12:25.000000000 +0100 @@ -95,14 +95,14 @@ -- this change in future. credentialCanDecrypt :: Credential -> Maybe () credentialCanDecrypt (chain, priv) = - case extensionGet (certExtensions cert) of - Nothing -> Just () - Just (ExtKeyUsage flags) - | KeyUsage_keyEncipherment `elem` flags -> - case (pub, priv) of - (PubKeyRSA _, PrivKeyRSA _) -> Just () - _ -> Nothing - | otherwise -> Nothing + case (pub, priv) of + (PubKeyRSA _, PrivKeyRSA _) -> + case extensionGet (certExtensions cert) of + Nothing -> Just () + Just (ExtKeyUsage flags) + | KeyUsage_keyEncipherment `elem` flags -> Just () + | otherwise -> Nothing + _ -> Nothing where cert = signedObject $ getSigned signed pub = certPubKey cert signed = getCertificateChainLeaf chain diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Extra/Cipher.hs new/tls-1.3.10/Network/TLS/Extra/Cipher.hs --- old/tls-1.3.9/Network/TLS/Extra/Cipher.hs 2016-12-17 12:09:25.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Extra/Cipher.hs 2017-03-14 07:12:25.000000000 +0100 @@ -6,7 +6,6 @@ -- Portability : unknown -- {-# LANGUAGE CPP #-} -{-# LANGUAGE PackageImports #-} module Network.TLS.Extra.Cipher ( -- * cipher suite @@ -55,7 +54,7 @@ import qualified Data.ByteString as B -import Network.TLS (Version(..)) +import Network.TLS.Types (Version(..)) import Network.TLS.Cipher import Data.Tuple (swap) @@ -189,9 +188,9 @@ , cipher_AES128_SHA1 ] --- | The strongest ciphers supported ciphers supported. For ciphers with PFS, --- AEAD and SHA2, we list each AES128 variant right after the corresponding --- AES256 variant. For weaker constructs, we use just the AES256 form. +-- | The strongest ciphers supported. For ciphers with PFS, AEAD and SHA2, we +-- list each AES128 variant right after the corresponding AES256 variant. For +-- weaker constructs, we use just the AES256 form. ciphersuite_strong :: [Cipher] ciphersuite_strong = [ -- If we have PFS + AEAD + SHA2, then allow AES128, else just 256 @@ -527,7 +526,7 @@ , cipherBulk = bulk_aes128 , cipherHash = SHA1 , cipherPRFHash = Nothing - , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA + , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA , cipherMinVer = Just TLS10 } @@ -538,7 +537,7 @@ , cipherBulk = bulk_aes256 , cipherHash = SHA1 , cipherPRFHash = Nothing - , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA + , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA , cipherMinVer = Just TLS10 } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Extra/FFDHE.hs new/tls-1.3.10/Network/TLS/Extra/FFDHE.hs --- old/tls-1.3.9/Network/TLS/Extra/FFDHE.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Extra/FFDHE.hs 2016-12-28 11:26:10.000000000 +0100 @@ -0,0 +1,62 @@ +-- | +-- Module : Network.TLS.Extra +-- License : BSD-style +-- Maintainer : Kazu Yamamoto <[email protected]> +-- Stability : experimental +-- Portability : unknown +-- +-- Finite Field Diffie-Hellman Ephemeral Parameters defined in RFC 7919. +module Network.TLS.Extra.FFDHE where + +import Crypto.PubKey.DH +import Network.TLS.Crypto.DH (DHParams) + +-- | 2048 bits finite field Diffie-Hellman ephemeral parameters +-- defined in RFC 7919. +-- The estimated symmetric-equivalent strength is 103 bits. +ffdhe2048 :: DHParams +ffdhe2048 = Params { + params_p = 0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B423861285C97FFFFFFFFFFFFFFFF + , params_g = 2 + , params_bits = 2048 + } + +-- | 3072 bits finite field Diffie-Hellman ephemeral parameters +-- defined in RFC 7919. +-- The estimated symmetric-equivalent strength is 125 bits. +ffdhe3072 :: DHParams +ffdhe3072 = Params { + params_p = 0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B4238611FCFDCDE355B3B6519035BBC34F4DEF99C023861B46FC9D6E6C9077AD91D2691F7F7EE598CB0FAC186D91CAEFE130985139270B4130C93BC437944F4FD4452E2D74DD364F2E21E71F54BFF5CAE82AB9C9DF69EE86D2BC522363A0DABC521979B0DEADA1DBF9A42D5C4484E0ABCD06BFA53DDEF3C1B20EE3FD59D7C25E41D2B66C62E37FFFFFFFFFFFFFFFF + , params_g = 2 + , params_bits = 3072 + } + +-- | 4096 bits finite field Diffie-Hellman ephemeral parameters +-- defined in RFC 7919. +-- The estimated symmetric-equivalent strength is 150 bits. +ffdhe4096 :: DHParams +ffdhe4096 = Params { + params_p = 0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B4238611FCFDCDE355B3B6519035BBC34F4DEF99C023861B46FC9D6E6C9077AD91D2691F7F7EE598CB0FAC186D91CAEFE130985139270B4130C93BC437944F4FD4452E2D74DD364F2E21E71F54BFF5CAE82AB9C9DF69EE86D2BC522363A0DABC521979B0DEADA1DBF9A42D5C4484E0ABCD06BFA53DDEF3C1B20EE3FD59D7C25E41D2B669E1EF16E6F52C3164DF4FB7930E9E4E58857B6AC7D5F42D69F6D187763CF1D5503400487F55BA57E31CC7A7135C886EFB4318AED6A1E012D9E6832A907600A918130C46DC778F971AD0038092999A333CB8B7A1A1DB93D7140003C2A4ECEA9F98D0ACC0A8291CDCEC97DCF8EC9B55A7F88A46B4DB5A851F44182E1C68A007E5E655F6AFFFFFFFFFFFFFFFF + , params_g = 2 + , params_bits = 4096 + } + +-- | 6144 bits finite field Diffie-Hellman ephemeral parameters +-- defined in RFC 7919. +-- The estimated symmetric-equivalent strength is 175 bits. +ffdhe6144 :: DHParams +ffdhe6144 = Params { + params_p = 0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B4238611FCFDCDE355B3B6519035BBC34F4DEF99C023861B46FC9D6E6C9077AD91D2691F7F7EE598CB0FAC186D91CAEFE130985139270B4130C93BC437944F4FD4452E2D74DD364F2E21E71F54BFF5CAE82AB9C9DF69EE86D2BC522363A0DABC521979B0DEADA1DBF9A42D5C4484E0ABCD06BFA53DDEF3C1B20EE3FD59D7C25E41D2B669E1EF16E6F52C3164DF4FB7930E9E4E58857B6AC7D5F42D69F6D187763CF1D5503400487F55BA57E31CC7A7135C886EFB4318AED6A1E012D9E6832A907600A918130C46DC778F971AD0038092999A333CB8B7A1A1DB93D7140003C2A4ECEA9F98D0ACC0A8291CDCEC97DCF8EC9B55A7F88A46B4DB5A851F44182E1C68A007E5E0DD9020BFD64B645036C7A4E677D2C38532A3A23BA4442CAF53EA63BB454329B7624C8917BDD64B1C0FD4CB38E8C334C701C3ACDAD0657FCCFEC719B1F5C3E4E46041F388147FB4CFDB477A52471F7A9A96910B855322EDB6340D8A00EF092350511E30ABEC1FFF9E3A26E7FB29F8C183023C3587E38DA0077D9B4763E4E4B94B2BBC194C6651E77CAF992EEAAC0232A281BF6B3A739C1226116820AE8DB5847A67CBEF9C9091B462D538CD72B03746AE77F5E62292C311562A846505DC82DB854338AE49F5235C95B91178CCF2DD5CACEF403EC9D1810C6272B045B3B71F9DC6B80D63FDD4A8E9ADB1E6962A69526D43161C1A41D570D7938DAD4A40E329CD0E40E65FFFFFFFFFFFFFFFF + , params_g = 2 + , params_bits = 6144 + } + +-- | 8192 bits finite field Diffie-Hellman ephemeral parameters +-- defined in RFC 7919. +-- The estimated symmetric-equivalent strength is 192 bits. +ffdhe8192 :: DHParams +ffdhe8192 = Params { + params_p = 0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B4238611FCFDCDE355B3B6519035BBC34F4DEF99C023861B46FC9D6E6C9077AD91D2691F7F7EE598CB0FAC186D91CAEFE130985139270B4130C93BC437944F4FD4452E2D74DD364F2E21E71F54BFF5CAE82AB9C9DF69EE86D2BC522363A0DABC521979B0DEADA1DBF9A42D5C4484E0ABCD06BFA53DDEF3C1B20EE3FD59D7C25E41D2B669E1EF16E6F52C3164DF4FB7930E9E4E58857B6AC7D5F42D69F6D187763CF1D5503400487F55BA57E31CC7A7135C886EFB4318AED6A1E012D9E6832A907600A918130C46DC778F971AD0038092999A333CB8B7A1A1DB93D7140003C2A4ECEA9F98D0ACC0A8291CDCEC97DCF8EC9B55A7F88A46B4DB5A851F44182E1C68A007E5E0DD9020BFD64B645036C7A4E677D2C38532A3A23BA4442CAF53EA63BB454329B7624C8917BDD64B1C0FD4CB38E8C334C701C3ACDAD0657FCCFEC719B1F5C3E4E46041F388147FB4CFDB477A52471F7A9A96910B855322EDB6340D8A00EF092350511E30ABEC1FFF9E3A26E7FB29F8C183023C3587E38DA0077D9B4763E4E4B94B2BBC194C6651E77CAF992EEAAC0232A281BF6B3A739C1226116820AE8DB5847A67CBEF9C9091B462D538CD72B03746AE77F5E62292C311562A846505DC82DB854338AE49F5235C95B91178CCF2DD5CACEF403EC9D1810C6272B045B3B71F9DC6B80D63FDD4A8E9ADB1E6962A69526D43161C1A41D570D7938DAD4A40E329CCFF46AAA36AD004CF600C8381E425A31D951AE64FDB23FCEC9509D43687FEB69EDD1CC5E0B8CC3BDF64B10EF86B63142A3AB8829555B2F747C932665CB2C0F1CC01BD70229388839D2AF05E454504AC78B7582822846C0BA35C35F5C59160CC046FD8251541FC68C9C86B022BB7099876A460E7451A8A93109703FEE1C217E6C3826E52C51AA691E0E423CFC99E9E31650C1217B624816CDAD9A95F9D5B8019488D9C0A0A1FE3075A577E23183F81D4A3F2FA4571EFC8CE0BA8A4FE8B6855DFE72B0A66EDED2FBABFBE58A30FAFABE1C5D71A87E2F741EF8C1FE86FEA6BBFDE530677F0D97D11D49F7A8443D0822E506A9F4614E011E2A94838FF88CD68C8BB7C5C6424CFFFFFFFFFFFFFFFF + , params_g = 2 + , params_bits = 8192 + } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Extra.hs new/tls-1.3.10/Network/TLS/Extra.hs --- old/tls-1.3.9/Network/TLS/Extra.hs 2014-10-13 10:02:04.000000000 +0200 +++ new/tls-1.3.10/Network/TLS/Extra.hs 2016-12-28 11:26:10.000000000 +0100 @@ -8,6 +8,8 @@ -- default values and ciphers module Network.TLS.Extra ( module Network.TLS.Extra.Cipher + , module Network.TLS.Extra.FFDHE ) where import Network.TLS.Extra.Cipher +import Network.TLS.Extra.FFDHE diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Handshake/Client.hs new/tls-1.3.10/Network/TLS/Handshake/Client.hs --- old/tls-1.3.9/Network/TLS/Handshake/Client.hs 2016-07-30 12:11:49.000000000 +0200 +++ new/tls-1.3.10/Network/TLS/Handshake/Client.hs 2017-03-14 07:12:25.000000000 +0100 @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} -- | -- Module : Network.TLS.Handshake.Client -- License : BSD-style @@ -174,6 +174,7 @@ Just (cc@(CertificateChain (c:_)), pk) -> do case certPubKey $ getCertificate c of PubKeyRSA _ -> return () + PubKeyDSA _ -> return () _ -> throwCore $ Error_Protocol ("no supported certificate type", True, HandshakeFailure) usingHState ctx $ setPrivateKey pk usingHState ctx $ setClientCertSent True @@ -205,7 +206,7 @@ sendPacket ctx $ Handshake [ClientKeyXchg ckx] where getCKX_DHE = do xver <- usingState_ ctx getVersion - serverParams <- fromJust <$> usingHState ctx (gets hstServerDHParams) + serverParams <- usingHState ctx getServerDHParams (clientDHPriv, clientDHPub) <- generateDHE ctx (serverDHParamsToParams serverParams) let premaster = dhGetShared (serverDHParamsToParams serverParams) @@ -217,7 +218,7 @@ getCKX_ECDHE = do xver <- usingState_ ctx getVersion - (ServerECDHParams ecdhparams serverECDHPub) <- fromJust <$> usingHState ctx (gets hstServerECDHParams) + (ServerECDHParams ecdhparams serverECDHPub) <- usingHState ctx getServerECDHParams (clientECDHPriv, clientECDHPub) <- generateECDHE ctx ecdhparams case ecdhGetShared ecdhparams clientECDHPriv serverECDHPub of @@ -244,24 +245,38 @@ certSent <- usingHState ctx $ getClientCertSent case certSent of True -> do - malg <- case usedVersion of + sigAlg <- getLocalSignatureAlg + + mhash <- case usedVersion of TLS12 -> do Just (_, Just hashSigs, _) <- usingHState ctx $ getClientCertRequest + -- The values in the "signature_algorithms" extension + -- are in descending order of preference. + -- However here the algorithms are selected according + -- to client preference in 'supportedHashSignatures'. let suppHashSigs = supportedHashSignatures $ ctxSupported ctx - hashSigs' = filter (\ a -> a `elem` hashSigs) suppHashSigs + matchHashSigs = filter (\ a -> snd a == sigAlg) suppHashSigs + hashSigs' = filter (\ a -> a `elem` hashSigs) matchHashSigs when (null hashSigs') $ - throwCore $ Error_Protocol ("no hash/signature algorithms in common with the server", True, HandshakeFailure) - return $ Just $ head hashSigs' + throwCore $ Error_Protocol ("no " ++ show sigAlg ++ " hash algorithm in common with the server", True, HandshakeFailure) + return $ Just $ fst $ head hashSigs' _ -> return Nothing -- Fetch all handshake messages up to now. msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages - sigDig <- certificateVerifyCreate ctx usedVersion malg msgs + sigDig <- certificateVerifyCreate ctx usedVersion sigAlg mhash msgs sendPacket ctx $ Handshake [CertVerify sigDig] _ -> return () + getLocalSignatureAlg = do + pk <- usingHState ctx getLocalPrivateKey + case pk of + PrivKeyRSA _ -> return SignatureRSA + PrivKeyDSA _ -> return SignatureDSS + _ -> throwCore $ Error_Protocol ("unsupported local private key type", True, HandshakeFailure) + processServerExtension :: ExtensionRaw -> TLSSt () processServerExtension (ExtensionRaw 0xff01 content) = do cv <- getVerifiedData ClientRole diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Handshake/Common.hs new/tls-1.3.10/Network/TLS/Handshake/Common.hs --- old/tls-1.3.9/Network/TLS/Handshake/Common.hs 2016-05-12 07:52:42.000000000 +0200 +++ new/tls-1.3.10/Network/TLS/Handshake/Common.hs 2016-12-20 08:24:41.000000000 +0100 @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Network.TLS.Handshake.Common ( handshakeFailed , errorToAlert diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Handshake/Process.hs new/tls-1.3.10/Network/TLS/Handshake/Process.hs --- old/tls-1.3.9/Network/TLS/Handshake/Process.hs 2016-05-07 10:39:05.000000000 +0200 +++ new/tls-1.3.10/Network/TLS/Handshake/Process.hs 2017-03-14 07:12:25.000000000 +0100 @@ -95,8 +95,8 @@ rver <- usingState_ ctx getVersion role <- usingState_ ctx isClientContext - serverParams <- fromJust "server dh params" <$> usingHState ctx (gets hstServerDHParams) - dhpriv <- fromJust "dh private" <$> usingHState ctx (gets hstDHPrivate) + serverParams <- usingHState ctx getServerDHParams + dhpriv <- usingHState ctx getDHPrivate let premaster = dhGetShared (serverDHParamsToParams serverParams) dhpriv clientDHValue usingHState ctx $ setMasterSecretFromPre rver role premaster @@ -104,8 +104,8 @@ rver <- usingState_ ctx getVersion role <- usingState_ ctx isClientContext - (ServerECDHParams ecdhparams _) <- fromJust "server ecdh params" <$> usingHState ctx (gets hstServerECDHParams) - ecdhpriv <- fromJust "ecdh private" <$> usingHState ctx (gets hstECDHPrivate) + (ServerECDHParams ecdhparams _) <- usingHState ctx getServerECDHParams + ecdhpriv <- usingHState ctx getECDHPrivate case ecdhGetShared ecdhparams ecdhpriv clientECDHValue of Nothing -> throwCore $ Error_Protocol("invalid client public key", True, HandshakeFailure) Just premaster -> @@ -120,10 +120,8 @@ usingState_ ctx $ updateVerifiedData ServerRole fdata return () +-- initialize a new Handshake context (initial handshake or renegotiations) startHandshake :: Context -> Version -> ClientRandom -> IO () -startHandshake ctx ver crand = do - -- FIXME check if handshake is already not null - liftIO $ modifyMVar_ (ctxHandshake ctx) $ \hs -> - case hs of - Nothing -> return $ Just $ newEmptyHandshake ver crand - Just _ -> return hs +startHandshake ctx ver crand = + let hs = Just $ newEmptyHandshake ver crand + in liftIO $ void $ swapMVar (ctxHandshake ctx) hs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Handshake/Server.hs new/tls-1.3.10/Network/TLS/Handshake/Server.hs --- old/tls-1.3.9/Network/TLS/Handshake/Server.hs 2016-12-17 12:09:25.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Handshake/Server.hs 2017-03-14 07:12:25.000000000 +0100 @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} -- | -- Module : Network.TLS.Handshake.Server -- License : BSD-style @@ -19,7 +20,7 @@ import Network.TLS.Cipher import Network.TLS.Compression import Network.TLS.Credentials -import Network.TLS.Crypto.ECDH +import Network.TLS.Crypto import Network.TLS.Extension import Network.TLS.Util (catchException, fromJust) import Network.TLS.IO @@ -30,9 +31,16 @@ import Network.TLS.Handshake.Key import Network.TLS.Measurement import Data.Maybe (isJust, listToMaybe, mapMaybe) -import Data.List (intersect, sortBy) +import Data.List (intersect) import qualified Data.ByteString as B import Data.ByteString.Char8 () +import Data.Ord (Down(..)) +#if MIN_VERSION_base(4,8,0) +import Data.List (sortOn) +#else +import Data.List (sortBy) +import Data.Ord (comparing) +#endif import Control.Monad.State @@ -95,7 +103,11 @@ -- Handle Client hello processHandshake ctx clientHello - when (clientVersion == SSL2) $ throwCore $ Error_Protocol ("ssl2 is not supported", True, ProtocolVersion) + -- rejecting SSL2. RFC 6176 + when (clientVersion == SSL2) $ throwCore $ Error_Protocol ("SSL 2.0 is not supported", True, ProtocolVersion) + -- rejecting SSL3. RFC 7568 + -- when (clientVersion == SSL3) $ throwCore $ Error_Protocol ("SSL 3.0 is not supported", True, ProtocolVersion) + -- Fallback SCSV: RFC7507 -- TLS_FALLBACK_SCSV: {0x56, 0x00} when (supportedFallbackScsv (ctxSupported ctx) && @@ -106,26 +118,60 @@ Nothing -> throwCore $ Error_Protocol ("client version " ++ show clientVersion ++ " is not supported", True, ProtocolVersion) Just v -> return v + -- If compression is null, commonCompressions should be [0]. when (null commonCompressions) $ throwCore $ Error_Protocol ("no compression in common with the client", True, HandshakeFailure) - let serverName = case extensionDecode False `fmap` (extensionLookup extensionID_ServerName exts) of - Just (Just (ServerName ns)) -> listToMaybe (mapMaybe toHostName ns) + -- SNI (Server Name Indication) + let serverName = case extensionLookup extensionID_ServerName exts >>= extensionDecode False of + Just (ServerName ns) -> listToMaybe (mapMaybe toHostName ns) where toHostName (ServerNameHostName hostName) = Just hostName toHostName (ServerNameOther _) = Nothing - _ -> Nothing + _ -> Nothing extraCreds <- (onServerNameIndication $ serverHooks sparams) serverName + -- When selecting a cipher we must ensure that it is allowed for the + -- TLS version but also that all its key-exchange requirements + -- will be met. + + -- Some ciphers require a signature and a hash. With TLS 1.2 the hash + -- algorithm is selected from a combination of server configuration and + -- the client "supported_signatures" extension. So we cannot pick + -- such a cipher if no hash is available for it. It's best to skip this + -- cipher and pick another one (with another key exchange). + + -- FIXME ciphers should also be checked for other requirements + -- (i.e. elliptic curves and D-H groups) + let cipherAllowed cipher = case chosenVersion of + TLS12 -> let -- Build a list of all signature algorithms with at least + -- one hash algorithm in common between client and server. + -- May contain duplicates, as it is only used for `elem`. + possibleSigAlgs = map snd (hashAndSignaturesInCommon ctx exts) + + -- Check that a candidate cipher with a signature requiring + -- a hash will have at least one hash available. This avoids + -- a failure later in 'decideHash'. + hasSigningRequirements = + case cipherKeyExchange cipher of + CipherKeyExchange_DHE_RSA -> SignatureRSA `elem` possibleSigAlgs + CipherKeyExchange_DHE_DSS -> SignatureDSS `elem` possibleSigAlgs + CipherKeyExchange_ECDHE_RSA -> SignatureRSA `elem` possibleSigAlgs + CipherKeyExchange_ECDHE_ECDSA -> SignatureECDSA `elem` possibleSigAlgs + _ -> True -- signature not used + + in cipherAllowedForVersion chosenVersion cipher && hasSigningRequirements + _ -> cipherAllowedForVersion chosenVersion cipher + -- The shared cipherlist can become empty after filtering for compatible -- creds, check now before calling onCipherChoosing, which does not handle -- empty lists. - let ciphersFilteredVersion = filter (cipherAllowedForVersion chosenVersion) (commonCiphers extraCreds) + let ciphersFilteredVersion = filter cipherAllowed (commonCiphers extraCreds) when (null ciphersFilteredVersion) $ throwCore $ Error_Protocol ("no cipher in common with the client", True, HandshakeFailure) let usedCipher = (onCipherChoosing $ serverHooks sparams) chosenVersion ciphersFilteredVersion - creds = extraCreds `mappend` (sharedCredentials $ ctxShared ctx) + creds = extraCreds `mappend` sharedCredentials (ctxShared ctx) cred <- case cipherKeyExchange usedCipher of CipherKeyExchange_RSA -> return $ credentialsFindForDecrypting creds @@ -141,24 +187,24 @@ maybe (return ()) (usingState_ ctx . setClientSNI) serverName - case extensionDecode False `fmap` (extensionLookup extensionID_ApplicationLayerProtocolNegotiation exts) of - Just (Just (ApplicationLayerProtocolNegotiation protos)) -> usingState_ ctx $ setClientALPNSuggest protos + case extensionLookup extensionID_ApplicationLayerProtocolNegotiation exts >>= extensionDecode False of + Just (ApplicationLayerProtocolNegotiation protos) -> usingState_ ctx $ setClientALPNSuggest protos _ -> return () - case extensionDecode False `fmap` (extensionLookup extensionID_EllipticCurves exts) of - Just (Just (EllipticCurvesSupported es)) -> usingState_ ctx $ setClientEllipticCurveSuggest es + case extensionLookup extensionID_EllipticCurves exts >>= extensionDecode False of + Just (EllipticCurvesSupported es) -> usingState_ ctx $ setClientEllipticCurveSuggest es _ -> return () -- Currently, we don't send back EcPointFormats. In this case, -- the client chooses EcPointFormat_Uncompressed. - case extensionDecode False `fmap` (extensionLookup extensionID_EcPointFormats exts) of - Just (Just (EcPointFormatsSupported fs)) -> usingState_ ctx $ setClientEcPointFormatSuggest fs + case extensionLookup extensionID_EcPointFormats exts >>= extensionDecode False of + Just (EcPointFormatsSupported fs) -> usingState_ ctx $ setClientEcPointFormatSuggest fs _ -> return () doHandshake sparams cred ctx chosenVersion usedCipher usedCompression clientSession resumeSessionData exts where - commonCipherIDs extra = intersect ciphers (map cipherID $ (ctxCiphers ctx extra)) + commonCipherIDs extra = ciphers `intersect` map cipherID (ctxCiphers ctx extra) commonCiphers extra = filter (flip elem (commonCipherIDs extra) . cipherID) (ctxCiphers ctx extra) commonCompressions = compressionIntersectID (supportedCompressions $ ctxSupported ctx) compressions usedCompression = head commonCompressions @@ -194,14 +240,14 @@ if null protos then npn else return protos alpn | clientALPNSuggest = do - suggest <- usingState_ ctx $ getClientALPNSuggest + suggest <- usingState_ ctx getClientALPNSuggest case (onALPNClientSuggest $ serverHooks sparams, suggest) of (Just io, Just protos) -> do proto <- liftIO $ io protos usingState_ ctx $ do setExtensionALPN True setNegotiatedProtocol proto - return $ [ ExtensionRaw extensionID_ApplicationLayerProtocolNegotiation + return [ ExtensionRaw extensionID_ApplicationLayerProtocolNegotiation (extensionEncode $ ApplicationLayerProtocolNegotiation [proto]) ] (_, _) -> return [] | otherwise = return [] @@ -226,7 +272,7 @@ -- --- makeServerHello session = do - srand <- getStateRNG ctx 32 >>= return . ServerRandom + srand <- ServerRandom <$> getStateRNG ctx 32 case mcred of Just (_, privkey) -> usingHState ctx $ setPrivateKey privkey _ -> return () -- return a sensible error @@ -240,10 +286,23 @@ cvf <- getVerifiedData ClientRole svf <- getVerifiedData ServerRole return $ extensionEncode (SecureRenegotiation cvf $ Just svf) - return [ ExtensionRaw 0xff01 vf ] + return [ ExtensionRaw extensionID_SecureRenegotiation vf ] else return [] protoExt <- applicationProtocol - let extensions = secRengExt ++ protoExt + sniExt <- do + resuming <- usingState_ ctx isSessionResuming + if resuming + then return [] + else do + msni <- usingState_ ctx getClientSNI + case msni of + -- RFC6066: In this event, the server SHALL include + -- an extension of type "server_name" in the + -- (extended) server hello. The "extension_data" + -- field of this extension SHALL be empty. + Just _ -> return [ ExtensionRaw extensionID_ServerName ""] + Nothing -> return [] + let extensions = secRengExt ++ protoExt ++ sniExt usingState_ ctx (setVersion chosenVersion) usingHState ctx $ setServerHelloParameters chosenVersion srand usedCipher usedCompression return $ ServerHello chosenVersion srand session (cipherID usedCipher) @@ -298,12 +357,29 @@ let serverParams = serverDHParamsFrom dhparams pub usingHState ctx $ setServerDHParams serverParams - usingHState ctx $ modify $ \hst -> hst { hstDHPrivate = Just priv } - return (serverParams) + usingHState ctx $ setDHPrivate priv + return serverParams + + -- Choosing a hash algorithm to sign (EC)DHE parameters + -- in ServerKeyExchange. Hash algorithm is not suggested by + -- the chosen cipher suite. So, it should be selected based on + -- the "signature_algorithms" extension in a client hello. + -- If RSA is also used for key exchange, this function is + -- not called. + decideHash sigAlg = do + usedVersion <- usingState_ ctx getVersion + case usedVersion of + TLS12 -> do + let hashSigs = hashAndSignaturesInCommon ctx exts + case filter ((==) sigAlg . snd) hashSigs of + [] -> error ("no hash signature for " ++ show sigAlg) + x:_ -> return $ Just (fst x) + _ -> return Nothing generateSKX_DHE sigAlg = do serverParams <- setup_DHE - signed <- digitallySignDHParams ctx serverParams sigAlg + mhash <- decideHash sigAlg + signed <- digitallySignDHParams ctx serverParams sigAlg mhash case sigAlg of SignatureRSA -> return $ SKX_DHE_RSA serverParams signed SignatureDSS -> return $ SKX_DHE_DSS serverParams signed @@ -318,18 +394,19 @@ let serverParams = ServerECDHParams ecdhparams pub usingHState ctx $ setServerECDHParams serverParams - usingHState ctx $ modify $ \hst -> hst { hstECDHPrivate = Just priv } + usingHState ctx $ setECDHPrivate priv return (serverParams) generateSKX_ECDHE sigAlg = do - ncs <- usingState_ ctx $ getClientEllipticCurveSuggest + ncs <- usingState_ ctx getClientEllipticCurveSuggest let common = availableEllipticCurves `intersect` fromJust "ClientEllipticCurveSuggest" ncs -- FIXME: Currently maximum strength is chosen. -- There may be a better way to choose EC. nc = if null common then error "No common EllipticCurves" else maximum $ map fromEnumSafe16 common serverParams <- setup_ECDHE nc - signed <- digitallySignECDHParams ctx serverParams sigAlg + mhash <- decideHash sigAlg + signed <- digitallySignECDHParams ctx serverParams sigAlg mhash case sigAlg of SignatureRSA -> return $ SKX_ECDHE_RSA serverParams signed _ -> error ("generate skx_ecdhe unsupported signature type: " ++ show sigAlg) @@ -349,7 +426,7 @@ recvClientData sparams ctx = runRecvState ctx (RecvStateHandshake processClientCertificate) where processClientCertificate (Certificates certs) = do -- run certificate recv hook - ctxWithHooks ctx (\hooks -> hookRecvCertificates hooks $ certs) + ctxWithHooks ctx (\hooks -> hookRecvCertificates hooks certs) -- Call application callback to see whether the -- certificate chain is acceptable. -- @@ -378,7 +455,7 @@ -- Check whether the client correctly signed the handshake. -- If not, ask the application on how to proceed. -- - processCertificateVerify (Handshake [hs@(CertVerify dsig@(DigitallySigned mbHashSig _))]) = do + processCertificateVerify (Handshake [hs@(CertVerify dsig)]) = do processHandshake ctx hs checkValidClientCertChain "change cipher message expected" @@ -386,14 +463,19 @@ usedVersion <- usingState_ ctx getVersion -- Fetch all handshake messages up to now. msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages - verif <- certificateVerifyCheck ctx usedVersion mbHashSig msgs dsig + + sigAlgExpected <- getRemoteSignatureAlg + + -- FIXME should check certificate is allowed for signing + + verif <- certificateVerifyCheck ctx usedVersion sigAlgExpected msgs dsig case verif of True -> do -- When verification succeeds, commit the -- client certificate chain to the context. -- - Just certs <- usingHState ctx $ getClientCertChain + Just certs <- usingHState ctx getClientCertChain usingState_ ctx $ setClientCertificateChain certs return () @@ -410,19 +492,27 @@ -- application callbacks accepts, we -- also commit the client certificate -- chain to the context. - Just certs <- usingHState ctx $ getClientCertChain + Just certs <- usingHState ctx getClientCertChain usingState_ ctx $ setClientCertificateChain certs else throwCore $ Error_Protocol ("verification failed", True, BadCertificate) return $ RecvStateNext expectChangeCipher processCertificateVerify p = do - chain <- usingHState ctx $ getClientCertChain + chain <- usingHState ctx getClientCertChain case chain of Just cc | isNullCertificateChain cc -> return () | otherwise -> throwCore $ Error_Protocol ("cert verify message missing", True, UnexpectedMessage) Nothing -> return () expectChangeCipher p + getRemoteSignatureAlg = do + pk <- usingHState ctx getRemotePublicKey + case pk of + PubKeyRSA _ -> return SignatureRSA + PubKeyDSA _ -> return SignatureDSS + PubKeyEC _ -> return SignatureECDSA + _ -> throwCore $ Error_Protocol ("unsupported remote public key type", True, HandshakeFailure) + expectChangeCipher ChangeCipherSpec = do npn <- usingState_ ctx getExtensionNPN return $ RecvStateHandshake $ if npn then expectNPN else expectFinish @@ -435,15 +525,36 @@ expectFinish p = unexpected (show p) (Just "Handshake Finished") checkValidClientCertChain msg = do - chain <- usingHState ctx $ getClientCertChain + chain <- usingHState ctx getClientCertChain let throwerror = Error_Protocol (msg , True, UnexpectedMessage) case chain of Nothing -> throwCore throwerror Just cc | isNullCertificateChain cc -> throwCore throwerror | otherwise -> return () +hashAndSignaturesInCommon :: Context -> [ExtensionRaw] -> [HashAndSignatureAlgorithm] +hashAndSignaturesInCommon ctx exts = + let cHashSigs = case extensionLookup extensionID_SignatureAlgorithms exts >>= extensionDecode False of + -- See Section 7.4.1.4.1 of RFC 5246. + Nothing -> [(HashSHA1, SignatureECDSA) + ,(HashSHA1, SignatureRSA) + ,(HashSHA1, SignatureDSS)] + Just (SignatureAlgorithms sas) -> sas + sHashSigs = supportedHashSignatures $ ctxSupported ctx + -- The values in the "signature_algorithms" extension + -- are in descending order of preference. + -- However here the algorithms are selected according + -- to server preference in 'supportedHashSignatures'. + in sHashSigs `intersect` cHashSigs + findHighestVersionFrom :: Version -> [Version] -> Maybe Version findHighestVersionFrom clientVersion allowedVersions = - case filter (clientVersion >=) $ reverse $ sortBy compare allowedVersions of + case filter (clientVersion >=) $ sortOn Down allowedVersions of [] -> Nothing v:_ -> Just v + +#if !MIN_VERSION_base(4,8,0) +sortOn :: Ord b => (a -> b) -> [a] -> [a] +sortOn f = + map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Handshake/Signature.hs new/tls-1.3.10/Network/TLS/Handshake/Signature.hs --- old/tls-1.3.9/Network/TLS/Handshake/Signature.hs 2016-12-17 12:09:25.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Handshake/Signature.hs 2017-03-14 07:12:25.000000000 +0100 @@ -20,8 +20,8 @@ import Network.TLS.Context.Internal import Network.TLS.Struct import Network.TLS.Imports -import Network.TLS.Packet (generateCertificateVerify_SSL, encodeSignedDHParams, encodeSignedECDHParams) -import Network.TLS.Parameters (supportedHashSignatures) +import Network.TLS.Packet (generateCertificateVerify_SSL, generateCertificateVerify_SSL_DSS, + encodeSignedDHParams, encodeSignedECDHParams) import Network.TLS.State import Network.TLS.Handshake.State import Network.TLS.Handshake.Key @@ -31,49 +31,56 @@ certificateVerifyCheck :: Context -> Version - -> Maybe HashAndSignatureAlgorithm + -> SignatureAlgorithm -> Bytes -> DigitallySigned -> IO Bool -certificateVerifyCheck ctx usedVersion malg msgs dsig = - prepareCertificateVerifySignatureData ctx usedVersion malg msgs >>= - signatureVerifyWithHashDescr ctx SignatureRSA dsig +certificateVerifyCheck ctx usedVersion sigAlgExpected msgs digSig@(DigitallySigned hashSigAlg _) = + case (usedVersion, hashSigAlg) of + (TLS12, Nothing) -> return False + (TLS12, Just (h,s)) | s == sigAlgExpected -> doVerify (Just h) + | otherwise -> return False + (_, Nothing) -> doVerify Nothing + (_, Just _) -> return False + where + doVerify mhash = + prepareCertificateVerifySignatureData ctx usedVersion sigAlgExpected mhash msgs >>= + signatureVerifyWithHashDescr ctx sigAlgExpected digSig certificateVerifyCreate :: Context -> Version - -> Maybe HashAndSignatureAlgorithm + -> SignatureAlgorithm + -> Maybe HashAlgorithm -- TLS12 only -> Bytes -> IO DigitallySigned -certificateVerifyCreate ctx usedVersion malg msgs = - prepareCertificateVerifySignatureData ctx usedVersion malg msgs >>= - signatureCreate ctx malg - -getHashAndASN1 :: MonadIO m => (HashAlgorithm, SignatureAlgorithm) -> m Hash -getHashAndASN1 hashSig = case hashSig of - (HashSHA1, SignatureRSA) -> return SHA1 - (HashSHA224, SignatureRSA) -> return SHA224 - (HashSHA256, SignatureRSA) -> return SHA256 - (HashSHA384, SignatureRSA) -> return SHA384 - (HashSHA512, SignatureRSA) -> return SHA512 - _ -> throwCore $ Error_Misc "unsupported hash/sig algorithm" +certificateVerifyCreate ctx usedVersion sigAlg mhash msgs = + prepareCertificateVerifySignatureData ctx usedVersion sigAlg mhash msgs >>= + signatureCreateWithHashDescr ctx (toAlg `fmap` mhash) + where + toAlg hashAlg = (hashAlg, sigAlg) type CertVerifyData = (Hash, Bytes) prepareCertificateVerifySignatureData :: Context -> Version - -> Maybe HashAndSignatureAlgorithm + -> SignatureAlgorithm + -> Maybe HashAlgorithm -- TLS12 only -> Bytes -> IO CertVerifyData -prepareCertificateVerifySignatureData ctx usedVersion malg msgs +prepareCertificateVerifySignatureData ctx usedVersion sigAlg mhash msgs | usedVersion == SSL3 = do + (h, generateCV_SSL) <- + case sigAlg of + SignatureRSA -> return (SHA1_MD5, generateCertificateVerify_SSL) + SignatureDSS -> return (SHA1, generateCertificateVerify_SSL_DSS) + _ -> throwCore $ Error_Misc ("unsupported CertificateVerify signature for SSL3: " ++ show sigAlg) Just masterSecret <- usingHState ctx $ gets hstMasterSecret - return (SHA1_MD5, generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit SHA1_MD5) msgs)) - | usedVersion == TLS10 || usedVersion == TLS11 = do - return (SHA1_MD5, hashFinal $ hashUpdate (hashInit SHA1_MD5) msgs) - | otherwise = do - let Just hashSig = malg - hsh <- getHashAndASN1 hashSig - return (hsh, msgs) + return (h, generateCV_SSL masterSecret (hashUpdate (hashInit h) msgs)) + | usedVersion == TLS10 || usedVersion == TLS11 = + case signatureHashData sigAlg Nothing of + SHA1_MD5 -> return (SHA1_MD5, hashFinal $ hashUpdate (hashInit SHA1_MD5) msgs) + alg -> return (alg, msgs) + | otherwise = return (signatureHashData sigAlg mhash, msgs) signatureHashData :: SignatureAlgorithm -> Maybe HashAlgorithm -> Hash signatureHashData SignatureRSA mhash = @@ -95,19 +102,28 @@ Just HashSHA384 -> SHA384 Just HashSHA256 -> SHA256 Just HashSHA1 -> SHA1 - Nothing -> SHA1_MD5 + Nothing -> SHA1 Just hsh -> error ("unimplemented ECDSA signature hash type: " ++ show hsh) signatureHashData sig _ = error ("unimplemented signature type: " ++ show sig) --signatureCreate :: Context -> Maybe HashAndSignatureAlgorithm -> HashDescr -> Bytes -> IO DigitallySigned signatureCreate :: Context -> Maybe HashAndSignatureAlgorithm -> CertVerifyData -> IO DigitallySigned -signatureCreate ctx malg (hashAlg, toSign) = do - cc <- usingState_ ctx $ isClientContext +signatureCreate ctx malg (hashAlg, toSign) = + -- in the case of TLS < 1.2, RSA signing, then the data need to be hashed first, as + -- the SHA_MD5 algorithm expect an already digested data let signData = case (malg, hashAlg) of (Nothing, SHA1_MD5) -> hashFinal $ hashUpdate (hashInit SHA1_MD5) toSign _ -> toSign - DigitallySigned malg <$> signPrivate ctx cc hashAlg signData + in signatureCreateWithHashDescr ctx malg (hashAlg, signData) + +signatureCreateWithHashDescr :: Context + -> Maybe HashAndSignatureAlgorithm + -> CertVerifyData + -> IO DigitallySigned +signatureCreateWithHashDescr ctx malg (hashDescr, toSign) = do + cc <- usingState_ ctx $ isClientContext + DigitallySigned malg <$> signPrivate ctx cc hashDescr toSign signatureVerify :: Context -> DigitallySigned -> SignatureAlgorithm -> Bytes -> IO Bool signatureVerify ctx digSig@(DigitallySigned hashSigAlg _) sigAlgExpected toVerifyData = do @@ -138,32 +154,28 @@ SignatureECDSA -> verifyPublic ctx cc hashDescr toVerify bs _ -> error "signature verification not implemented yet" -digitallySignParams :: Context -> Bytes -> SignatureAlgorithm -> IO DigitallySigned -digitallySignParams ctx signatureData sigAlg = do - usedVersion <- usingState_ ctx getVersion - let mhash = case usedVersion of - TLS12 -> case filter ((==) sigAlg . snd) $ supportedHashSignatures $ ctxSupported ctx of - [] -> error ("no hash signature for " ++ show sigAlg) - x:_ -> Just (fst x) - _ -> Nothing +digitallySignParams :: Context -> Bytes -> SignatureAlgorithm -> Maybe HashAlgorithm -> IO DigitallySigned +digitallySignParams ctx signatureData sigAlg mhash = do let hashDescr = signatureHashData sigAlg mhash signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) (hashDescr, signatureData) digitallySignDHParams :: Context -> ServerDHParams -> SignatureAlgorithm + -> Maybe HashAlgorithm -- TLS12 only -> IO DigitallySigned -digitallySignDHParams ctx serverParams sigAlg = do +digitallySignDHParams ctx serverParams sigAlg mhash = do dhParamsData <- withClientAndServerRandom ctx $ encodeSignedDHParams serverParams - digitallySignParams ctx dhParamsData sigAlg + digitallySignParams ctx dhParamsData sigAlg mhash digitallySignECDHParams :: Context -> ServerECDHParams -> SignatureAlgorithm + -> Maybe HashAlgorithm -- TLS12 only -> IO DigitallySigned -digitallySignECDHParams ctx serverParams sigAlg = do +digitallySignECDHParams ctx serverParams sigAlg mhash = do ecdhParamsData <- withClientAndServerRandom ctx $ encodeSignedECDHParams serverParams - digitallySignParams ctx ecdhParamsData sigAlg + digitallySignParams ctx ecdhParamsData sigAlg mhash digitallySignDHParamsVerify :: Context -> ServerDHParams diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Handshake/State.hs new/tls-1.3.10/Network/TLS/Handshake/State.hs --- old/tls-1.3.9/Network/TLS/Handshake/State.hs 2016-12-17 12:09:25.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Handshake/State.hs 2016-12-20 08:24:41.000000000 +0100 @@ -20,7 +20,13 @@ , getLocalPrivateKey , getRemotePublicKey , setServerDHParams + , getServerDHParams , setServerECDHParams + , getServerECDHParams + , setDHPrivate + , getDHPrivate + , setECDHPrivate + , getECDHPrivate -- * cert accessors , setClientCertSent , getClientCertSent @@ -138,12 +144,30 @@ getLocalPrivateKey :: HandshakeM PrivKey getLocalPrivateKey = fromJust "local private key" <$> gets (hksLocalPrivateKey . hstKeyState) +getServerDHParams :: HandshakeM ServerDHParams +getServerDHParams = fromJust "server DH params" <$> gets hstServerDHParams + +getServerECDHParams :: HandshakeM ServerECDHParams +getServerECDHParams = fromJust "server ECDH params" <$> gets hstServerECDHParams + setServerDHParams :: ServerDHParams -> HandshakeM () setServerDHParams shp = modify (\hst -> hst { hstServerDHParams = Just shp }) setServerECDHParams :: ServerECDHParams -> HandshakeM () setServerECDHParams shp = modify (\hst -> hst { hstServerECDHParams = Just shp }) +getDHPrivate :: HandshakeM DHPrivate +getDHPrivate = fromJust "server DH private" <$> gets hstDHPrivate + +getECDHPrivate :: HandshakeM ECDHPrivate +getECDHPrivate = fromJust "server ECDH private" <$> gets hstECDHPrivate + +setDHPrivate :: DHPrivate -> HandshakeM () +setDHPrivate shp = modify (\hst -> hst { hstDHPrivate = Just shp }) + +setECDHPrivate :: ECDHPrivate -> HandshakeM () +setECDHPrivate shp = modify (\hst -> hst { hstECDHPrivate = Just shp }) + setCertReqSent :: Bool -> HandshakeM () setCertReqSent b = modify (\hst -> hst { hstCertReqSent = b }) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/IO.hs new/tls-1.3.10/Network/TLS/IO.hs --- old/tls-1.3.9/Network/TLS/IO.hs 2014-10-13 10:02:04.000000000 +0200 +++ new/tls-1.3.10/Network/TLS/IO.hs 2016-12-20 08:24:41.000000000 +0100 @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-} -- | -- Module : Network.TLS.IO diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Packet.hs new/tls-1.3.10/Network/TLS/Packet.hs --- old/tls-1.3.9/Network/TLS/Packet.hs 2016-12-17 12:09:25.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Packet.hs 2017-03-14 07:12:25.000000000 +0100 @@ -52,6 +52,7 @@ , generateServerFinished , generateCertificateVerify_SSL + , generateCertificateVerify_SSL_DSS -- * for extensions parsing , getSignatureHashAlgorithm @@ -666,9 +667,20 @@ | ver < TLS10 = generateFinished_SSL "SRVR" | otherwise = generateFinished_TLS (getPRF ver ciph) "server finished" +{- returns *output* after final MD5/SHA1 -} generateCertificateVerify_SSL :: Bytes -> HashCtx -> Bytes generateCertificateVerify_SSL = generateFinished_SSL "" +{- returns *input* before final SHA1 -} +generateCertificateVerify_SSL_DSS :: Bytes -> HashCtx -> Bytes +generateCertificateVerify_SSL_DSS mastersecret hashctx = toHash + where toHash = B.concat [ mastersecret, pad2, sha1left ] + + sha1left = hashFinal $ flip hashUpdate pad1 + $ hashUpdate hashctx mastersecret + pad2 = B.replicate 40 0x5c + pad1 = B.replicate 40 0x36 + encodeSignedDHParams :: ServerDHParams -> ClientRandom -> ServerRandom -> Bytes encodeSignedDHParams dhparams cran sran = runPut $ putClientRandom32 cran >> putServerRandom32 sran >> putServerDHParams dhparams diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Parameters.hs new/tls-1.3.10/Network/TLS/Parameters.hs --- old/tls-1.3.9/Network/TLS/Parameters.hs 2016-12-17 12:09:25.000000000 +0100 +++ new/tls-1.3.10/Network/TLS/Parameters.hs 2017-03-14 07:12:25.000000000 +0100 @@ -153,7 +153,14 @@ -- | supported compressions methods , supportedCompressions :: [Compression] -- | All supported hash/signature algorithms pair for client - -- certificate verification, ordered by decreasing priority. + -- certificate verification and server signature in (EC)DHE, + -- ordered by decreasing priority. + -- + -- This list is sent to the peer as part of the signature_algorithms + -- extension. It is also used to restrict the choice of hash and + -- signature algorithm, but only when the TLS version is 1.2 or above. + -- In order to disable SHA-1 one must then also disable earlier protocol + -- versions in 'supportedVersions'. , supportedHashSignatures :: [HashAndSignatureAlgorithm] -- | Secure renegotiation defined in RFC5746. -- If 'True', clients send the renegotiation_info extension. @@ -246,6 +253,10 @@ Maybe [HashAndSignatureAlgorithm], [DistinguishedName]) -> IO (Maybe (CertificateChain, PrivKey)) , onNPNServerSuggest :: Maybe ([B.ByteString] -> IO B.ByteString) + -- | Used by the client to validate the server certificate. The default + -- implementation calls 'validateDefault' which validates according to the + -- default hooks and checks provided by "Data.X509.Validation". This can + -- be replaced with a custom validation function using different settings. , onServerCertificate :: CertificateStore -> ValidationCache -> ServiceID -> CertificateChain -> IO [FailedReason] , onSuggestALPN :: IO (Maybe [B.ByteString]) } @@ -272,9 +283,8 @@ onClientCertificate :: CertificateChain -> IO CertificateUsage -- | This action is called when the client certificate - -- cannot be verified. A 'Nothing' argument indicates a - -- wrong signature, a 'Just e' message signals a crypto - -- error. + -- cannot be verified. Return 'True' to accept the certificate + -- anyway, or 'False' to fail verification. , onUnverifiedClientCert :: IO Bool -- | Allow the server to choose the cipher relative to the diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Record/State.hs new/tls-1.3.10/Network/TLS/Record/State.hs --- old/tls-1.3.9/Network/TLS/Record/State.hs 2016-05-07 08:24:19.000000000 +0200 +++ new/tls-1.3.10/Network/TLS/Record/State.hs 2016-12-20 08:24:41.000000000 +0100 @@ -1,4 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} -- | diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Network/TLS/Wire.hs new/tls-1.3.10/Network/TLS/Wire.hs --- old/tls-1.3.9/Network/TLS/Wire.hs 2015-09-21 23:00:21.000000000 +0200 +++ new/tls-1.3.10/Network/TLS/Wire.hs 2016-12-20 08:24:41.000000000 +0100 @@ -22,6 +22,7 @@ , getWord16 , getWords16 , getWord24 + , getWord32 , getBytes , getOpaque8 , getOpaque16 @@ -38,6 +39,7 @@ , putWord16 , putWords16 , putWord24 + , putWord32 , putBytes , putOpaque8 , putOpaque16 @@ -104,6 +106,9 @@ c <- fromIntegral <$> getWord8 return $ (a `shiftL` 16) .|. (b `shiftL` 8) .|. c +getWord32 :: Get Word32 +getWord32 = getWord32be + getOpaque8 :: Get Bytes getOpaque8 = getWord8 >>= getBytes . fromIntegral diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Tests/Connection.hs new/tls-1.3.10/Tests/Connection.hs --- old/tls-1.3.9/Tests/Connection.hs 2016-12-17 12:09:25.000000000 +0100 +++ new/tls-1.3.10/Tests/Connection.hs 2017-03-14 07:12:25.000000000 +0100 @@ -1,10 +1,17 @@ module Connection ( newPairContext , arbitraryPairParams + , arbitraryPairParamsWithVersionsAndCiphers + , arbitraryClientCredential , setPairParamsSessionManager , setPairParamsSessionResuming , establishDataPipe + , initiateDataPipe , blockCipher + , blockCipherDHE_RSA + , blockCipherDHE_DSS + , blockCipherECDHE_RSA + , blockCipherECDHE_RSA_SHA384 , streamCipher ) where @@ -13,6 +20,7 @@ import PubKey import PipeChan import Network.TLS +import Network.TLS.Extra.FFDHE import Data.X509 import Data.Default.Class import Control.Applicative @@ -102,38 +110,57 @@ knownVersions :: [Version] knownVersions = [SSL3,TLS10,TLS11,TLS12] -arbitraryPairParams = do - (dsaPub, dsaPriv) <- (\(p,r) -> (PubKeyDSA p, PrivKeyDSA r)) <$> arbitraryDSAPair - let (pubKey, privKey) = (\(p, r) -> (PubKeyRSA p, PrivKeyRSA r)) $ getGlobalRSAPair - creds <- mapM (\(pub, priv) -> do - cert <- arbitraryX509WithKey (pub, priv) - return (CertificateChain [cert], priv) - ) [ (pubKey, privKey), (dsaPub, dsaPriv) ] - connectVersion <- elements knownVersions +arbitraryCredentialsOfEachType = do + let (pubKey, privKey) = getGlobalRSAPair + (dsaPub, dsaPriv) <- arbitraryDSAPair + mapM (\(pub, priv) -> do + cert <- arbitraryX509WithKey (pub, priv) + return (CertificateChain [cert], priv) + ) [ (PubKeyRSA pubKey, PrivKeyRSA privKey) + , (PubKeyDSA dsaPub, PrivKeyDSA dsaPriv) + ] + +arbitraryCipherPair :: Version -> Gen ([Cipher], [Cipher]) +arbitraryCipherPair connectVersion = do serverCiphers <- arbitraryCiphers `suchThat` (\cs -> or [maybe True (<= connectVersion) (cipherMinVer x) | x <- cs]) clientCiphers <- oneof [arbitraryCiphers] `suchThat` (\cs -> or [x `elem` serverCiphers && maybe True (<= connectVersion) (cipherMinVer x) | x <- cs]) + return (clientCiphers, serverCiphers) + where + arbitraryCiphers = resize (length knownCiphers + 1) $ listOf1 (elements knownCiphers) + +arbitraryPairParams :: Gen (ClientParams, ServerParams) +arbitraryPairParams = do + connectVersion <- elements knownVersions + (clientCiphers, serverCiphers) <- arbitraryCipherPair connectVersion -- The shared ciphers may set a floor on the compatible protocol versions let allowedVersions = [ v | v <- knownVersions, or [ x `elem` serverCiphers && maybe True (<= v) (cipherMinVer x) | x <- clientCiphers ]] serAllowedVersions <- (:[]) `fmap` elements allowedVersions - secNeg <- arbitrary + arbitraryPairParamsWithVersionsAndCiphers (allowedVersions, serAllowedVersions) (clientCiphers, serverCiphers) +arbitraryPairParamsWithVersionsAndCiphers :: ([Version], [Version]) + -> ([Cipher], [Cipher]) + -> Gen (ClientParams, ServerParams) +arbitraryPairParamsWithVersionsAndCiphers (clientVersions, serverVersions) (clientCiphers, serverCiphers) = do + secNeg <- arbitrary + dhparams <- elements [dhParams,ffdhe2048,ffdhe3072] + creds <- arbitraryCredentialsOfEachType let serverState = def { serverSupported = def { supportedCiphers = serverCiphers - , supportedVersions = serAllowedVersions + , supportedVersions = serverVersions , supportedSecureRenegotiation = secNeg } - , serverDHEParams = Just dhParams + , serverDHEParams = Just dhparams , serverShared = def { sharedCredentials = Credentials creds } } let clientState = (defaultParamsClient "" B.empty) { clientSupported = def { supportedCiphers = clientCiphers - , supportedVersions = allowedVersions + , supportedVersions = clientVersions , supportedSecureRenegotiation = secNeg } , clientShared = def { sharedValidationCache = ValidationCache @@ -143,8 +170,9 @@ } } return (clientState, serverState) - where - arbitraryCiphers = resize (length knownCiphers + 1) $ listOf1 (elements knownCiphers) + +arbitraryClientCredential :: Gen Credential +arbitraryClientCredential = arbitraryCredentialsOfEachType >>= elements setPairParamsSessionManager :: SessionManager -> (ClientParams, ServerParams) -> (ClientParams, ServerParams) setPairParamsSessionManager manager (clientState, serverState) = (nc,ns) @@ -197,3 +225,27 @@ putStrLn $ s ++ " exception: " ++ show e ++ ", supported: " ++ show supported E.throw e + +initiateDataPipe params tlsServer tlsClient = do + -- initial setup + pipe <- newPipe + _ <- (runPipe pipe) + cQueue <- newChan + sQueue <- newChan + + (cCtx, sCtx) <- newPairContext pipe params + + _ <- forkIO $ E.catch (tlsServer sCtx >>= writeSuccess sQueue) + (writeException sQueue) + _ <- forkIO $ E.catch (tlsClient cCtx >>= writeSuccess cQueue) + (writeException cQueue) + + sRes <- readChan sQueue + cRes <- readChan cQueue + return (cRes, sRes) + where + writeException :: Chan (Either E.SomeException a) -> E.SomeException -> IO () + writeException queue e = writeChan queue (Left e) + + writeSuccess :: Chan (Either E.SomeException a) -> a -> IO () + writeSuccess queue res = writeChan queue (Right res) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/Tests/Tests.hs new/tls-1.3.10/Tests/Tests.hs --- old/tls-1.3.9/Tests/Tests.hs 2015-08-10 11:37:10.000000000 +0200 +++ new/tls-1.3.10/Tests/Tests.hs 2017-03-14 07:12:25.000000000 +0100 @@ -10,6 +10,7 @@ import Ciphers import Data.Maybe +import Data.List (intersect) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C8 @@ -55,10 +56,7 @@ Just d `assertEq` dres return () -prop_handshake_initiate :: PropertyM IO () -prop_handshake_initiate = do - params <- pick arbitraryPairParams - runTLSPipe params tlsServer tlsClient +runTLSPipeSimple params = runTLSPipe params tlsServer tlsClient where tlsServer ctx queue = do handshake ctx d <- recvDataNonNull ctx @@ -71,6 +69,66 @@ bye ctx return () +runTLSInitFailure params = do + (cRes, sRes) <- run (initiateDataPipe params tlsServer tlsClient) + assertIsLeft cRes + assertIsLeft sRes + where tlsServer ctx = handshake ctx >> bye ctx >> return "server success" + tlsClient ctx = handshake ctx >> bye ctx >> return "client success" + +prop_handshake_initiate :: PropertyM IO () +prop_handshake_initiate = do + params <- pick arbitraryPairParams + runTLSPipeSimple params + +-- test TLS12 protocol extensions with non-default configuration +prop_handshake_initiate_tls12 :: PropertyM IO () +prop_handshake_initiate_tls12 = do + let clientVersions = [TLS12] + serverVersions = [TLS12] + ciphers = [ blockCipherECDHE_RSA_SHA384 + , blockCipherECDHE_RSA + , blockCipherDHE_RSA + , blockCipherDHE_DSS + ] + (clientParam,serverParam) <- pick $ arbitraryPairParamsWithVersionsAndCiphers + (clientVersions, serverVersions) + (ciphers, ciphers) + clientHashSigs <- pick someHashSignatures + serverHashSigs <- pick someHashSignatures + let clientParam' = clientParam { clientSupported = (clientSupported clientParam) + { supportedHashSignatures = clientHashSigs } + } + serverParam' = serverParam { serverSupported = (serverSupported serverParam) + { supportedHashSignatures = serverHashSigs } + } + shouldFail = null (clientHashSigs `intersect` serverHashSigs) + if shouldFail + then runTLSInitFailure (clientParam',serverParam') + else runTLSPipeSimple (clientParam',serverParam') + where someHashSignatures = sublistOf [ (HashSHA512, SignatureRSA) + , (HashSHA384, SignatureRSA) + , (HashSHA256, SignatureRSA) + , (HashSHA1, SignatureRSA) + , (HashSHA1, SignatureDSS) + ] + +prop_handshake_client_auth_initiate :: PropertyM IO () +prop_handshake_client_auth_initiate = do + (clientParam,serverParam) <- pick arbitraryPairParams + cred <- pick arbitraryClientCredential + let clientParam' = clientParam { clientHooks = (clientHooks clientParam) + { onCertificateRequest = \_ -> return $ Just cred } + } + serverParam' = serverParam { serverWantClientCert = True + , serverHooks = (serverHooks serverParam) + { onClientCertificate = validateChain cred } + } + runTLSPipeSimple (clientParam',serverParam') + where validateChain cred chain + | chain == fst cred = return CertificateUsageAccept + | otherwise = return (CertificateUsageReject CertificateRejectUnknownCA) + prop_handshake_npn_initiate :: PropertyM IO () prop_handshake_npn_initiate = do (clientParam,serverParam) <- pick arbitraryPairParams @@ -141,29 +199,22 @@ plainParams <- pick arbitraryPairParams let params = setPairParamsSessionManager sessionManager plainParams - runTLSPipe params tlsServer tlsClient + runTLSPipeSimple params -- and resume sessionParams <- run $ readIORef sessionRef assert (isJust sessionParams) let params2 = setPairParamsSessionResuming (fromJust sessionParams) params - runTLSPipe params2 tlsServer tlsClient - 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 () + runTLSPipeSimple params2 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) +assertIsLeft :: (Show b, Monad m) => Either a b -> m () +assertIsLeft (Left _) = return() +assertIsLeft (Right b) = error ("got " ++ show b ++ " but was expecting a failure") + main :: IO () main = defaultMain $ testGroup "tls" [ tests_marshalling @@ -182,6 +233,8 @@ tests_handshake = testGroup "Handshakes" [ testProperty "setup" (monadicIO prop_pipe_work) , testProperty "initiate" (monadicIO prop_handshake_initiate) + , testProperty "initiate TLS12" (monadicIO prop_handshake_initiate_tls12) + , testProperty "clientAuthInitiate" (monadicIO prop_handshake_client_auth_initiate) , testProperty "npnInitiate" (monadicIO prop_handshake_npn_initiate) , testProperty "renegociation" (monadicIO prop_handshake_renegociation) , testProperty "resumption" (monadicIO prop_handshake_session_resumption) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.3.9/tls.cabal new/tls-1.3.10/tls.cabal --- old/tls-1.3.9/tls.cabal 2016-12-17 12:54:03.000000000 +0100 +++ new/tls-1.3.10/tls.cabal 2017-03-14 08:08:04.000000000 +0100 @@ -1,5 +1,5 @@ Name: tls -Version: 1.3.9 +Version: 1.3.10 Description: Native Haskell TLS and SSL protocol implementation for server and client. . @@ -55,9 +55,9 @@ , x509 >= 1.6.5 && < 1.7.0 , x509-store >= 1.6 , x509-validation >= 1.6.5 && < 1.7.0 - , async + , async >= 2.0 if flag(network) - Build-Depends: network + Build-Depends: network >= 2.4.0.0 cpp-options: -DINCLUDE_NETWORK if flag(hans) Build-Depends: hans @@ -68,6 +68,7 @@ Network.TLS.Internal Network.TLS.Extra Network.TLS.Extra.Cipher + Network.TLS.Extra.FFDHE other-modules: Network.TLS.Cap Network.TLS.Struct Network.TLS.Core ++++++ tls.cabal ++++++ Name: tls Version: 1.3.10 x-revision: 1 Description: Native Haskell TLS and SSL protocol implementation for server and client. . This provides a high-level implementation of a sensitive security protocol, eliminating a common set of security issues through the use of the advanced type system, high level constructions and common Haskell features. . Currently implement the SSL3.0, TLS1.0, TLS1.1 and TLS1.2 protocol, and support RSA and Ephemeral (Elliptic curve and regular) Diffie Hellman key exchanges, and many extensions. . Some debug tools linked with tls, are available through the <http://hackage.haskell.org/package/tls-debug/>. License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez <[email protected]> Author: Vincent Hanquez <[email protected]> Maintainer: Vincent Hanquez <[email protected]> Synopsis: TLS/SSL protocol native implementation (Server and Client) Build-Type: Simple Category: Network stability: experimental Cabal-Version: >=1.8 Homepage: http://github.com/vincenthz/hs-tls extra-source-files: Tests/*.hs CHANGELOG.md Flag compat Description: Accept SSLv2 client hello for beginning SSLv3 / TLS handshake Default: True Flag network Description: Use the base network library Default: True Flag hans Description: Use the Haskell Network Stack (HaNS) Default: False Library Build-Depends: base >= 4.6 && < 5 , mtl >= 2 && < 2.3 , transformers < 0.6 , cereal >= 0.4 && < 0.6 , bytestring < 0.11 , data-default-class < 0.2 -- crypto related , memory < 0.15 , cryptonite >= 0.21 && < 0.23 -- certificate related , asn1-types >= 0.2.0 && < 0.4 , asn1-encoding < 0.10 , x509 >= 1.6.5 && < 1.7 , x509-store >= 1.6 && < 1.7 , x509-validation >= 1.6.5 && < 1.7 , async >= 2.0 && < 2.2 if flag(network) Build-Depends: network >= 2.4.0.0 && < 2.7 cpp-options: -DINCLUDE_NETWORK if flag(hans) Build-Depends: hans cpp-options: -DINCLUDE_HANS Exposed-modules: Network.TLS Network.TLS.Cipher Network.TLS.Compression Network.TLS.Internal Network.TLS.Extra Network.TLS.Extra.Cipher Network.TLS.Extra.FFDHE other-modules: Network.TLS.Cap Network.TLS.Struct Network.TLS.Core Network.TLS.Context Network.TLS.Context.Internal Network.TLS.Credentials Network.TLS.Backend Network.TLS.Crypto Network.TLS.Crypto.DH Network.TLS.Crypto.ECDH Network.TLS.ErrT Network.TLS.Extension Network.TLS.Extension.EC Network.TLS.Handshake Network.TLS.Handshake.Common Network.TLS.Handshake.Certificate Network.TLS.Handshake.Key Network.TLS.Handshake.Client Network.TLS.Handshake.Server Network.TLS.Handshake.Process Network.TLS.Handshake.Signature Network.TLS.Handshake.State Network.TLS.Hooks Network.TLS.IO Network.TLS.Imports Network.TLS.MAC Network.TLS.Measurement Network.TLS.Packet Network.TLS.Parameters Network.TLS.Record Network.TLS.Record.Types Network.TLS.Record.Engage Network.TLS.Record.Disengage Network.TLS.Record.State Network.TLS.RNG Network.TLS.State Network.TLS.Session Network.TLS.Sending Network.TLS.Receiving Network.TLS.Util Network.TLS.Util.ASN1 Network.TLS.Util.Serialization Network.TLS.Types Network.TLS.Wire Network.TLS.X509 ghc-options: -Wall -fwarn-tabs -fno-warn-unused-imports if flag(compat) cpp-options: -DSSLV2_COMPATIBLE Test-Suite test-tls type: exitcode-stdio-1.0 hs-source-dirs: Tests Main-is: Tests.hs other-modules: Certificate Ciphers Connection Marshalling PipeChan PubKey Build-Depends: base >= 3 && < 5 , mtl , cereal >= 0.3 , data-default-class , tasty , tasty-quickcheck , tls , QuickCheck , cryptonite , bytestring , x509 , x509-validation , hourglass ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -fwarn-tabs Benchmark bench-tls hs-source-dirs: Benchmarks Tests Main-Is: Benchmarks.hs type: exitcode-stdio-1.0 Build-depends: base >= 4 && < 5 , tls , x509 , x509-validation , data-default-class , cryptonite , criterion >= 1.0 , mtl , bytestring , hourglass , QuickCheck >= 2 , tasty-quickcheck , tls source-repository head type: git location: https://github.com/vincenthz/hs-tls subdir: core
