Improve version negotiation

core/Network/TLS/Handshake/Client.hs

@@ -159,7 +159,7 @@ handshakeClient' cparams ctx groups mcrand = do
 
         versionExtension
           | tls13 = do
-                let vers = filter (>= TLS12) $ supportedVersions $ ctxSupported ctx
+                let vers = filter (>= TLS10) $ supportedVersions $ ctxSupported ctx
                 return $ Just $ toExtensionRaw $ SupportedVersionsClientHello vers
           | otherwise = return Nothing
 
@@ -641,6 +641,10 @@ onServerHello ctx cparams sentExts (ServerHello rver serverRan serverSession cip
         Nothing -> throwCore $ Error_Protocol ("server version " ++ show ver ++ " is not supported", True, ProtocolVersion)
         Just _  -> return ()
     if ver > TLS12 then do
+        established <- ctxEstablished ctx
+        eof <- ctxEOF ctx
+        when (established == Established && not eof) $
+            throwCore $ Error_Protocol ("renegotiation to TLS 1.3 or later is not allowed", True, ProtocolVersion)
         ensureNullCompression compression
         usingHState ctx $ setHelloParameters13 cipherAlg
         return RecvStateDone

core/Network/TLS/Handshake/Server.hs

@@ -83,17 +83,17 @@ handshakeServer sparams ctx = liftIO $ do
 --      -> finish             <- finish
 --
 handshakeServerWith :: ServerParams -> Context -> Handshake -> IO ()
-handshakeServerWith sparams ctx clientHello@(ClientHello clientVersion _ clientSession ciphers compressions exts _) = do
+handshakeServerWith sparams ctx clientHello@(ClientHello legacyVersion _ clientSession ciphers compressions exts _) = do
     established <- ctxEstablished ctx
     -- renego is not allowed in TLS 1.3
     when (established /= NotEstablished) $ do
         ver <- usingState_ ctx (getVersionWithDefault TLS10)
-        when (ver == TLS13) $ throwCore $ Error_Protocol ("renegotiation is not allowed in TLS 1.3", False, NoRenegotiation)
+        when (ver == TLS13) $ throwCore $ Error_Protocol ("renegotiation is not allowed in TLS 1.3", True, UnexpectedMessage)
     -- rejecting client initiated renegotiation to prevent DOS.
-    unless (supportedClientInitiatedRenegotiation (ctxSupported ctx)) $ do
-        eof <- ctxEOF ctx
-        when (established == Established && not eof) $
-            throwCore $ Error_Protocol ("renegotiation is not allowed", False, NoRenegotiation)
+    eof <- ctxEOF ctx
+    let renegotiation = established == Established && not eof
+    when (renegotiation && not (supportedClientInitiatedRenegotiation $ ctxSupported ctx)) $
+        throwCore $ Error_Protocol ("renegotiation is not allowed", False, NoRenegotiation)
     -- check if policy allow this new handshake to happens
     handshakeAuthorized <- withMeasure ctx (onNewHandshake $ serverHooks sparams)
     unless handshakeAuthorized (throwCore $ Error_HandshakePolicy "server: handshake denied")
@@ -103,26 +103,29 @@ handshakeServerWith sparams ctx clientHello@(ClientHello clientVersion _ clientS
     processHandshake ctx clientHello
 
     -- rejecting SSL2. RFC 6176
-    when (clientVersion == SSL2) $ throwCore $ Error_Protocol ("SSL 2.0 is not supported", True, ProtocolVersion)
+    when (legacyVersion == 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)
+    -- when (legacyVersion == SSL3) $ throwCore $ Error_Protocol ("SSL 3.0 is not supported", True, ProtocolVersion)
 
     -- Fallback SCSV: RFC7507
     -- TLS_FALLBACK_SCSV: {0x56, 0x00}
     when (supportedFallbackScsv (ctxSupported ctx) &&
           (0x5600 `elem` ciphers) &&
-          clientVersion < TLS12) $
+          legacyVersion < TLS12) $
         throwCore $ Error_Protocol ("fallback is not allowed", True, InappropriateFallback)
     -- choosing TLS version
     let clientVersions = case extensionLookup extensionID_SupportedVersions exts >>= extensionDecode MsgTClientHello of
             Just (SupportedVersionsClientHello vers) -> vers
             _                                        -> []
-        serverVersions = supportedVersions $ ctxSupported ctx
+        clientVersion = min TLS12 legacyVersion
+        serverVersions
+            | renegotiation = filter (< TLS13) (supportedVersions $ ctxSupported ctx)
+            | otherwise     = supportedVersions $ ctxSupported ctx
         mVersion = debugVersionForced $ serverDebug sparams
     chosenVersion <- case mVersion of
       Just cver -> return cver
       Nothing   ->
-        if (TLS13 `elem` serverVersions) && clientVersion == TLS12 && clientVersions /= [] then case findHighestVersionFrom13 clientVersions serverVersions of
+        if (TLS13 `elem` serverVersions) && clientVersions /= [] then case findHighestVersionFrom13 clientVersions serverVersions of
                   Nothing -> throwCore $ Error_Protocol ("client versions " ++ show clientVersions ++ " is not supported", True, ProtocolVersion)
                   Just v  -> return v
            else case findHighestVersionFrom clientVersion serverVersions of

core/Network/TLS/Parameters.hs

@@ -161,9 +161,13 @@ instance Default ServerParams where
 -- | List all the supported algorithms, versions, ciphers, etc supported.
 data Supported = Supported
     {
-      -- | Supported Versions by this context
-      -- On the client side, the highest version will be used to establish the connection.
-      -- On the server side, the highest version that is less or equal than the client version will be chosed.
+      -- | Supported versions by this context.  On the client side, the highest
+      -- version will be used to establish the connection.  On the server side,
+      -- the highest version that is less or equal than the client version will
+      -- be chosen.
+      --
+      -- Versions should be listed in preference order, i.e. higher versions
+      -- first.
       supportedVersions       :: [Version]
       -- | Supported cipher methods.  The default is empty, specify a suitable
       -- cipher list.  'Network.TLS.Extra.Cipher.ciphersuite_default' is often

core/Tests/Connection.hs

@@ -64,7 +64,7 @@ arbitraryCiphers :: Gen [Cipher]
 arbitraryCiphers = listOf1 $ elements knownCiphers
 
 knownVersions :: [Version]
-knownVersions = [SSL3,TLS10,TLS11,TLS12,TLS13]
+knownVersions = [TLS13,TLS12,TLS11,TLS10,SSL3]
 
 arbitraryVersions :: Gen [Version]
 arbitraryVersions = sublistOf knownVersions

core/Tests/Tests.hs

@@ -594,7 +594,7 @@ prop_handshake_dh = do
 prop_handshake_srv_key_usage :: PropertyM IO ()
 prop_handshake_srv_key_usage = do
     tls13 <- pick arbitrary
-    let versions = if tls13 then [TLS13] else [SSL3,TLS10,TLS11,TLS12]
+    let versions = if tls13 then [TLS13] else [TLS12,TLS11,TLS10,SSL3]
         ciphers = [ cipher_ECDHE_RSA_AES128CBC_SHA
                   , cipher_TLS13_AES128GCM_SHA256
                   , cipher_DHE_RSA_AES128_SHA1

debug/src/SimpleClient.hs

@@ -123,7 +123,7 @@ getDefaultParams flags host store sStorage certCredsRequest session earlyData =
             supportedVers
                 | NoVersionDowngrade `elem` flags = [tlsConnectVer]
                 | otherwise = filter (<= tlsConnectVer) allVers
-            allVers = [SSL3, TLS10, TLS11, TLS12, TLS13]
+            allVers = [TLS13, TLS12, TLS11, TLS10, SSL3]
             validateCert = not (NoValidateCert `elem` flags)
 
 getGroups flags = case getGroup >>= readGroups of

debug/src/SimpleServer.hs

@@ -120,7 +120,7 @@ getDefaultParams flags store smgr cred rtt0accept = do
             supportedVers
                 | NoVersionDowngrade `elem` flags = [tlsConnectVer]
                 | otherwise = filter (<= tlsConnectVer) allVers
-            allVers = [SSL3, TLS10, TLS11, TLS12, TLS13]
+            allVers = [TLS13, TLS12, TLS11, TLS10, SSL3]
             validateCert = not (NoValidateCert `elem` flags)
             allowRenegotiation = AllowRenegotiation `elem` flags