tls 2.4.9 → 2.4.10
raw patch · 20 files changed
+721/−136 lines, 20 filesdep −mlkemdep ~cryptondep ~crypton-x509dep ~crypton-x509-storePVP ok
version bump matches the API change (PVP)
Dependencies removed: mlkem
Dependency ranges changed: crypton, crypton-x509, crypton-x509-store, crypton-x509-validation, hpke
API changes (from Hackage documentation)
+ Network.TLS: PrivKeyMLDSA44 :: PrivKeyMLDSA MLDSA44 -> PrivKey
+ Network.TLS: PrivKeyMLDSA65 :: PrivKeyMLDSA MLDSA65 -> PrivKey
+ Network.TLS: PrivKeyMLDSA87 :: PrivKeyMLDSA MLDSA87 -> PrivKey
+ Network.TLS: PubKeyMLDSA44 :: VerificationKey MLDSA44 -> PubKey
+ Network.TLS: PubKeyMLDSA65 :: VerificationKey MLDSA65 -> PubKey
+ Network.TLS: PubKeyMLDSA87 :: VerificationKey MLDSA87 -> PubKey
+ Network.TLS: pattern HashMLDSA :: HashAlgorithm
+ Network.TLS: pattern MLDSA44 :: HashAndSignatureAlgorithm
+ Network.TLS: pattern MLDSA65 :: HashAndSignatureAlgorithm
+ Network.TLS: pattern MLDSA87 :: HashAndSignatureAlgorithm
Files
- CHANGELOG.md +10/−0
- Network/TLS.hs +7/−0
- Network/TLS/Credentials.hs +3/−0
- Network/TLS/Crypto.hs +78/−22
- Network/TLS/Crypto/IES.hs +111/−83
- Network/TLS/Handshake/Client/ServerHello.hs +7/−3
- Network/TLS/Handshake/Client/TLS13.hs +6/−0
- Network/TLS/Handshake/Common13.hs +2/−2
- Network/TLS/Handshake/Key.hs +9/−0
- Network/TLS/Handshake/Server/ClientHello12.hs +2/−1
- Network/TLS/Handshake/Server/Common.hs +7/−1
- Network/TLS/Handshake/Server/ServerHello12.hs +6/−2
- Network/TLS/Handshake/Signature.hs +50/−10
- Network/TLS/HashAndSignature.hs +60/−3
- test/Arbitrary.hs +17/−1
- test/Certificate.hs +3/−0
- test/HandshakeSpec.hs +303/−0
- test/PubKey.hs +26/−0
- tls.cabal +6/−7
- util/tls-server.hs +8/−1
CHANGELOG.md view
@@ -1,5 +1,15 @@ # Change log for "tls" +## Version 2.4.10++* Support ML-DSA certificates and CertificateVerify, TLS 1.3 only+ (draft-ietf-tls-mldsa).+ [#583](https://github.com/haskell-tls/hs-tls/pull/583)+* Take ML-KEM from `crypton` instead of the `mlkem` package.+ [#583](https://github.com/haskell-tls/hs-tls/pull/583)+* `tls-server`: let `-g` choose the TLS 1.3 groups too.+ [#583](https://github.com/haskell-tls/hs-tls/pull/583)+ ## Version 2.4.9 * Include CertificateRequest in the post-handshake auth transcript.
Network/TLS.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE PatternSynonyms #-} -- | -- Native Haskell TLS protocol implementation for servers and -- clients.@@ -198,6 +199,9 @@ supportedSignatureSchemes, HashAlgorithm (..), SignatureAlgorithm (..),+ pattern MLDSA44,+ pattern MLDSA65,+ pattern MLDSA87, Group (..), supportedNamedGroups, EMSMode (..),@@ -352,6 +356,9 @@ TLSError (..), TLSException (..), supportedSignatureSchemes,+ pattern MLDSA44,+ pattern MLDSA65,+ pattern MLDSA87, ) import Network.TLS.Struct13 (Handshake13) import Network.TLS.Types
Network/TLS/Credentials.hs view
@@ -156,6 +156,9 @@ SignatureALG X509.HashSHA512 PubKeyALG_RSAPSS -> Just (TLS.HashIntrinsic, TLS.SignatureRSApssRSAeSHA512) SignatureALG_IntrinsicHash PubKeyALG_Ed25519 -> Just (TLS.HashIntrinsic, TLS.SignatureEd25519) SignatureALG_IntrinsicHash PubKeyALG_Ed448 -> Just (TLS.HashIntrinsic, TLS.SignatureEd448)+ SignatureALG_IntrinsicHash PubKeyALG_MLDSA44 -> Just TLS.MLDSA44+ SignatureALG_IntrinsicHash PubKeyALG_MLDSA65 -> Just TLS.MLDSA65+ SignatureALG_IntrinsicHash PubKeyALG_MLDSA87 -> Just TLS.MLDSA87 _ -> Nothing where convertHash sig X509.HashMD5 = Just (TLS.HashMD5, sig)
Network/TLS/Crypto.hs view
@@ -54,11 +54,12 @@ import qualified Crypto.PubKey.ECDSA as ECDSA import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.MLDSA as MLDSA import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as RSA import qualified Crypto.PubKey.RSA.PSS as PSS import Crypto.Random-import Data.ASN1.BinaryEncoding (BER (..), DER (..))+import Data.ASN1.BinaryEncoding (DER (..)) import Data.ASN1.Encoding import Data.ASN1.Types import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes, convert)@@ -71,6 +72,7 @@ PubKey (..), PubKeyEC (..), SerializedPoint (..),+ privkeyMLDSA_key, ) import Data.X509.EC (ecPrivKeyCurveName, ecPubKeyCurveName, unserializePoint) @@ -261,6 +263,13 @@ | ECDSAParams Hash | Ed25519Params | Ed448Params+ | -- | Pure ML-DSA with an empty context, which is what+ -- draft-ietf-tls-mldsa uses. One constructor per parameter set,+ -- since the key fixes it and a signature made under one does not+ -- verify under another.+ MLDSA44Params+ | MLDSA65Params+ | MLDSA87Params deriving (Show, Eq) -- Verify that the signature matches the given message, using the@@ -271,38 +280,21 @@ kxVerify (PubKeyRSA pk) (RSAParams alg RSApkcs1) msg sign = rsaVerifyHash alg pk msg sign kxVerify (PubKeyRSA pk) (RSAParams alg RSApss) msg sign = rsapssVerifyHash alg pk msg sign kxVerify (PubKeyDSA pk) DSAParams msg signBS =- case dsaToSignature signBS of- Just sig -> DSA.verify H.SHA1 pk sig msg+ case decodeSignatureRS signBS of+ Just (r, s) -> DSA.verify H.SHA1 pk DSA.Signature{DSA.sign_r = r, DSA.sign_s = s} msg _ -> False- where- dsaToSignature :: ByteString -> Maybe DSA.Signature- dsaToSignature b =- case decodeASN1' BER b of- Left _ -> Nothing- Right asn1 ->- case asn1 of- Start Sequence : IntVal r : IntVal s : End Sequence : _ ->- Just DSA.Signature{DSA.sign_r = r, DSA.sign_s = s}- _ ->- Nothing kxVerify (PubKeyEC key) (ECDSAParams alg) msg sigBS = fromMaybe False $ join $ withPubKeyEC key verifyProxy verifyClassic Nothing where- decodeSignatureASN1 buildRS =- case decodeASN1' BER sigBS of- Left _ -> Nothing- Right [Start Sequence, IntVal r, IntVal s, End Sequence] ->- Just (buildRS r s)- Right _ -> Nothing verifyProxy prx pubkey = do- rs <- decodeSignatureASN1 (,)+ rs <- decodeSignatureRS sigBS signature <- maybeCryptoError $ ECDSA.signatureFromIntegers prx rs verifyF <- withAlg (ECDSA.verify prx) return $ verifyF pubkey signature msg verifyClassic pubkey = do- signature <- decodeSignatureASN1 ECDSA_ECC.Signature+ signature <- uncurry ECDSA_ECC.Signature <$> decodeSignatureRS sigBS verifyF <- withAlg ECDSA_ECC.verify return $ verifyF pubkey signature msg withAlg :: (forall hash. H.HashAlgorithm hash => hash -> a) -> Maybe a@@ -322,8 +314,66 @@ case Ed448.signature sigBS of CryptoPassed sig -> Ed448.verify key msg sig _ -> False+-- A signature of the wrong length is refused by the smart constructor, and+-- one of the right length that does not verify returns False. Neither+-- throws, which is what a peer sending a damaged CertificateVerify has to+-- meet with decrypt_error rather than with a crash.+kxVerify (PubKeyMLDSA44 key) MLDSA44Params msg sigBS = mldsaVerify key msg sigBS+kxVerify (PubKeyMLDSA65 key) MLDSA65Params msg sigBS = mldsaVerify key msg sigBS+kxVerify (PubKeyMLDSA87 key) MLDSA87Params msg sigBS = mldsaVerify key msg sigBS kxVerify _ _ _ _ = False +mldsaVerify+ :: MLDSA.MLDSA p+ => MLDSA.VerificationKey p -> ByteString -> ByteString -> Bool+mldsaVerify key msg sigBS = case MLDSA.signature sigBS of+ CryptoPassed sig -> MLDSA.verify key MLDSA.emptyContext msg sig+ _ -> False++-- | Decode a DSA or ECDSA signature: a DER SEQUENCE of two INTEGERs, r+-- and s (RFC 3279 Sections 2.2.2 and 2.2.3). This is done here rather+-- than with crypton-asn1-encoding, whose 'decodeASN1'' throws on some+-- malformed input rather than returning 'Left'. Only DER is accepted:+-- definite lengths in their shortest form, non-negative INTEGERs in+-- theirs, and nothing after the SEQUENCE.+decodeSignatureRS :: ByteString -> Maybe (Integer, Integer)+decodeSignatureRS bs = do+ (0x30, body) <- whole bs+ (0x02, rbs, rest) <- tlv body+ (0x02, sbs) <- whole rest+ (,) <$> derInteger rbs <*> derInteger sbs+ where+ whole b = do+ (t, v, rest) <- tlv b+ guard $ B.null rest+ return (t, v)+ tlv b = do+ (t, b1) <- B.uncons b+ (l0, b2) <- B.uncons b1+ (len, b3) <- case l0 of+ _ | l0 < 0x80 -> Just (fromIntegral l0, b2)+ 0x81 -> do+ (l1, b3) <- B.uncons b2+ guard $ l1 >= 0x80+ Just (fromIntegral l1, b3)+ 0x82 -> do+ (l1, b3) <- B.uncons b2+ (l2, b4) <- B.uncons b3+ let n = fromIntegral l1 * 256 + fromIntegral l2 :: Int+ guard $ n >= 0x100+ Just (n, b4)+ _ -> Nothing+ guard $ B.length b3 >= len+ let (v, rest) = B.splitAt len b3+ return (t, v, rest)+ derInteger v = do+ (h, t) <- B.uncons v+ guard $ h < 0x80+ case B.uncons t of+ Just (h2, _) | h == 0 -> guard $ h2 >= 0x80+ _ -> return ()+ return $ B.foldl' (\acc w -> acc * 256 + fromIntegral w) 0 v+ -- Sign the given message using the private key. -- kxSign@@ -366,6 +416,12 @@ return $ Right $ convert $ Ed25519.sign pk pub msg kxSign (PrivKeyEd448 pk) (PubKeyEd448 pub) Ed448Params msg = return $ Right $ convert $ Ed448.sign pk pub msg+kxSign (PrivKeyMLDSA44 pk) (PubKeyMLDSA44 _) MLDSA44Params msg =+ Right . convert <$> MLDSA.sign (privkeyMLDSA_key pk) MLDSA.emptyContext msg+kxSign (PrivKeyMLDSA65 pk) (PubKeyMLDSA65 _) MLDSA65Params msg =+ Right . convert <$> MLDSA.sign (privkeyMLDSA_key pk) MLDSA.emptyContext msg+kxSign (PrivKeyMLDSA87 pk) (PubKeyMLDSA87 _) MLDSA87Params msg =+ Right . convert <$> MLDSA.sign (privkeyMLDSA_key pk) MLDSA.emptyContext msg kxSign _ _ _ _ = return (Left KxUnsupported)
Network/TLS/Crypto/IES.hs view
@@ -34,8 +34,8 @@ import Crypto.PubKey.DH (PrivateNumber (..), PublicNumber (..)) import qualified Crypto.PubKey.DH as DH import Crypto.PubKey.ECIES-import Crypto.PubKey.ML_KEM (ML_KEM_1024, ML_KEM_512, ML_KEM_768)-import qualified Crypto.PubKey.ML_KEM as ML+import Crypto.PubKey.MLKEM (MLKEM1024, MLKEM512, MLKEM768)+import qualified Crypto.PubKey.MLKEM as ML import Data.ByteArray (ScrubbedBytes, convert) import qualified Data.ByteArray as BA import Data.Proxy@@ -58,12 +58,12 @@ | GroupPri_FFDHE4096 PrivateNumber | GroupPri_FFDHE6144 PrivateNumber | GroupPri_FFDHE8192 PrivateNumber- | GroupPri_MLKEM512 (ML.DecapsulationKey ML_KEM_512)- | GroupPri_MLKEM768 (ML.DecapsulationKey ML_KEM_768)- | GroupPri_MLKEM1024 (ML.DecapsulationKey ML_KEM_1024)- | GroupPri_X25519MLKEM768 (Scalar Curve_X25519, ML.DecapsulationKey ML_KEM_768)- | GroupPri_P256MLKEM768 (Scalar Curve_P256R1, ML.DecapsulationKey ML_KEM_768)- | GroupPri_P384MLKEM1024 (Scalar Curve_P384R1, ML.DecapsulationKey ML_KEM_1024)+ | GroupPri_MLKEM512 (ML.DecapsulationKey MLKEM512)+ | GroupPri_MLKEM768 (ML.DecapsulationKey MLKEM768)+ | GroupPri_MLKEM1024 (ML.DecapsulationKey MLKEM1024)+ | GroupPri_X25519MLKEM768 (Scalar Curve_X25519, ML.DecapsulationKey MLKEM768)+ | GroupPri_P256MLKEM768 (Scalar Curve_P256R1, ML.DecapsulationKey MLKEM768)+ | GroupPri_P384MLKEM1024 (Scalar Curve_P384R1, ML.DecapsulationKey MLKEM1024) deriving (Eq, Show) {- FOURMOLU_ENABLE -} @@ -79,12 +79,12 @@ | GroupPubA_FFDHE4096 PublicNumber | GroupPubA_FFDHE6144 PublicNumber | GroupPubA_FFDHE8192 PublicNumber- | GroupPubA_MLKEM512 (ML.EncapsulationKey ML_KEM_512)- | GroupPubA_MLKEM768 (ML.EncapsulationKey ML_KEM_768)- | GroupPubA_MLKEM1024 (ML.EncapsulationKey ML_KEM_1024)- | GroupPubA_X25519MLKEM768 (Point Curve_X25519, ML.EncapsulationKey ML_KEM_768)- | GroupPubA_P256MLKEM768 (Point Curve_P256R1, ML.EncapsulationKey ML_KEM_768)- | GroupPubA_P384MLKEM1024 (Point Curve_P384R1, ML.EncapsulationKey ML_KEM_1024)+ | GroupPubA_MLKEM512 (ML.EncapsulationKey MLKEM512)+ | GroupPubA_MLKEM768 (ML.EncapsulationKey MLKEM768)+ | GroupPubA_MLKEM1024 (ML.EncapsulationKey MLKEM1024)+ | GroupPubA_X25519MLKEM768 (Point Curve_X25519, ML.EncapsulationKey MLKEM768)+ | GroupPubA_P256MLKEM768 (Point Curve_P256R1, ML.EncapsulationKey MLKEM768)+ | GroupPubA_P384MLKEM1024 (Point Curve_P384R1, ML.EncapsulationKey MLKEM1024) deriving (Eq, Show) {- FOURMOLU_ENABLE -} @@ -100,12 +100,12 @@ | GroupPubB_FFDHE4096 PublicNumber | GroupPubB_FFDHE6144 PublicNumber | GroupPubB_FFDHE8192 PublicNumber- | GroupPubB_MLKEM512 (ML.Ciphertext ML_KEM_512)- | GroupPubB_MLKEM768 (ML.Ciphertext ML_KEM_768)- | GroupPubB_MLKEM1024 (ML.Ciphertext ML_KEM_1024)- | GroupPubB_X25519MLKEM768 (Point Curve_X25519, ML.Ciphertext ML_KEM_768)- | GroupPubB_P256MLKEM768 (Point Curve_P256R1, ML.Ciphertext ML_KEM_768)- | GroupPubB_P384MLKEM1024 (Point Curve_P384R1, ML.Ciphertext ML_KEM_1024)+ | GroupPubB_MLKEM512 (ML.Ciphertext MLKEM512)+ | GroupPubB_MLKEM768 (ML.Ciphertext MLKEM768)+ | GroupPubB_MLKEM1024 (ML.Ciphertext MLKEM1024)+ | GroupPubB_X25519MLKEM768 (Point Curve_X25519, ML.Ciphertext MLKEM768)+ | GroupPubB_P256MLKEM768 (Point Curve_P256R1, ML.Ciphertext MLKEM768)+ | GroupPubB_P384MLKEM1024 (Point Curve_P384R1, ML.Ciphertext MLKEM1024) deriving (Eq, Show) {- FOURMOLU_ENABLE -} @@ -126,13 +126,27 @@ x448 :: Proxy Curve_X448 x448 = Proxy -mlkem512 :: Proxy ML_KEM_512+mlkem512 :: Proxy MLKEM512 mlkem512 = Proxy -mlkem768 :: Proxy ML_KEM_768+-- crypton reports a value it will not accept as a 'CryptoFailable' and has a+-- constructor per type rather than one overloaded 'decode'. These two keep+-- the call sites below in the shape they were.+--+-- 'ML.encapsulationKey' is the stricter of the two: besides the length it+-- runs the check of FIPS 203 section 7.2, so an encapsulation key whose+-- coefficients are out of range is refused here rather than used.+decodeEK+ :: ML.MLKEM p => proxy p -> ByteString -> Maybe (ML.EncapsulationKey p)+decodeEK _ = maybeCryptoError . ML.encapsulationKey++decodeCT :: ML.MLKEM p => proxy p -> ByteString -> Maybe (ML.Ciphertext p)+decodeCT _ = maybeCryptoError . ML.ciphertext++mlkem768 :: Proxy MLKEM768 mlkem768 = Proxy -mlkem1024 :: Proxy ML_KEM_1024+mlkem1024 :: Proxy MLKEM1024 mlkem1024 = Proxy dhParamsForGroup :: Group -> Maybe DH.Params@@ -160,25 +174,25 @@ groupGenerateKeyPair FFDHE6144 = gen ffdhe6144 exp6144 GroupPri_FFDHE6144 GroupPubA_FFDHE6144 groupGenerateKeyPair FFDHE8192 = gen ffdhe8192 exp8192 GroupPri_FFDHE8192 GroupPubA_FFDHE8192 groupGenerateKeyPair MLKEM512 = do- (e, d) <- ML.generate mlkem512+ (e, d) <- ML.generateKeyPair mlkem512 return (GroupPri_MLKEM512 d, GroupPubA_MLKEM512 e) groupGenerateKeyPair MLKEM768 = do- (e, d) <- ML.generate mlkem768+ (e, d) <- ML.generateKeyPair mlkem768 return (GroupPri_MLKEM768 d, GroupPubA_MLKEM768 e) groupGenerateKeyPair MLKEM1024 = do- (e, d) <- ML.generate mlkem1024+ (e, d) <- ML.generateKeyPair mlkem1024 return (GroupPri_MLKEM1024 d, GroupPubA_MLKEM1024 e) groupGenerateKeyPair X25519MLKEM768 = do (d1, e1) <- fs' $ curveGenerateKeyPair x25519- (e2, d2) <- ML.generate mlkem768+ (e2, d2) <- ML.generateKeyPair mlkem768 return (GroupPri_X25519MLKEM768 (d1, d2), GroupPubA_X25519MLKEM768 (e1, e2)) groupGenerateKeyPair P256MLKEM768 = do (d1, e1) <- fs' $ curveGenerateKeyPair p256- (e2, d2) <- ML.generate mlkem768+ (e2, d2) <- ML.generateKeyPair mlkem768 return (GroupPri_P256MLKEM768 (d1, d2), GroupPubA_P256MLKEM768 (e1, e2)) groupGenerateKeyPair P384MLKEM1024 = do (d1, e1) <- fs' $ curveGenerateKeyPair p384- (e2, d2) <- ML.generate mlkem1024+ (e2, d2) <- ML.generateKeyPair mlkem1024 return (GroupPri_P384MLKEM1024 (d1, d2), GroupPubA_P384MLKEM1024 (e1, e2)) groupGenerateKeyPair _ = error "groupGenerateKeyPair" @@ -228,6 +242,17 @@ -> r (PrivateNumber, PublicNumber) gen' params expBits = (id &&& DH.calculatePublic params) <$> generatePriv expBits +-- 'ML.encapsulate' takes the parameter set as a proxy and reports a+-- failure, as every KEM in Crypto.KEM does; ML-KEM has none to report.+mlkemEncap+ :: (MonadRandom r, ML.MLKEM p)+ => proxy p+ -> ML.EncapsulationKey p+ -> r (Maybe (ML.Ciphertext p, GroupKey))+mlkemEncap p ek = fmap f <$> fmap maybeCryptoError (ML.encapsulate p ek)+ where+ f (ct, sec) = (ct, convert sec)+ groupEncapsulate :: MonadRandom r => GroupPublicA -> r (Maybe (GroupPublicB, GroupKey)) groupEncapsulate (GroupPubA_P256 pub) = getECDHPubShared GroupPubB_P256 p256 pub@@ -240,41 +265,44 @@ groupEncapsulate (GroupPubA_FFDHE4096 pub) = getDHPubShared ffdhe4096 exp4096 pub GroupPubB_FFDHE4096 groupEncapsulate (GroupPubA_FFDHE6144 pub) = getDHPubShared ffdhe6144 exp6144 pub GroupPubB_FFDHE6144 groupEncapsulate (GroupPubA_FFDHE8192 pub) = getDHPubShared ffdhe8192 exp8192 pub GroupPubB_FFDHE8192-groupEncapsulate (GroupPubA_MLKEM512 pub) = do- (sec, ct) <- ML.encapsulate pub- return $ Just (GroupPubB_MLKEM512 ct, convert sec)-groupEncapsulate (GroupPubA_MLKEM768 pub) = do- (sec, ct) <- ML.encapsulate pub- return $ Just (GroupPubB_MLKEM768 ct, convert sec)-groupEncapsulate (GroupPubA_MLKEM1024 pub) = do- (sec, ct) <- ML.encapsulate pub- return $ Just (GroupPubB_MLKEM1024 ct, convert sec)+groupEncapsulate (GroupPubA_MLKEM512 pub) =+ fmap (\(ct, k) -> (GroupPubB_MLKEM512 ct, k)) <$> mlkemEncap mlkem512 pub+groupEncapsulate (GroupPubA_MLKEM768 pub) =+ fmap (\(ct, k) -> (GroupPubB_MLKEM768 ct, k)) <$> mlkemEncap mlkem768 pub+groupEncapsulate (GroupPubA_MLKEM1024 pub) =+ fmap (\(ct, k) -> (GroupPubB_MLKEM1024 ct, k)) <$> mlkemEncap mlkem1024 pub -- The classical part of a hybrid can fail as the group alone does: an -- all-zero X25519 public key decodes, but the shared secret derived from -- it is rejected. Nothing is turned into illegal_parameter by the caller.-groupEncapsulate (GroupPubA_X25519MLKEM768 (e1, e2)) = do- mx <- getECDHPubShared' x25519 e1- case mx of- Nothing -> return Nothing- Just (c1, k1) -> do- (k2, c2) <- ML.encapsulate e2- -- Sec 4.1: Specifically, the order of shares in the concatenation- -- has been reversed.- return $ Just (GroupPubB_X25519MLKEM768 (c1, c2), convert k2 <> k1)-groupEncapsulate (GroupPubA_P256MLKEM768 (e1, e2)) = do- mx <- getECDHPubShared' p256 e1- case mx of- Nothing -> return Nothing- Just (c1, k1) -> do- (k2, c2) <- ML.encapsulate e2- return $ Just (GroupPubB_P256MLKEM768 (c1, c2), k1 <> convert k2)-groupEncapsulate (GroupPubA_P384MLKEM1024 (e1, e2)) = do- mx <- getECDHPubShared' p384 e1+groupEncapsulate (GroupPubA_X25519MLKEM768 (e1, e2)) =+ hybrid x25519 mlkem768 e1 e2 $ \c1 k1 c2 k2 ->+ -- Sec 4.1: Specifically, the order of shares in the concatenation+ -- has been reversed.+ (GroupPubB_X25519MLKEM768 (c1, c2), k2 <> k1)+groupEncapsulate (GroupPubA_P256MLKEM768 (e1, e2)) =+ hybrid p256 mlkem768 e1 e2 $ \c1 k1 c2 k2 ->+ (GroupPubB_P256MLKEM768 (c1, c2), k1 <> k2)+groupEncapsulate (GroupPubA_P384MLKEM1024 (e1, e2)) =+ hybrid p384 mlkem1024 e1 e2 $ \c1 k1 c2 k2 ->+ (GroupPubB_P384MLKEM1024 (c1, c2), k1 <> k2)++-- Either half can refuse: the classical one rejects a peer value that would+-- make its secret degenerate, which the caller turns into+-- illegal_parameter. ML-KEM has nothing to refuse, but says so the same+-- way, so both are read alike here.+hybrid+ :: (MonadRandom r, EllipticCurveDH curve, ML.MLKEM p)+ => Proxy curve+ -> Proxy p+ -> Point curve+ -> ML.EncapsulationKey p+ -> (Point curve -> GroupKey -> ML.Ciphertext p -> GroupKey -> (GroupPublicB, GroupKey))+ -> r (Maybe (GroupPublicB, GroupKey))+hybrid pc pk e1 e2 k = do+ mx <- getECDHPubShared' pc e1 case mx of Nothing -> return Nothing- Just (c1, k1) -> do- (k2, c2) <- ML.encapsulate e2- return $ Just (GroupPubB_P384MLKEM1024 (c1, c2), k1 <> convert k2)+ Just (c1, k1) -> fmap (\(c2, k2) -> k c1 k1 c2 k2) <$> mlkemEncap pk e2 dhGroupGetPubShared :: MonadRandom r => Group -> PublicNumber -> r (Maybe (PublicNumber, GroupKey))@@ -351,22 +379,22 @@ groupDecapsulate (GroupPubB_FFDHE6144 pub) (GroupPri_FFDHE6144 pri) = calcDHShared ffdhe6144 pub pri groupDecapsulate (GroupPubB_FFDHE8192 pub) (GroupPri_FFDHE8192 pri) = calcDHShared ffdhe8192 pub pri groupDecapsulate (GroupPubB_MLKEM512 p) (GroupPri_MLKEM512 s) =- Just $ convert $ ML.decapsulate s p+ convert <$> maybeCryptoError (ML.decapsulate mlkem512 s p) groupDecapsulate (GroupPubB_MLKEM768 p) (GroupPri_MLKEM768 s) =- Just $ convert $ ML.decapsulate s p+ convert <$> maybeCryptoError (ML.decapsulate mlkem768 s p) groupDecapsulate (GroupPubB_MLKEM1024 p) (GroupPri_MLKEM1024 s) =- Just $ convert $ ML.decapsulate s p+ convert <$> maybeCryptoError (ML.decapsulate mlkem1024 s p) groupDecapsulate (GroupPubB_X25519MLKEM768 (p1, p2)) (GroupPri_X25519MLKEM768 (s1, s2)) = do bs1 <- (unwrap <$>) . maybeCryptoError $ deriveDecrypt x25519 p1 s1- let bs2 = convert $ ML.decapsulate s2 p2+ bs2 <- convert <$> maybeCryptoError (ML.decapsulate mlkem768 s2 p2) return (bs2 <> bs1) groupDecapsulate (GroupPubB_P256MLKEM768 (p1, p2)) (GroupPri_P256MLKEM768 (s1, s2)) = do bs1 <- (unwrap <$>) . maybeCryptoError $ deriveDecrypt p256 p1 s1- let bs2 = convert $ ML.decapsulate s2 p2+ bs2 <- convert <$> maybeCryptoError (ML.decapsulate mlkem768 s2 p2) return (bs1 <> bs2) groupDecapsulate (GroupPubB_P384MLKEM1024 (p1, p2)) (GroupPri_P384MLKEM1024 (s1, s2)) = do bs1 <- (unwrap <$>) . maybeCryptoError $ deriveDecrypt p384 p1 s1- let bs2 = convert $ ML.decapsulate s2 p2+ bs2 <- convert <$> maybeCryptoError (ML.decapsulate mlkem1024 s2 p2) return (bs1 <> bs2) groupDecapsulate _ _ = Nothing @@ -388,15 +416,15 @@ groupEncodePublicA (GroupPubA_FFDHE4096 p) = enc ffdhe4096 p groupEncodePublicA (GroupPubA_FFDHE6144 p) = enc ffdhe6144 p groupEncodePublicA (GroupPubA_FFDHE8192 p) = enc ffdhe8192 p-groupEncodePublicA (GroupPubA_MLKEM512 p) = ML.encode p-groupEncodePublicA (GroupPubA_MLKEM768 p) = ML.encode p-groupEncodePublicA (GroupPubA_MLKEM1024 p) = ML.encode p+groupEncodePublicA (GroupPubA_MLKEM512 p) = BA.convert p+groupEncodePublicA (GroupPubA_MLKEM768 p) = BA.convert p+groupEncodePublicA (GroupPubA_MLKEM1024 p) = BA.convert p groupEncodePublicA (GroupPubA_X25519MLKEM768 (p1, p2)) =- ML.encode p2 <> encodePoint x25519 p1+ BA.convert p2 <> encodePoint x25519 p1 groupEncodePublicA (GroupPubA_P256MLKEM768 (p1, p2)) =- encodePoint p256 p1 <> ML.encode p2+ encodePoint p256 p1 <> BA.convert p2 groupEncodePublicA (GroupPubA_P384MLKEM1024 (p1, p2)) =- encodePoint p384 p1 <> ML.encode p2+ encodePoint p384 p1 <> BA.convert p2 groupEncodePublicB :: GroupPublicB -> ByteString groupEncodePublicB (GroupPubB_P256 p) = encodePoint p256 p@@ -433,32 +461,32 @@ groupDecodePublicA FFDHE4096 bs = Right . GroupPubA_FFDHE4096 . PublicNumber $ os2ip bs groupDecodePublicA FFDHE6144 bs = Right . GroupPubA_FFDHE6144 . PublicNumber $ os2ip bs groupDecodePublicA FFDHE8192 bs = Right . GroupPubA_FFDHE8192 . PublicNumber $ os2ip bs-groupDecodePublicA MLKEM512 bs = case ML.decode mlkem512 bs of+groupDecodePublicA MLKEM512 bs = case decodeEK mlkem512 bs of Nothing -> Left CryptoError_PointFormatInvalid Just p -> Right $ GroupPubA_MLKEM512 p-groupDecodePublicA MLKEM768 bs = case ML.decode mlkem768 bs of+groupDecodePublicA MLKEM768 bs = case decodeEK mlkem768 bs of Nothing -> Left CryptoError_PointFormatInvalid Just p -> Right $ GroupPubA_MLKEM768 p-groupDecodePublicA MLKEM1024 bs = case ML.decode mlkem1024 bs of+groupDecodePublicA MLKEM1024 bs = case decodeEK mlkem1024 bs of Nothing -> Left CryptoError_PointFormatInvalid Just p -> Right $ GroupPubA_MLKEM1024 p groupDecodePublicA X25519MLKEM768 bs = let (bs1, bs2) = BA.splitAt 1184 bs- in case ML.decode mlkem768 bs1 of+ in case decodeEK mlkem768 bs1 of Nothing -> Left CryptoError_PointFormatInvalid Just p1 -> case maybeCryptoError $ decodePoint x25519 bs2 of Nothing -> Left CryptoError_PointFormatInvalid Just p2 -> Right $ GroupPubA_X25519MLKEM768 (p2, p1) groupDecodePublicA P256MLKEM768 bs = let (bs1, bs2) = BA.splitAt 65 bs- in case ML.decode mlkem768 bs2 of+ in case decodeEK mlkem768 bs2 of Nothing -> Left CryptoError_PointFormatInvalid Just p1 -> case maybeCryptoError $ decodePoint p256 bs1 of Nothing -> Left CryptoError_PointFormatInvalid Just p2 -> Right $ GroupPubA_P256MLKEM768 (p2, p1) groupDecodePublicA P384MLKEM1024 bs = let (bs1, bs2) = BA.splitAt 97 bs- in case ML.decode mlkem1024 bs2 of+ in case decodeEK mlkem1024 bs2 of Nothing -> Left CryptoError_PointFormatInvalid Just p1 -> case maybeCryptoError $ decodePoint p384 bs1 of Nothing -> Left CryptoError_PointFormatInvalid@@ -476,32 +504,32 @@ groupDecodePublicB FFDHE4096 bs = Right . GroupPubB_FFDHE4096 . PublicNumber $ os2ip bs groupDecodePublicB FFDHE6144 bs = Right . GroupPubB_FFDHE6144 . PublicNumber $ os2ip bs groupDecodePublicB FFDHE8192 bs = Right . GroupPubB_FFDHE8192 . PublicNumber $ os2ip bs-groupDecodePublicB MLKEM512 bs = case ML.decode mlkem512 bs of+groupDecodePublicB MLKEM512 bs = case decodeCT mlkem512 bs of Nothing -> Left CryptoError_PointFormatInvalid Just p -> Right $ GroupPubB_MLKEM512 p-groupDecodePublicB MLKEM768 bs = case ML.decode mlkem768 bs of+groupDecodePublicB MLKEM768 bs = case decodeCT mlkem768 bs of Nothing -> Left CryptoError_PointFormatInvalid Just p -> Right $ GroupPubB_MLKEM768 p-groupDecodePublicB MLKEM1024 bs = case ML.decode mlkem1024 bs of+groupDecodePublicB MLKEM1024 bs = case decodeCT mlkem1024 bs of Nothing -> Left CryptoError_PointFormatInvalid Just p -> Right $ GroupPubB_MLKEM1024 p groupDecodePublicB X25519MLKEM768 bs = let (bs1, bs2) = BA.splitAt 1088 bs- in case ML.decode mlkem768 bs1 of+ in case decodeCT mlkem768 bs1 of Nothing -> Left CryptoError_PointFormatInvalid Just p1 -> case maybeCryptoError $ decodePoint x25519 bs2 of Nothing -> Left CryptoError_PointFormatInvalid Just p2 -> Right $ GroupPubB_X25519MLKEM768 (p2, p1) groupDecodePublicB P256MLKEM768 bs = let (bs1, bs2) = BA.splitAt 65 bs- in case ML.decode mlkem768 bs2 of+ in case decodeCT mlkem768 bs2 of Nothing -> Left CryptoError_PointFormatInvalid Just p1 -> case maybeCryptoError $ decodePoint p256 bs1 of Nothing -> Left CryptoError_PointFormatInvalid Just p2 -> Right $ GroupPubB_P256MLKEM768 (p2, p1) groupDecodePublicB P384MLKEM1024 bs = let (bs1, bs2) = BA.splitAt 97 bs- in case ML.decode mlkem1024 bs2 of+ in case decodeCT mlkem1024 bs2 of Nothing -> Left CryptoError_PointFormatInvalid Just p1 -> case maybeCryptoError $ decodePoint p384 bs1 of Nothing -> Left CryptoError_PointFormatInvalid
Network/TLS/Handshake/Client/ServerHello.hs view
@@ -4,6 +4,7 @@ module Network.TLS.Handshake.Client.ServerHello ( receiveServerHello, processServerHello13,+ processRecordSizeLimit, ) where import Data.ByteArray (convert)@@ -179,9 +180,8 @@ then do -- Session is dummy in TLS 1.3. usingState_ ctx $ setSession shSession- processRecordSizeLimit ctx shExtensions True- enableMyRecordLimit ctx- enablePeerRecordLimit ctx+ -- RecordSizeLimit comes in EncryptedExtensions in TLS 1.3+ -- (RFC 8449 Section 4), and is processed there. let usedHash = cipherHash usedCipher transitTranscriptHashI ctx "transitI" usedHash isHRR accepted <- checkECHacceptance ctx isHRR usedHash sh@@ -272,6 +272,10 @@ (return ()) (setPeerRecordSizeLimit ctx tls13) ack <- checkPeerRecordLimit ctx+ -- RFC 8449 Section 4: a limit that is not negotiated does not+ -- bind the peer, so a server that did not send RecordSizeLimit+ -- back may send records of any size the protocol permits.+ unless ack $ setMyRecordLimit ctx Nothing -- When a client sends RecordSizeLimit, it does not know -- which TLS version the server selects. RecordLimit is -- the length of plaintext. But RecordSizeLimit also
Network/TLS/Handshake/Client/TLS13.hs view
@@ -135,6 +135,12 @@ :: MonadIO m => Context -> Handshake13 -> m () expectEncryptedExtensions ctx (EncryptedExtensions13 eexts) = do liftIO $ do+ -- RFC 8449 Section 4: the server's RecordSizeLimit is in+ -- EncryptedExtensions. Until it is known, our own limit is not+ -- enforced, as the server may not have agreed to it.+ processRecordSizeLimit ctx eexts True+ enableMyRecordLimit ctx+ enablePeerRecordLimit ctx setALPN ctx MsgTEncryptedExtensions eexts modifyTLS13State ctx $ \st -> st{tls13stClientExtensions = eexts} st13 <- usingHState ctx getTLS13RTT0Status
Network/TLS/Handshake/Common13.hs view
@@ -185,7 +185,7 @@ unless (pub `signatureCompatible13` hs) $ throwCore $ Error_Protocol- ("signature algorithm " ++ show hs ++ " does not fit the public key")+ ("signature algorithm " ++ showSignatureScheme hs ++ " does not fit the public key") IllegalParameter role <- usingState_ ctx getRole let ctxStr@@ -444,7 +444,7 @@ checkHashSignatureValid13 :: HashAndSignatureAlgorithm -> IO () checkHashSignatureValid13 hs = unless (isHashSignatureValid13 hs) $- let msg = "invalid TLS13 hash and signature algorithm: " ++ show hs+ let msg = "invalid TLS13 hash and signature algorithm: " ++ showSignatureScheme hs in throwCore $ Error_Protocol msg IllegalParameter isHashSignatureValid13 :: HashAndSignatureAlgorithm -> Bool
Network/TLS/Handshake/Key.hs view
@@ -91,6 +91,9 @@ isDigitalSignatureKey (PubKeyEC _) = True isDigitalSignatureKey (PubKeyEd25519 _) = True isDigitalSignatureKey (PubKeyEd448 _) = True+isDigitalSignatureKey (PubKeyMLDSA44 _) = True+isDigitalSignatureKey (PubKeyMLDSA65 _) = True+isDigitalSignatureKey (PubKeyMLDSA87 _) = True isDigitalSignatureKey _ = False versionCompatible :: PubKey -> Version -> Bool@@ -99,6 +102,9 @@ versionCompatible (PubKeyEC _) v = v >= TLS10 versionCompatible (PubKeyEd25519 _) v = v >= TLS12 versionCompatible (PubKeyEd448 _) v = v >= TLS12+versionCompatible (PubKeyMLDSA44 _) v = v >= TLS13+versionCompatible (PubKeyMLDSA65 _) v = v >= TLS13+versionCompatible (PubKeyMLDSA87 _) v = v >= TLS13 versionCompatible _ _ = False {- FOURMOLU_ENABLE -} @@ -128,6 +134,9 @@ (PubKeyEC _, PrivKeyEC k) -> kxSupportedPrivKeyEC k (PubKeyEd25519 _, PrivKeyEd25519 _) -> True (PubKeyEd448 _, PrivKeyEd448 _) -> True+ (PubKeyMLDSA44 _, PrivKeyMLDSA44 _) -> True+ (PubKeyMLDSA65 _, PrivKeyMLDSA65 _) -> True+ (PubKeyMLDSA87 _, PrivKeyMLDSA87 _) -> True _ -> False getLocalPublicKey :: MonadIO m => Context -> m PubKey
Network/TLS/Handshake/Server/ClientHello12.hs view
@@ -172,7 +172,8 @@ -- Build a list of all hash/signature algorithms in common between -- client and server.- hashAndSignatures = supportedHashSignatures supported+ -- ML-DSA is TLS 1.3 only (draft-ietf-tls-mldsa).+ hashAndSignatures = filter (not . isMLDSA) $ supportedHashSignatures supported possibleHashSigAlgs = hashAndSignaturesInCommon hashAndSignatures chExtensions -- Check that a candidate signature credential will be compatible with
Network/TLS/Handshake/Server/Common.hs view
@@ -223,4 +223,10 @@ let mysiz = fromIntegral mylim + if tls13 then 1 else 0 rsl = RecordSizeLimit mysiz return $ Just $ toExtensionRaw rsl- else return Nothing+ else do+ -- RFC 8449 Section 4: a limit that is not negotiated+ -- does not bind the peer, so a client that did not send+ -- RecordSizeLimit may send records of any size the+ -- protocol permits.+ setMyRecordLimit ctx Nothing+ return Nothing
Network/TLS/Handshake/Server/ServerHello12.hs view
@@ -142,7 +142,7 @@ if serverWantClientCert then do let (certTypes, hashSigs) =- let as = supportedHashSignatures serverSupported+ let as = filter (not . isMLDSA) $ supportedHashSignatures serverSupported in (nub $ mapMaybe (fmap certTypeOnWire . hashSigToCertType) as, as) creq = CertRequest@@ -160,7 +160,11 @@ certTypeOnWire CertificateType_Ed448_Sign = CertificateType_ECDSA_Sign certTypeOnWire t = t commonGroups = negotiatedGroupsInCommon (supportedGroups serverSupported) chExts- commonHashSigs = hashAndSignaturesInCommon (supportedHashSignatures serverSupported) chExts+ -- ML-DSA is TLS 1.3 only (draft-ietf-tls-mldsa).+ commonHashSigs =+ hashAndSignaturesInCommon+ (filter (not . isMLDSA) $ supportedHashSignatures serverSupported)+ chExts setup_DHE = do let possibleFFGroups = commonGroups `intersect` availableFFGroups (dhparams, priv, pub) <-
Network/TLS/Handshake/Signature.hs view
@@ -44,9 +44,24 @@ certificateCompatible (PubKeyEC _) cTypes = CertificateType_ECDSA_Sign `elem` cTypes certificateCompatible (PubKeyEd25519 _) _ = True certificateCompatible (PubKeyEd448 _) _ = True+-- ML-DSA has no CertificateType of its own, as EdDSA does not either; what+-- a client may send is decided by signature_algorithms.+certificateCompatible (PubKeyMLDSA44 _) _ = True+certificateCompatible (PubKeyMLDSA65 _) _ = True+certificateCompatible (PubKeyMLDSA87 _) _ = True certificateCompatible _ _ = False signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool+-- ML-DSA first, and with a refusal for every other kind of key. The RSA+-- equations below ignore the first byte, and ML-DSA's second byte is one+-- RSASSA-PSS also uses, so an ML-DSA scheme reaching them would be answered+-- for as though it were RSASSA-PSS.+signatureCompatible (PubKeyMLDSA44 _) MLDSA44 = True+signatureCompatible (PubKeyMLDSA65 _) MLDSA65 = True+signatureCompatible (PubKeyMLDSA87 _) MLDSA87 = True+signatureCompatible _ MLDSA44 = False+signatureCompatible _ MLDSA65 = False+signatureCompatible _ MLDSA87 = False signatureCompatible (PubKeyRSA pk) (HashSHA1, SignatureRSA) = kxCanUseRSApkcs1 pk SHA1 signatureCompatible (PubKeyRSA pk) (HashSHA256, SignatureRSA) = kxCanUseRSApkcs1 pk SHA256 signatureCompatible (PubKeyRSA pk) (HashSHA384, SignatureRSA) = kxCanUseRSApkcs1 pk SHA384@@ -62,8 +77,20 @@ -- Whether the signature algorithm is for the type of the key, whatever -- its other parameters.-keyTypeFits :: PubKey -> SignatureAlgorithm -> Bool-keyTypeFits (PubKeyRSA _) s =+--+-- This takes the whole scheme and not its second byte alone, because+-- ML-DSA's second byte is one RSASSA-PSS also uses: only the pair says+-- which of the two a scheme is. The ML-DSA equations come first for the+-- same reason -- an ML-DSA scheme fits no other kind of key, and one+-- ML-DSA size does not fit another's key.+keyTypeFits :: PubKey -> HashAndSignatureAlgorithm -> Bool+keyTypeFits (PubKeyMLDSA44 _) hs = hs == MLDSA44+keyTypeFits (PubKeyMLDSA65 _) hs = hs == MLDSA65+keyTypeFits (PubKeyMLDSA87 _) hs = hs == MLDSA87+keyTypeFits _ MLDSA44 = False+keyTypeFits _ MLDSA65 = False+keyTypeFits _ MLDSA87 = False+keyTypeFits (PubKeyRSA _) (_, s) = s `elem` [ SignatureRSA , SignatureRSApssRSAeSHA256@@ -73,10 +100,10 @@ , SignatureRSApsspssSHA384 , SignatureRSApsspssSHA512 ]-keyTypeFits (PubKeyDSA _) s = s == SignatureDSA-keyTypeFits (PubKeyEC _) s = s == SignatureECDSA-keyTypeFits (PubKeyEd25519 _) s = s == SignatureEd25519-keyTypeFits (PubKeyEd448 _) s = s == SignatureEd448+keyTypeFits (PubKeyDSA _) (_, s) = s == SignatureDSA+keyTypeFits (PubKeyEC _) (_, s) = s == SignatureECDSA+keyTypeFits (PubKeyEd25519 _) (_, s) = s == SignatureEd25519+keyTypeFits (PubKeyEd448 _) (_, s) = s == SignatureEd448 keyTypeFits _ _ = False -- Same as 'signatureCompatible' but for TLS13: for ECDSA this also checks the@@ -142,12 +169,19 @@ -- an illegal_parameter. One for the right type of key that still does -- not fit it, an RSASSA-PSS one for an rsaEncryption key say, is a -- signature that does not verify, a decrypt_error, which False leads to.-checkCertificateVerify ctx usedVersion pubKey msgs digSig@(DigitallySigned hashSigAlg@(_, sigAlg) _) = do+checkCertificateVerify ctx usedVersion pubKey msgs digSig@(DigitallySigned hashSigAlg _) = do+ -- ML-DSA is defined for TLS 1.3 only, so naming one here is a field+ -- that is incorrect whatever key the peer holds.+ when (usedVersion < TLS13 && isMLDSA hashSigAlg) $+ throwCore $+ Error_Protocol+ ("signature algorithm " ++ showSignatureScheme hashSigAlg ++ " is not for " ++ show usedVersion)+ IllegalParameter checkSupportedHashSignature ctx hashSigAlg- unless (pubKey `keyTypeFits` sigAlg) $+ unless (pubKey `keyTypeFits` hashSigAlg) $ throwCore $ Error_Protocol- ("signature algorithm " ++ show hashSigAlg ++ " is for another type of key")+ ("signature algorithm " ++ showSignatureScheme hashSigAlg ++ " is for another type of key") IllegalParameter if pubKey `signatureCompatible` hashSigAlg then doVerify@@ -187,6 +221,9 @@ return (signatureParams pubKey hashSigAlg, msgs) signatureParams :: PubKey -> HashAndSignatureAlgorithm -> SignatureParams+-- Which of these is used is decided by the key, and signatureCompatible has+-- already refused a scheme that does not fit the key, so an ML-DSA scheme+-- cannot arrive at a clause for another kind of key. signatureParams (PubKeyRSA _) hashSigAlg = case hashSigAlg of (HashSHA512, SignatureRSA) -> RSAParams SHA512 RSApkcs1@@ -226,6 +263,9 @@ (hsh, SignatureEd448) -> error ("unimplemented Ed448 signature hash type: " ++ show hsh) (_, sigAlg) -> error ("signature algorithm is incompatible with Ed448: " ++ show sigAlg)+signatureParams (PubKeyMLDSA44 _) MLDSA44 = MLDSA44Params+signatureParams (PubKeyMLDSA65 _) MLDSA65 = MLDSA65Params+signatureParams (PubKeyMLDSA87 _) MLDSA87 = MLDSA87Params signatureParams pk _ = error ("signatureParams: " ++ pubkeyType pk ++ " is not supported") signatureCreateWithCertVerifyData@@ -332,5 +372,5 @@ :: Context -> HashAndSignatureAlgorithm -> IO () checkSupportedHashSignature ctx hs = unless (hs `elem` supportedHashSignatures (ctxSupported ctx)) $- let msg = "unsupported hash and signature algorithm: " ++ show hs+ let msg = "unsupported hash and signature algorithm: " ++ showSignatureScheme hs in throwCore $ Error_Protocol msg IllegalParameter
Network/TLS/HashAndSignature.hs view
@@ -10,7 +10,8 @@ HashSHA256, HashSHA384, HashSHA512,- HashIntrinsic+ HashIntrinsic,+ HashMLDSA ), SignatureAlgorithm ( ..,@@ -31,8 +32,13 @@ SignatureBrainpoolP512 ), HashAndSignatureAlgorithm,+ pattern MLDSA44,+ pattern MLDSA65,+ pattern MLDSA87, supportedSignatureSchemes, signatureSchemesForTLS13,+ isMLDSA,+ showSignatureScheme, ) where import Network.TLS.Imports@@ -59,6 +65,8 @@ pattern HashSHA512 = HashAlgorithm 6 pattern HashIntrinsic :: HashAlgorithm pattern HashIntrinsic = HashAlgorithm 8+pattern HashMLDSA :: HashAlgorithm -- not a hash; see MLDSA44 below+pattern HashMLDSA = HashAlgorithm 9 instance Show HashAlgorithm where show HashNone = "None"@@ -69,6 +77,7 @@ show HashSHA384 = "SHA384" show HashSHA512 = "SHA512" show HashIntrinsic = "TLS13"+ show HashMLDSA = "MLDSA" show (HashAlgorithm x) = "Hash " ++ show x {- FOURMOLU_ENABLE -} @@ -133,11 +142,55 @@ type HashAndSignatureAlgorithm = (HashAlgorithm, SignatureAlgorithm) +-- ML-DSA, from draft-ietf-tls-mldsa: mldsa44(0x0904), mldsa65(0x0905) and+-- mldsa87(0x0906).+--+-- These are named as whole pairs rather than as a new 'SignatureAlgorithm',+-- because neither byte is what it is elsewhere: 0x09 is not a hash, and the+-- second byte repeats numbers RSASSA-PSS already uses. Only the pair+-- identifies the scheme, so only the pair is given a name, and code that+-- decides anything about ML-DSA has to match on both bytes.++-- | Name a signature scheme.+--+-- 'show' on the pair cannot do this for ML-DSA. A scheme is a 16-bit+-- number that hs-tls carries as the two bytes it is made of, and for ML-DSA+-- the size is in the second byte, whose values RSASSA-PSS also uses -- so+-- the components alone render mldsa65 as @(MLDSA,RSApssRSAeSHA384)@, which+-- names the wrong algorithm. Use this wherever a scheme is put in front of+-- a person.+showSignatureScheme :: HashAndSignatureAlgorithm -> String+showSignatureScheme MLDSA44 = "mldsa44"+showSignatureScheme MLDSA65 = "mldsa65"+showSignatureScheme MLDSA87 = "mldsa87"+showSignatureScheme hs = show hs++-- | Is this one of the ML-DSA schemes? They are TLS 1.3 only, so the+-- TLS 1.2 paths filter them out and refuse one that arrives anyway.+isMLDSA :: HashAndSignatureAlgorithm -> Bool+isMLDSA MLDSA44 = True+isMLDSA MLDSA65 = True+isMLDSA MLDSA87 = True+isMLDSA _ = False+ {- FOURMOLU_DISABLE -}+pattern MLDSA44 :: HashAndSignatureAlgorithm+pattern MLDSA44 = (HashMLDSA, SignatureAlgorithm 4)+pattern MLDSA65 :: HashAndSignatureAlgorithm+pattern MLDSA65 = (HashMLDSA, SignatureAlgorithm 5)+pattern MLDSA87 :: HashAndSignatureAlgorithm+pattern MLDSA87 = (HashMLDSA, SignatureAlgorithm 6)+{- FOURMOLU_ENABLE -}++{- FOURMOLU_DISABLE -} supportedSignatureSchemes :: [HashAndSignatureAlgorithm] supportedSignatureSchemes =+ -- ML-DSA algorithms, TLS 1.3 only+ [ MLDSA87 -- mldsa87(0x0906)+ , MLDSA65 -- mldsa65(0x0905)+ , MLDSA44 -- mldsa44(0x0904) -- EdDSA algorithms- [ (HashIntrinsic, SignatureEd448) -- ed448 (0x0808)+ , (HashIntrinsic, SignatureEd448) -- ed448 (0x0808) , (HashIntrinsic, SignatureEd25519) -- ed25519(0x0807) -- ECDSA algorithms , (HashSHA512, SignatureECDSA) -- ecdsa_secp512r1_sha512(0x0603)@@ -162,8 +215,12 @@ signatureSchemesForTLS13 :: [(HashAlgorithm, SignatureAlgorithm)] signatureSchemesForTLS13 =+ -- ML-DSA algorithms+ [ MLDSA87 -- mldsa87(0x0906)+ , MLDSA65 -- mldsa65(0x0905)+ , MLDSA44 -- mldsa44(0x0904) -- EdDSA algorithms- [ (HashIntrinsic, SignatureEd448) -- ed448 (0x0808)+ , (HashIntrinsic, SignatureEd448) -- ed448 (0x0808) , (HashIntrinsic, SignatureEd25519) -- ed25519(0x0807) -- ECDSA algorithms , (HashSHA512, SignatureECDSA) -- ecdsa_secp512r1_sha512(0x0603)
test/Arbitrary.hs view
@@ -7,7 +7,7 @@ import qualified Data.ByteString as B import Data.List import Data.Word-import Data.X509 (ExtKeyUsageFlag)+import Data.X509 (ExtKeyUsageFlag, privkeyMLDSAFromKey) import Network.TLS import Network.TLS.Extra.Cipher import Network.TLS.Internal@@ -220,6 +220,22 @@ , (toPubKeyEC curveName ecdsaPub, toPrivKeyEC curveName ecdsaPriv) , (PubKeyEd25519 ed25519Pub, PrivKeyEd25519 ed25519Priv) , (PubKeyEd448 ed448Pub, PrivKeyEd448 ed448Priv)+ ]++-- | One credential per ML-DSA parameter set.+arbitraryCredentialsOfEachMLDSA :: Gen [(CertificateChain, PrivKey)]+arbitraryCredentialsOfEachMLDSA = do+ (pub44, priv44) <- arbitraryMLDSA44Pair+ (pub65, priv65) <- arbitraryMLDSA65Pair+ (pub87, priv87) <- arbitraryMLDSA87Pair+ mapM+ ( \(pub, priv) -> do+ cert <- arbitraryX509WithKey (pub, priv)+ return (CertificateChain [cert], priv)+ )+ [ (PubKeyMLDSA44 pub44, PrivKeyMLDSA44 (privkeyMLDSAFromKey priv44))+ , (PubKeyMLDSA65 pub65, PrivKeyMLDSA65 (privkeyMLDSAFromKey priv65))+ , (PubKeyMLDSA87 pub87, PrivKeyMLDSA87 (privkeyMLDSAFromKey priv87)) ] arbitraryCredentialsOfEachCurve :: Gen [(CertificateChain, PrivKey)]
test/Certificate.hs view
@@ -159,6 +159,9 @@ getSignatureALG (PubKeyEC _) = SignatureALG HashSHA256 PubKeyALG_EC getSignatureALG (PubKeyEd25519 _) = SignatureALG_IntrinsicHash PubKeyALG_Ed25519 getSignatureALG (PubKeyEd448 _) = SignatureALG_IntrinsicHash PubKeyALG_Ed448+getSignatureALG (PubKeyMLDSA44 _) = SignatureALG_IntrinsicHash PubKeyALG_MLDSA44+getSignatureALG (PubKeyMLDSA65 _) = SignatureALG_IntrinsicHash PubKeyALG_MLDSA65+getSignatureALG (PubKeyMLDSA87 _) = SignatureALG_IntrinsicHash PubKeyALG_MLDSA87 getSignatureALG pubKey = error $ "getSignatureALG: unsupported public key: " ++ show pubKey
test/HandshakeSpec.hs view
@@ -59,6 +59,22 @@ handshake_high_legacy_version TLS12 (Version 0x0309) it "ignores legacy_version when supported_versions is present" $ handshake_high_legacy_version TLS13 TLS13+ it "keeps to the TLS 1.3 server's record size limit" $+ record_size_limit_negotiated TLS13 False+ it "keeps to the TLS 1.3 client's record size limit" $+ record_size_limit_negotiated TLS13 True+ it "keeps to the TLS 1.2 server's record size limit" $+ record_size_limit_negotiated TLS12 False+ it "keeps to the TLS 1.2 client's record size limit" $+ record_size_limit_negotiated TLS12 True+ it "ignores the client's record size limit the TLS 1.3 server does not take" $+ record_size_limit_unnegotiated TLS13 True+ it "ignores the server's record size limit the TLS 1.3 client did not offer" $+ record_size_limit_unnegotiated TLS13 False+ it "ignores the client's record size limit the TLS 1.2 server does not take" $+ record_size_limit_unnegotiated TLS12 True+ it "ignores the server's record size limit the TLS 1.2 client did not offer" $+ record_size_limit_unnegotiated TLS12 False it "rejects ec_point_formats without uncompressed" $ handshake12_ec_point_formats (B.pack [1, 1])@@ -90,6 +106,12 @@ prop "can authenticate client" handshake_client_auth it "rejects a TLS 1.3 CertificateVerify algorithm unfit for the key" $ handshake13_client_cert_verify_unfit_sigalg+ it "rejects a primitive SEQUENCE as an ECDSA signature" $+ handshake13_client_cert_verify_malformed_ecdsa $ \sig ->+ B.cons (B.head sig `xor` 0x20) (B.tail sig)+ it "rejects a BIT STRING in an ECDSA signature" $+ handshake13_client_cert_verify_malformed_ecdsa $ \_ ->+ B.pack [0x30, 0x06, 0x02, 0x01, 0x01, 0x03, 0x01, 0x09] it "rejects a TLS 1.2 CertificateVerify algorithm for another key type" $ handshake12_client_cert_verify_sigalg (HashSHA256, SignatureECDSA)@@ -154,6 +176,28 @@ prop "can handshake with TLS 1.3 EE" handshake13_ee_groups prop "can handshake with TLS 1.3 EC groups" handshake13_ec prop "can handshake with TLS 1.3 FFDHE groups" handshake13_ffdhe+ mapM_+ ( \grp ->+ prop ("can handshake with " ++ show grp) $+ handshake13_kem grp+ )+ [ MLKEM512+ , MLKEM768+ , MLKEM1024+ , X25519MLKEM768+ , P256MLKEM768+ , P384MLKEM1024+ ]+ mapM_+ ( \(n, nm) -> do+ prop ("can handshake with an " ++ nm ++ " server certificate") $+ handshake13_mldsa n+ prop ("can handshake with an " ++ nm ++ " client certificate") $+ handshake13_mldsa_client n+ )+ [(0, "ML-DSA-44"), (1, "ML-DSA-65"), (2, "ML-DSA-87")]+ it "rejects a CertificateVerify whose scheme is not the key's" $+ handshake13_mldsa_wrong_scheme it "rejects an X25519MLKEM768 key share with a zero X25519 part" $ handshake13_x25519mlkem768_zero_x25519 prop "can handshake with TLS 1.3 Post-handshake auth" post_handshake_auth@@ -936,6 +980,49 @@ (void (E.try (handshake cctx) :: IO (Either TLSException ()))) r `shouldSatisfy` isJust +-- A DER ECDSA signature that does not decode is a signature that does not+-- verify, a decrypt_error. The client's TLS 1.3 CertificateVerify+-- signature is replaced on its way to the server with one that the ASN.1+-- library used to throw on, which ended the handshake with internal_error.+handshake13_client_cert_verify_malformed_ecdsa+ :: (B.ByteString -> B.ByteString) -> IO ()+handshake13_client_cert_verify_malformed_ecdsa corrupt = do+ let cipher = cipher13_AES_128_GCM_SHA256+ (clientParam, serverParam) <-+ generate $+ arbitraryPairParamsWithVersionsAndCiphers+ ([TLS13], [TLS13])+ ([cipher], [cipher])+ creds <- generate arbitraryCredentialsOfEachType+ let cred = head [c | c@(_, PrivKeyEC _) <- creds]+ clientParam' =+ clientParam+ { clientHooks =+ (clientHooks clientParam)+ { onCertificateRequest = \_ -> return $ Just cred+ }+ }+ serverParam' =+ serverParam+ { serverWantClientCert = True+ , serverHooks =+ (serverHooks serverParam)+ { onClientCertificate = \_ -> return CertificateUsageAccept+ }+ }+ malform (CertVerify13 (DigitallySigned alg sig)) =+ pure $ CertVerify13 (DigitallySigned alg (corrupt sig))+ malform hs = pure hs+ r <- timeout 10000000 $+ withPairContextWith (id, id) (clientParam', serverParam') $ \(cctx, sctx) -> do+ contextHookSetHandshake13Recv sctx malform+ concurrently_+ ((handshake sctx >> recvData sctx) `shouldThrow` rejectedAsDecryptError)+ ( void+ (E.try (handshake cctx >> recvData cctx) :: IO (Either TLSException B.ByteString))+ )+ r `shouldSatisfy` isJust+ rejectedAsDecryptError :: TLSException -> Bool rejectedAsDecryptError (HandshakeFailed (Error_Protocol _ DecryptError)) = True rejectedAsDecryptError _ = False@@ -1053,6 +1140,78 @@ rejectedAsDecodeError (HandshakeFailed (Error_Protocol _ DecodeError)) = True rejectedAsDecodeError _ = False +-- RFC 8449 Section 4: a record size limit binds the peer only when the+-- extension is negotiated. Only one side sets limitRecordSize, so the+-- extension is not negotiated, and a record of 2^14 octets from the other+-- side must be received rather than refused with record_overflow.+record_size_limit_unnegotiated :: Version -> Bool -> IO ()+record_size_limit_unnegotiated version clientLimited = do+ let cipher+ | version == TLS13 = cipher13_AES_128_GCM_SHA256+ | otherwise = cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256+ (clientParam, serverParam) <-+ generate $+ arbitraryPairParamsWithVersionsAndCiphers+ ([version], [version])+ ([cipher], [cipher])+ let limited shared = shared{sharedLimit = (sharedLimit shared){limitRecordSize = Just 1024}}+ clientParam'+ | clientLimited = clientParam{clientShared = limited $ clientShared clientParam}+ | otherwise = clientParam+ serverParam'+ | clientLimited = serverParam+ | otherwise = serverParam{serverShared = limited $ serverShared serverParam}+ payload = B.replicate 16384 0x61+ send ctx = handshake ctx >> sendData ctx (L.fromStrict payload)+ received <- newIORef B.empty+ let recv ctx = do+ handshake ctx+ let loop acc+ | B.length acc >= B.length payload = writeIORef received acc+ | otherwise = recvData ctx >>= \bs -> loop (acc <> bs)+ loop B.empty+ r <- timeout 10000000 $+ withPairContextWith (id, id) (clientParam', serverParam') $ \(cctx, sctx) ->+ if clientLimited+ then concurrently_ (send sctx) (recv cctx)+ else concurrently_ (recv sctx) (send cctx)+ r `shouldSatisfy` isJust+ readIORef received `shouldReturn` payload++-- RFC 8449 Section 4: with record_size_limit negotiated, each side keeps+-- to the other's limit. Both sides set limitRecordSize, which a TLS 1.3+-- server returns in EncryptedExtensions, and 2^14 octets sent by one side+-- must reach the other in records within its limit.+record_size_limit_negotiated :: Version -> Bool -> IO ()+record_size_limit_negotiated version serverSends = do+ let cipher+ | version == TLS13 = cipher13_AES_128_GCM_SHA256+ | otherwise = cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256+ (clientParam, serverParam) <-+ generate $+ arbitraryPairParamsWithVersionsAndCiphers+ ([version], [version])+ ([cipher], [cipher])+ let limited shared = shared{sharedLimit = (sharedLimit shared){limitRecordSize = Just 1024}}+ clientParam' = clientParam{clientShared = limited $ clientShared clientParam}+ serverParam' = serverParam{serverShared = limited $ serverShared serverParam}+ payload = B.replicate 16384 0x61+ send ctx = handshake ctx >> sendData ctx (L.fromStrict payload)+ received <- newIORef B.empty+ let recv ctx = do+ handshake ctx+ let loop acc+ | B.length acc >= B.length payload = writeIORef received acc+ | otherwise = recvData ctx >>= \bs -> loop (acc <> bs)+ loop B.empty+ r <- timeout 10000000 $+ withPairContextWith (id, id) (clientParam', serverParam') $ \(cctx, sctx) ->+ if serverSends+ then concurrently_ (send sctx) (recv cctx)+ else concurrently_ (recv sctx) (send cctx)+ r `shouldSatisfy` isJust+ readIORef received `shouldReturn` payload+ handshake_client_auth_fail :: (ClientParams, ServerParams) -> IO () handshake_client_auth_fail (clientParam, serverParam) = do let clientVersions = supportedVersions $ clientSupported clientParam@@ -1493,6 +1652,150 @@ , srv{serverSupported = svrSupported} ) runTLSSimple13 params FullHandshake++-- A handshake that succeeds, for each group whose key exchange is a KEM.+--+-- Until this was added the suite had one ML-KEM test and it was a negative+-- one: a zero X25519 part, rejected before any shared secret was computed.+-- Nothing ran encapsulation and decapsulation to the end and checked the two+-- sides reached the same key, which is the one thing a key exchange has to+-- do. An implementation that returned the ciphertext where the secret+-- belongs would have passed everything else here.+handshake13_kem :: Group -> CSP13 -> IO ()+handshake13_kem grp (CSP13 (cli, srv)) = do+ let cliSupported =+ defaultSupported+ { supportedCiphers = [cipher13_AES_128_GCM_SHA256]+ , supportedGroups = [grp]+ }+ svrSupported =+ defaultSupported+ { supportedCiphers = [cipher13_AES_128_GCM_SHA256]+ , supportedGroups = [grp]+ , supportedGroupsTLS13 = [[grp]]+ }+ params =+ ( cli{clientSupported = cliSupported}+ , srv{serverSupported = svrSupported}+ )+ runTLSSimple13 params FullHandshake++-- A handshake with an ML-DSA server certificate, and one with an ML-DSA+-- client certificate, for each parameter set.+handshake13_mldsa :: Int -> CSP13 -> IO ()+handshake13_mldsa n (CSP13 (cli, srv)) = do+ creds <- generate arbitraryCredentialsOfEachMLDSA+ let cred = creds !! n+ -- one group on both sides, so the mode is a full handshake and not+ -- a retry, which is what this is asserting about+ cliSupported =+ (clientSupported cli)+ { supportedCiphers = [cipher13_AES_128_GCM_SHA256]+ , supportedGroups = [X25519]+ }+ svrSupported =+ (serverSupported srv)+ { supportedCiphers = [cipher13_AES_128_GCM_SHA256]+ , supportedGroups = [X25519]+ , supportedGroupsTLS13 = [[X25519]]+ }+ params =+ ( cli{clientSupported = cliSupported}+ , srv+ { serverSupported = svrSupported+ , serverShared =+ (serverShared srv){sharedCredentials = Credentials [cred]}+ }+ )+ runTLSSimple13 params FullHandshake++handshake13_mldsa_client :: Int -> CSP13 -> IO ()+handshake13_mldsa_client n (CSP13 (clientParam, serverParam)) = do+ creds <- generate arbitraryCredentialsOfEachMLDSA+ let cred = creds !! n+ clientParam' =+ clientParam+ { clientHooks =+ (clientHooks clientParam)+ { onCertificateRequest = \_ -> return $ Just cred+ }+ }+ serverParam' =+ serverParam+ { serverWantClientCert = True+ , serverHooks =+ (serverHooks serverParam)+ { onClientCertificate = \chain ->+ if chain == fst cred+ then return CertificateUsageAccept+ else return (CertificateUsageReject CertificateRejectUnknownCA)+ }+ , serverSupported =+ (serverSupported serverParam)+ { supportedCiphers = [cipher13_AES_128_GCM_SHA256]+ , supportedGroups = [X25519]+ , supportedGroupsTLS13 = [[X25519]]+ }+ }+ clientParam'' =+ clientParam'+ { clientSupported =+ (clientSupported clientParam)+ { supportedCiphers = [cipher13_AES_128_GCM_SHA256]+ , supportedGroups = [X25519]+ }+ }+ runTLSSimple13 (clientParam'', serverParam') FullHandshake++-- A CertificateVerify naming a scheme the key cannot have made.+--+-- The second byte of an ML-DSA scheme is one RSASSA-PSS also uses, so code+-- that looks at it alone answers for the wrong algorithm; this is here to+-- catch that, and to pin the alert, which has to be illegal_parameter and+-- not decrypt_error -- the field is wrong, rather than the signature.+handshake13_mldsa_wrong_scheme :: IO ()+handshake13_mldsa_wrong_scheme = do+ CSP13 (cli, srv) <- generate arbitrary+ creds <- generate arbitraryCredentialsOfEachMLDSA+ let cred = head creds -- ML-DSA-44+ cliSupported =+ (clientSupported cli)+ { supportedCiphers = [cipher13_AES_128_GCM_SHA256]+ , supportedGroups = [X25519]+ }+ svrSupported =+ (serverSupported srv)+ { supportedCiphers = [cipher13_AES_128_GCM_SHA256]+ , supportedGroups = [X25519]+ , supportedGroupsTLS13 = [[X25519]]+ }+ params =+ ( cli{clientSupported = cliSupported}+ , srv+ { serverSupported = svrSupported+ , serverShared =+ (serverShared srv){sharedCredentials = Credentials [cred]}+ }+ )+ withPairContextWith (id, id) params $ \(cctx, sctx) -> do+ contextHookSetHandshake13Recv cctx relabel+ concurrently_+ (handshake cctx `shouldThrow` clientRejectedTheScheme)+ (handshake sctx `shouldThrow` anyTLSException)+ where+ -- The signature is the one ML-DSA-44 made; only the scheme is changed,+ -- to another ML-DSA size, which the key cannot have signed under.+ relabel (CertVerify13 (DigitallySigned _ sig)) =+ pure $ CertVerify13 $ DigitallySigned MLDSA65 sig+ relabel hs = pure hs++-- The reason as well as the alert. Matching the alert alone would also be+-- satisfied by an illegal_parameter raised for some other reason, which is+-- not what this is asking about.+clientRejectedTheScheme :: TLSException -> Bool+clientRejectedTheScheme (HandshakeFailed (Error_Protocol msg alert)) =+ alert == IllegalParameter && "does not fit the public key" `isInfixOf` msg+clientRejectedTheScheme _ = False handshake13_hrr :: CSP13 -> IO () handshake13_hrr (CSP13 (cli, srv)) = do
test/PubKey.hs view
@@ -4,6 +4,9 @@ arbitraryECDSAPair, arbitraryEd25519Pair, arbitraryEd448Pair,+ arbitraryMLDSA44Pair,+ arbitraryMLDSA65Pair,+ arbitraryMLDSA87Pair, globalRSAPair, getGlobalRSAPair, knownECCurves,@@ -20,8 +23,10 @@ import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.MLDSA as MLDSA import qualified Crypto.PubKey.RSA as RSA import Crypto.Random+import Data.Proxy (Proxy (..)) import qualified Data.ByteString as B import System.IO.Unsafe import Test.QuickCheck@@ -111,6 +116,27 @@ bytes <- vectorOf 32 arbitrary let priv = fromCryptoPassed $ Ed25519.secretKey (B.pack bytes) return (Ed25519.toPublic priv, priv)++-- ML-DSA, from a seed drawn here, so a run is reproducible from its seed+-- the way the other pairs are.+arbitraryMLDSAPair+ :: MLDSA.MLDSA p+ => proxy p -> Gen (MLDSA.VerificationKey p, MLDSA.SigningKey p)+arbitraryMLDSAPair p = do+ bytes <- vectorOf MLDSA.seedSize arbitrary+ return $ fromCryptoPassed $ MLDSA.keyPairFromSeed p (B.pack bytes)++arbitraryMLDSA44Pair+ :: Gen (MLDSA.VerificationKey MLDSA.MLDSA44, MLDSA.SigningKey MLDSA.MLDSA44)+arbitraryMLDSA44Pair = arbitraryMLDSAPair (Proxy :: Proxy MLDSA.MLDSA44)++arbitraryMLDSA65Pair+ :: Gen (MLDSA.VerificationKey MLDSA.MLDSA65, MLDSA.SigningKey MLDSA.MLDSA65)+arbitraryMLDSA65Pair = arbitraryMLDSAPair (Proxy :: Proxy MLDSA.MLDSA65)++arbitraryMLDSA87Pair+ :: Gen (MLDSA.VerificationKey MLDSA.MLDSA87, MLDSA.SigningKey MLDSA.MLDSA87)+arbitraryMLDSA87Pair = arbitraryMLDSAPair (Proxy :: Proxy MLDSA.MLDSA87) arbitraryEd448Pair :: Gen (Ed448.PublicKey, Ed448.SecretKey) arbitraryEd448Pair = do
tls.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: tls-version: 2.4.9+version: 2.4.10 license: BSD3 license-file: LICENSE copyright: Vincent Hanquez <vincent@snarc.org>@@ -122,16 +122,15 @@ base16-bytestring, bytestring >=0.10 && <0.13, cereal >=0.5.3 && <0.6,- crypton >=2.1.1 && <2.2,+ crypton >=2.1.8 && <2.3, crypton-asn1-encoding >= 0.10.0 && < 0.11, crypton-asn1-types >= 0.4.1 && < 0.5,- crypton-x509 >=1.9 && <1.10,- crypton-x509-store >=1.9 && <1.10,- crypton-x509-validation >=1.9 && <1.10,+ crypton-x509 >=1.10 && <1.11,+ crypton-x509-store >=1.10 && <1.11,+ crypton-x509-validation >=1.10 && <1.11, data-default, ech-config,- hpke >=0.1.0 && <0.3,- mlkem >= 0.2.0 && <0.3,+ hpke >=0.3.0 && <0.4, mtl >=2.2 && <2.4, network >=3.1, ram >=0.22.0 && <0.23,
util/tls-server.hs view
@@ -157,6 +157,10 @@ | optUseWeakCiphers = supportedGroups defaultSupported -- excluding FFDHE8192 for retry | otherwise = FFDHE8192 `delete` supportedGroups defaultSupported+ -- A TLS 1.3 server picks a group from supportedGroupsTLS13, so the+ -- groups given with -g go there too. Without -g, the default+ -- preference stands.+ groupsTLS13 = maybe (supportedGroupsTLS13 defaultSupported) (: []) optGroups when (null groups) $ do putStrLn "Error: unsupported groups" exitFailure@@ -193,6 +197,7 @@ creds optUseWeakCiphers groups+ groupsTLS13 smgr keyLog optClientAuth@@ -222,6 +227,7 @@ :: Credentials -> Bool -> [Group]+ -> [[Group]] -> SessionManager -> (String -> IO ()) -> Bool@@ -231,7 +237,7 @@ -> (String -> IO ()) -> Maybe HostName -> ServerParams-getServerParams creds weak groups sm keyLog clientAuth mstore (ekey, ecnf) printError traceKey mname =+getServerParams creds weak groups groupsTLS13 sm keyLog clientAuth mstore (ekey, ecnf) printError traceKey mname = defaultParamsServer { serverSupported = supported , serverShared = shared@@ -260,6 +266,7 @@ defaultSupported { supportedCiphers = ciphers , supportedGroups = groups+ , supportedGroupsTLS13 = groupsTLS13 , supportedExtendedMainSecret = if weak then AllowEMS else supportedExtendedMainSecret defaultSupported , supportedClientInitiatedRenegotiation =