Handle no shared ciphers more gracefully

haskell-tls · Dec 2, 2016 · 5feecd3 · 5feecd3
1 parent 0016374
commit 5feecd3
Showing 1 changed file with 7 additions and 4 deletions.
diff --git a/core/Network/TLS/Handshake/Server.hs b/core/Network/TLS/Handshake/Server.hs
@@ -117,13 +117,16 @@ handshakeServerWith sparams ctx clientHello@(ClientHello clientVersion _ clientS
 
     extraCreds <- (onServerNameIndication $ serverHooks sparams) serverName
 
+    -- 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)
-        usedCipher = (onCipherChoosing $ serverHooks sparams) chosenVersion ciphersFilteredVersion
-        creds = extraCreds `mappend` (sharedCredentials $ ctxShared ctx)
-
-    when (commonCipherIDs extraCreds == []) $ throwCore $
+    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)
+
     cred <- case cipherKeyExchange usedCipher of
                 CipherKeyExchange_RSA     -> return $ credentialsFindForDecrypting creds
                 CipherKeyExchange_DH_Anon -> return $ Nothing