Send "supported_groups" in encrypted extensions

core/Network/TLS/Handshake/Client.hs

@@ -99,7 +99,7 @@ handshakeClient' cparams ctx groups mcrand = do
                   Just _  -> error "handshakeClient': invalid KeyShare value"
                   Nothing -> throwCore $ Error_Protocol ("key exchange not implemented in HRR, expected key_share extension", True, HandshakeFailure)
           else do
-            handshakeClient13 cparams ctx
+            handshakeClient13 cparams ctx groupToSend
       else do
         sessionResuming <- usingState_ ctx isSessionResuming
         if sessionResuming
@@ -112,6 +112,7 @@ handshakeClient' cparams ctx groups mcrand = do
         compressions = supportedCompressions $ ctxSupported ctx
         highestVer = maximum $ supportedVersions $ ctxSupported ctx
         tls13 = highestVer >= TLS13
+        groupToSend = listToMaybe groups
         getExtensions pskInfo rtt0 = sequence
             [ sniExtension
             , secureReneg
@@ -166,9 +167,9 @@ handshakeClient' cparams ctx groups mcrand = do
 
         -- FIXME
         keyshareExtension
-          | tls13 = case groups of
-                  []    -> return Nothing
-                  grp:_ -> do
+          | tls13 = case groupToSend of
+                  Nothing  -> return Nothing
+                  Just grp -> do
                       (cpri, ent) <- makeClientKeyShare ctx grp
                       usingHState ctx $ setGroupPrivate cpri
                       return $ Just $ toExtensionRaw $ KeyShareClientHello [ent]
@@ -792,14 +793,14 @@ requiredCertKeyUsage cipher =
                            , KeyUsage_keyAgreement
                            ]
 
-handshakeClient13 :: ClientParams -> Context -> IO ()
-handshakeClient13 _cparams ctx = do
+handshakeClient13 :: ClientParams -> Context -> Maybe Group -> IO ()
+handshakeClient13 cparams ctx groupSent = do
     usedCipher <- usingHState ctx getPendingCipher
     let usedHash = cipherHash usedCipher
-    handshakeClient13' _cparams ctx usedCipher usedHash
+    handshakeClient13' cparams ctx groupSent usedCipher usedHash
 
-handshakeClient13' :: ClientParams -> Context -> Cipher -> Hash -> IO ()
-handshakeClient13' cparams ctx usedCipher usedHash = do
+handshakeClient13' :: ClientParams -> Context -> Maybe Group -> Cipher -> Hash -> IO ()
+handshakeClient13' cparams ctx groupSent usedCipher usedHash = do
     (resuming, handshakeSecret, clientHandshakeTrafficSecret, serverHandshakeTrafficSecret) <- switchToHandshakeSecret
     rtt0accepted <- runRecvHandshake13 $ do
         accepted <- recvHandshake13preUpdate ctx expectEncryptedExtensions
@@ -849,7 +850,8 @@ handshakeClient13' cparams ctx usedCipher usedHash = do
               Just _                        -> error "calcSharedKey: invalid KeyShare value"
               Nothing                       -> throwCore $ Error_Protocol ("key exchange not implemented, expected key_share extension", True, HandshakeFailure)
         let grp = keyShareEntryGroup serverKeyShare
-        checkSupportedGroup ctx grp
+        unless (groupSent == Just grp) $
+            throwCore $ Error_Protocol ("received incompatible group for (EC)DHE", True, IllegalParameter)
         usingHState ctx $ setNegotiatedGroup grp
         usingHState ctx getGroupPrivate >>= fromServerKeyShare serverKeyShare
 

core/Network/TLS/Handshake/Server.hs

@@ -888,16 +888,23 @@ doHandshake13 sparams ctx allCreds chosenVersion usedCipher exts usedHash client
     sendExtensions rtt0OK = do
         extensions' <- liftIO $ applicationProtocol ctx exts sparams
         msni <- liftIO $ usingState_ ctx getClientSNI
-        let extensions'' = case msni of
+        let sniExtension = 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 _  -> ExtensionRaw extensionID_ServerName "" : extensions'
-              Nothing -> extensions'
-        let extensions
-              | rtt0OK = ExtensionRaw extensionID_EarlyData (extensionEncode (EarlyDataIndication Nothing)) : extensions''
-              | otherwise = extensions''
+              Just _  -> Just $ ExtensionRaw extensionID_ServerName ""
+              Nothing -> Nothing
+        mgroup <- usingHState ctx getNegotiatedGroup 
+        let serverGroups = supportedGroups (ctxSupported ctx)
+            groupExtension
+              | null serverGroups = Nothing
+              | maybe True (== head serverGroups) mgroup = Nothing
+              | otherwise = Just $ ExtensionRaw extensionID_NegotiatedGroups $ extensionEncode (NegotiatedGroups serverGroups)
+        let earlyDataExtension
+              | rtt0OK = Just $ ExtensionRaw extensionID_EarlyData $ extensionEncode (EarlyDataIndication Nothing)
+              | otherwise = Nothing
+        let extensions = catMaybes [earlyDataExtension, groupExtension, sniExtension] ++ extensions'
         loadPacket13 ctx $ Handshake13 [EncryptedExtensions13 extensions]
 
     sendNewSessionTicket masterSecret sfSentTime = when sendNST $ do