work13.patch

From 50e84d47221665a3fd44c7300c690994fdec3fa7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= <olivier.cheron@gmail.com>
Date: Thu, 23 Aug 2018 21:22:09 +0200
Subject: [PATCH] Fix handling of CKX_RSA with TLS13-compatible client

hstClientVersion must be set to TLS12 instead of TLS13 on both sides of
the connection.

diff --git a/core/Network/TLS/Handshake/Client.hs b/core/Network/TLS/Handshake/Client.hs
index 9951fa18..134a98e0 100644
--- a/core/Network/TLS/Handshake/Client.hs
+++ b/core/Network/TLS/Handshake/Client.hs
@@ -233,10 +233,10 @@ handshakeClient' cparams ctx groups mcrand = do
             crand <- case mcr of
               Nothing -> ClientRandom <$> getStateRNG ctx 32
               Just cr -> return cr
-            startHandshake ctx highestVer crand
-            usingState_ ctx $ setVersionIfUnset highestVer
             let ver = if tls13 then TLS12 else highestVer
-                cipherIds = map cipherID ciphers
+            startHandshake ctx ver crand
+            usingState_ ctx $ setVersionIfUnset highestVer
+            let cipherIds = map cipherID ciphers
                 compIds = map compressionID compressions
                 mkClientHello exts = ClientHello ver crand clientSession cipherIds compIds exts Nothing
             extensions0 <- catMaybes <$> getExtensions

From ccb7743b59b733d0af522603a691be72adeb1890 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= <olivier.cheron@gmail.com>
Date: Thu, 23 Aug 2018 21:48:41 +0200
Subject: [PATCH] Generalize test cases to all versions

Still work in progress.  Not everything passes.

diff --git a/core/Tests/Connection.hs b/core/Tests/Connection.hs
index f656ca4d..dd704493 100644
--- a/core/Tests/Connection.hs
+++ b/core/Tests/Connection.hs
@@ -42,8 +42,16 @@ import qualified Data.ByteString as B
 debug :: Bool
 debug = False
 
+-- Pre-TLS13 ciphers have TLS12 as maximum allowed version
+cipherMaxVer :: Cipher -> Maybe Version
+cipherMaxVer x =
+    case cipherMinVer x of
+        Nothing            -> Just TLS12
+        Just v | v < TLS13 -> Just TLS12
+               | otherwise -> Nothing
+
 knownCiphers :: [Cipher]
-knownCiphers = filter nonTLS13 $ filter nonECDSA (ciphersuite_all ++ ciphersuite_weak)
+knownCiphers = filter nonECDSA (ciphersuite_all ++ ciphersuite_weak)
   where
     ciphersuite_weak = [
         cipher_DHE_DSS_RC4_SHA1
@@ -53,7 +61,6 @@ knownCiphers = filter nonTLS13 $ filter nonECDSA (ciphersuite_all ++ ciphersuite
       ]
     -- arbitraryCredentialsOfEachType cannot generate ECDSA
     nonECDSA c = not ("ECDSA" `isInfixOf` cipherName c)
-    nonTLS13 c = cipherMinVer c /= Just TLS13
 
 knownCiphers13 :: [Cipher]
 knownCiphers13 = [
@@ -65,7 +72,7 @@ arbitraryCiphers :: Gen [Cipher]
 arbitraryCiphers = listOf1 $ elements knownCiphers
 
 knownVersions :: [Version]
-knownVersions = [SSL3,TLS10,TLS11,TLS12]
+knownVersions = [SSL3,TLS10,TLS11,TLS12,TLS13]
 
 arbitraryVersions :: Gen [Version]
 arbitraryVersions = sublistOf knownVersions
@@ -120,20 +127,23 @@ leafPublicKey (CertificateChain (leaf:_)) = Just (certPubKey $ signedObject $ ge
 arbitraryCipherPair :: Version -> Gen ([Cipher], [Cipher])
 arbitraryCipherPair connectVersion = do
     serverCiphers      <- arbitraryCiphers `suchThat`
-                                (\cs -> or [maybe True (<= connectVersion) (cipherMinVer x) | x <- cs])
+                                (\cs -> or [maybe True (<= connectVersion) (cipherMinVer x) &&
+                                            maybe True (>= connectVersion) (cipherMaxVer x) | x <- cs])
     clientCiphers      <- arbitraryCiphers `suchThat`
                                 (\cs -> or [x `elem` serverCiphers &&
-                                            maybe True (<= connectVersion) (cipherMinVer x) | x <- cs])
+                                            maybe True (<= connectVersion) (cipherMinVer x) &&
+                                            maybe True (>= connectVersion) (cipherMaxVer x) | x <- cs])
     return (clientCiphers, serverCiphers)
 
 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
+    -- The shared ciphers may add constraints on the compatible protocol versions
     let allowedVersions = [ v | v <- knownVersions,
                                 or [ x `elem` serverCiphers &&
-                                     maybe True (<= v) (cipherMinVer x) | x <- clientCiphers ]]
+                                     maybe True (<= v) (cipherMinVer x) &&
+                                     maybe True (>= v) (cipherMaxVer x) | x <- clientCiphers ]]
     serAllowedVersions <- (:[]) `fmap` elements allowedVersions
     arbitraryPairParamsWithVersionsAndCiphers (allowedVersions, serAllowedVersions) (clientCiphers, serverCiphers)
 
diff --git a/core/Tests/Tests.hs b/core/Tests/Tests.hs
index 228d9f61..e2d3bcce 100644
--- a/core/Tests/Tests.hs
+++ b/core/Tests/Tests.hs
@@ -102,7 +102,8 @@ prop_handshake_ciphersuites = do
     (clientParam,serverParam) <- pick $ arbitraryPairParamsWithVersionsAndCiphers
                                             (clientVersions, serverVersions)
                                             (clientCiphers, serverCiphers)
-    let shouldFail = null (clientCiphers `intersect` serverCiphers)
+    let nonTLS13 c = cipherMinVer c /= Just TLS13
+        shouldFail = not $ any nonTLS13 (clientCiphers `intersect` serverCiphers)
     if shouldFail
         then runTLSInitFailure (clientParam,serverParam)
         else runTLSPipeSimple  (clientParam,serverParam)