Fallback to all certificates when no match

Draft TLS 1.3 section 4.4.2.2:  If the server cannot produce a certificate
chain that is signed only via the indicated supported algorithms, then it
SHOULD continue the handshake by sending the client a certificate chain of
its choice that may include algorithms that are not known to be supported
by the client.

core/Network/TLS/Handshake/Server.hs

@@ -170,9 +170,24 @@ handshakeServerWith sparams ctx clientHello@(ClientHello clientVersion _ clientS
                                    case credentialDigitalSignatureAlg cred of
                                        Just sig -> findIndex (sig `signatureCompatible`) possibleHashSigAlgs
                                        Nothing  -> Nothing
+
+                               -- Finally compute and use credential list pairs
+                               -- (allCreds, sigAllCreds) or (cltCreds, sigCltCreds)
+                               --
+                               -- We try to keep certificates supported by the client, but
+                               -- fallback to all credentials if this produces no suitable result
+                               -- (see RFC 5246 section 7.4.2 and TLS 1.3 section 4.4.2.2).
+                               -- The test is performed with signature credentials instead of
+                               -- ciphers so that this does not give advantage to a less secure
+                               -- key exchange like CipherKeyExchange_RSA or CipherKeyExchange_DH_Anon.
                                cltCreds    = filterCredentialsWithHashSignatures exts allCreds
                                sigCltCreds = filterSortCredentials signingRank cltCreds
-                            in (cltCreds, sigCltCreds)
+                               sigAllCreds = filterSortCredentials signingRank allCreds
+
+                               resultPair = if nullCredentials sigCltCreds
+                                                then (allCreds, sigAllCreds)
+                                                else (cltCreds, sigCltCreds)
+                            in resultPair
                   _     -> (allCreds, allCreds)
 
         -- Ciphers are selected according to TLS version, availability of ECDHE
@@ -554,6 +569,9 @@ credentialDigitalSignatureAlg :: Credential -> Maybe DigitalSignatureAlg
 credentialDigitalSignatureAlg cred =
     findDigitalSignatureAlg (credentialPublicPrivateKeys cred)
 
+nullCredentials :: Credentials -> Bool
+nullCredentials (Credentials l) = null l
+
 filterSortCredentials :: Ord a => (Credential -> Maybe a) -> Credentials -> Credentials
 filterSortCredentials rankFun (Credentials creds) =
     let orderedPairs = sortOn fst [ (rankFun cred, cred) | cred <- creds ]

core/Tests/Tests.hs

@@ -121,19 +121,7 @@ prop_handshake_hashsignatures = do
         serverParam' = serverParam { serverSupported = (serverSupported serverParam)
                                        { supportedHashSignatures = serverHashSigs }
                                    }
-        -- Not only client and server must have hash/signature algorithms
-        -- in common but SHA-1 must also be supported by the client for a
-        -- common signature algorithm.  This is because server certificates
-        -- are SHA-1 only.
-        commonHashSigs = clientHashSigs `intersect` serverHashSigs
-        certSigAlgs    = [a | (HashSHA1, a) <- clientHashSigs]
-
-        hasCertSigAlg (_, SignatureRSApssSHA512) = SignatureRSA `elem` certSigAlgs
-        hasCertSigAlg (_, SignatureRSApssSHA384) = SignatureRSA `elem` certSigAlgs
-        hasCertSigAlg (_, SignatureRSApssSHA256) = SignatureRSA `elem` certSigAlgs
-        hasCertSigAlg (_, s)                     = s `elem` certSigAlgs
-
-        shouldFail     = all (not . hasCertSigAlg) commonHashSigs
+        shouldFail = null (clientHashSigs `intersect` serverHashSigs)
     if shouldFail
         then runTLSInitFailure (clientParam',serverParam')
         else runTLSPipeSimple  (clientParam',serverParam')