tls 2.3.1 → 2.4.3
raw patch · 20 files changed
Files
- CHANGELOG.md +24/−4
- Network/TLS.hs +2/−1
- Network/TLS/Compression.hs +1/−1
- Network/TLS/Context/Internal.hs +1/−1
- Network/TLS/Core.hs +1/−1
- Network/TLS/Extension.hs +1/−1
- Network/TLS/Extra/CipherCBC.hs +201/−0
- Network/TLS/Handshake/Certificate.hs +21/−1
- Network/TLS/Handshake/Client.hs +18/−8
- Network/TLS/Handshake/Client/ClientHello.hs +3/−2
- Network/TLS/Handshake/Server.hs +3/−3
- Network/TLS/Handshake/Server/ClientHello12.hs +1/−1
- Network/TLS/Handshake/Server/Common.hs +4/−2
- Network/TLS/Handshake/Server/ServerHello12.hs +1/−1
- Network/TLS/Handshake/Server/TLS13.hs +1/−1
- Network/TLS/Parameters.hs +18/−6
- Network/TLS/QUIC.hs +3/−3
- test/HandshakeSpec.hs +45/−1
- tls.cabal +3/−2
- util/Common.hs +1/−1
CHANGELOG.md view
@@ -1,7 +1,27 @@ # Change log for "tls" -## Version 2.3.1+## Version 2.4.3 +* A server checks clientAuth of ExtendedKeyUsage in a client+ certificate on client authentication.++## Version 2.4.2++* The `Network.TLS.Extra.CipherCBC` module is added.+ [#526](https://github.com/haskell-tls/hs-tls/pull/526)++## Version 2.4.1++* Ensure same `supported_groups` before/after HRR.+* New `clientWantTicket` parameter makes it possible to opt-out of soliciting+ session tickets from servers.++## Version 2.4.0++* Identical to v2.3.1 but major version up as v2.3.1 breaks "quic".++## Version 2.3.1 (deprecated)+ * Using ScrubbedBytes for secrets. * Key echange with ML-KEM. [#517](https://github.com/haskell-tls/hs-tls/pull/517)@@ -81,14 +101,14 @@ This feature is automatically used if the peer supports it. * More tests with `tlsfuzzer` especially for client authentication and 0-RTT.-* Implementing a utility funcation, `validateClientCertificate`, for+* Implementing a utility function, `validateClientCertificate`, for client authentication. * Bug fix for echo back logic of Cookie extension. * More pretty show for the internal `Handshake` structure for debugging. ## Version 2.1.6 -* Testing with "tlsfuzzer" again. Now don't send an alert agaist to+* Testing with "tlsfuzzer" again. Now don't send an alert against to peer's alert. Double locking (aka self dead-lock) is fixed. Sending an alert for known-but-cannot-parse extensions. Other corner cases are also fixed.@@ -352,7 +372,7 @@ API CHANGES: - `SessionManager` implementations need to provide a `sessionResumeOnlyOnce`- function to accomodate resumption scenarios with 0-RTT data. The function is+ function to accommodate resumption scenarios with 0-RTT data. The function is called only on the server side. - Data type `SessionData` is extended with four new fields for TLS version 1.3. `SessionManager` implementations that serializes/deserializes `SessionData`
Network/TLS.hs view
@@ -11,7 +11,7 @@ -- protocol, and support RSA and Ephemeral (Elliptic curve and -- regular) Diffie Hellman key exchanges, and many extensions. ----- The tipical usage is:+-- The typical usage is: -- -- > socket <- ... -- > ctx <- contextNew socket <params>@@ -46,6 +46,7 @@ clientUseServerNameIndication, clientWantSessionResume, clientWantSessionResumeList,+ clientWantTicket, clientShared, clientHooks, clientSupported,
Network/TLS/Compression.hs view
@@ -51,7 +51,7 @@ (==) c1 c2 = compressionID c1 == compressionID c2 -- | intersect a list of ids commonly given by the other side with a list of compression--- the function keeps the list of compression in order, to be able to find quickly the prefered+-- the function keeps the list of compression in order, to be able to find quickly the preferred -- compression. compressionIntersectID :: [Compression] -> [Word8] -> [Compression] compressionIntersectID l ids = filter (\c -> compressionID c `elem` ids) l
Network/TLS/Context/Internal.hs view
@@ -211,7 +211,7 @@ , tls13stClientExtensions :: [ExtensionRaw] -- client , tls13stChoice :: ~CipherChoice -- client , tls13stHsKey :: Maybe (SecretTriple HandshakeSecret) -- client- -- Actuall session id for TLS 1.2, random value for TLS 1.3+ -- Actual session id for TLS 1.2, random value for TLS 1.3 , tls13stSession :: Session , tls13stSentExtensions :: [ExtensionID] }
Network/TLS/Core.hs view
@@ -188,7 +188,7 @@ -- All chunks are protected with the same write lock because we don't -- want to interleave writes from other threads in the middle of our -- possibly large write.- mlen <- getPeerRecordLimit ctx -- plaintext, dont' adjust for TLS 1.3+ mlen <- getPeerRecordLimit ctx -- plaintext, don't adjust for TLS 1.3 mapM_ (mapChunks_ mlen sendP) (L.toChunks dataToSend) -- | Get data out of Data packet, and automatically renegotiate if a Handshake
Network/TLS/Extension.hs view
@@ -443,7 +443,7 @@ ------------------------------------------------------------ -- | Server Name extension including the name type and the associated name.--- the associated name decoding is dependant of its name type.+-- the associated name decoding is dependent of its name type. -- name type = 0 : hostname newtype ServerName = ServerName [ServerNameType] deriving (Show, Eq)
+ Network/TLS/Extra/CipherCBC.hs view
@@ -0,0 +1,201 @@+module Network.TLS.Extra.CipherCBC (+ -- * TLS 1.2 CBC ciphers with PFS and SHA2+ ciphersuite_pfs_sha2_cbc,+ ciphersuite_ecdhe_sha2_cbc,+ ciphersuite_dhe_rsa_sha2_cbc,++ -- ** Individual CBC ciphers+ cipher_DHE_RSA_AES128_SHA256,+ cipher_DHE_RSA_AES256_SHA256,+ cipher_ECDHE_RSA_AES128CBC_SHA256,+ cipher_ECDHE_RSA_AES256CBC_SHA384,+ cipher_ECDHE_ECDSA_AES128CBC_SHA256,+) where++import Crypto.Cipher.AES+import Crypto.Cipher.Types hiding (Cipher, cipherName)+import Crypto.Error+-- import Crypto.System.CPU+import qualified Data.ByteString as B++import Network.TLS.Cipher+import Network.TLS.Imports+import Network.TLS.Types hiding (IV)++----------------------------------------------------------------++-- | TLS 1.2 AES CBC ciphers with DHE or ECDHE key exchange, ECDSA or RSA+-- authentication and a SHA256 or SHA2384 MAC.+-- For legacy applications only, deprecated in HTTPS.+ciphersuite_pfs_sha2_cbc :: [Cipher]+ciphersuite_pfs_sha2_cbc =+ [ cipher_ECDHE_ECDSA_AES128CBC_SHA256+ , cipher_ECDHE_ECDSA_AES256CBC_SHA384+ , cipher_ECDHE_RSA_AES128CBC_SHA256+ , cipher_ECDHE_RSA_AES256CBC_SHA384+ , cipher_DHE_RSA_AES128_SHA256+ , cipher_DHE_RSA_AES256_SHA256+ ]++-- | TLS 1.2 AES CBC ciphers with ECDHE key exchange, ECDSA or RSA+-- authentication and a SHA256 or SHA2384 MAC.+-- For legacy applications only, deprecated in HTTPS.+ciphersuite_ecdhe_sha2_cbc :: [Cipher]+ciphersuite_ecdhe_sha2_cbc =+ [ cipher_ECDHE_ECDSA_AES128CBC_SHA256+ , cipher_ECDHE_ECDSA_AES256CBC_SHA384+ , cipher_ECDHE_RSA_AES128CBC_SHA256+ , cipher_ECDHE_RSA_AES256CBC_SHA384+ ]++-- | TLS 1.2 AES CBC ciphers with DHE key exchange, RSA authentication and a+-- SHA256 MAC.+-- For legacy applications only, deprecated in HTTPS.+ciphersuite_dhe_rsa_sha2_cbc :: [Cipher]+ciphersuite_dhe_rsa_sha2_cbc =+ [ cipher_DHE_RSA_AES256_SHA256+ , cipher_DHE_RSA_AES128_SHA256+ ]++----------------------------------------------------------------++-- | TLS 1.2 AES128 CBC, with DHE key exchange, RSA authentication and a SHA256 MAC.+-- For legacy applications only, deprecated in HTTPS.+cipher_DHE_RSA_AES128_SHA256 :: Cipher+cipher_DHE_RSA_AES128_SHA256 =+ Cipher+ { cipherID = 0x0067+ , cipherName = "DHE-RSA-AES128-SHA256"+ , cipherBulk = bulk_aes128+ , cipherHash = SHA256+ , cipherPRFHash = Just SHA256+ , cipherKeyExchange = CipherKeyExchange_DHE_RSA+ , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4+ }++-- | TLS 1.2 AES256 CBC, with DHE key exchange, RSA authentication and a SHA256 MAC.+-- For legacy applications only, deprecated in HTTPS.+cipher_DHE_RSA_AES256_SHA256 :: Cipher+cipher_DHE_RSA_AES256_SHA256 =+ cipher_DHE_RSA_AES128_SHA256+ { cipherID = 0x006B+ , cipherName = "DHE-RSA-AES256-SHA256"+ , cipherBulk = bulk_aes256+ }++-- | TLS 1.2 AES128 CBC, with ECDHE key exchange, RSA authentication and a SHA256 MAC.+-- For legacy applications only, deprecated in HTTPS.+cipher_ECDHE_RSA_AES128CBC_SHA256 :: Cipher+cipher_ECDHE_RSA_AES128CBC_SHA256 =+ Cipher+ { cipherID = 0xC027+ , cipherName = "ECDHE-RSA-AES128CBC-SHA256"+ , cipherBulk = bulk_aes128+ , cipherHash = SHA256+ , cipherPRFHash = Just SHA256+ , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA+ , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4+ }++-- | TLS 1.2 AES256 CBC, with ECDHE key exchange, RSA authentication and a SHA384 MAC.+-- For legacy applications only, deprecated in HTTPS.+cipher_ECDHE_RSA_AES256CBC_SHA384 :: Cipher+cipher_ECDHE_RSA_AES256CBC_SHA384 =+ Cipher+ { cipherID = 0xC028+ , cipherName = "ECDHE-RSA-AES256CBC-SHA384"+ , cipherBulk = bulk_aes256+ , cipherHash = SHA384+ , cipherPRFHash = Just SHA384+ , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA+ , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4+ }++-- | TLS 1.2 AES128 CBC, with ECDHE key exchange, ECDSA authentication and a SHA256 MAC.+-- For legacy applications only, deprecated in HTTPS.+cipher_ECDHE_ECDSA_AES128CBC_SHA256 :: Cipher+cipher_ECDHE_ECDSA_AES128CBC_SHA256 =+ Cipher+ { cipherID = 0xc023+ , cipherName = "ECDHE-ECDSA-AES128CBC-SHA256"+ , cipherBulk = bulk_aes128+ , cipherHash = SHA256+ , cipherPRFHash = Just SHA256+ , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA+ , cipherMinVer = Just TLS12 -- RFC 5289+ }++-- | TLS 1.2 AES256 CBC, with ECDHE key exchange, ECDSA authentication and a SHA384 MAC.+-- For legacy applications only, deprecated in HTTPS.+cipher_ECDHE_ECDSA_AES256CBC_SHA384 :: Cipher+cipher_ECDHE_ECDSA_AES256CBC_SHA384 =+ Cipher+ { cipherID = 0xC024+ , cipherName = "ECDHE-ECDSA-AES256CBC-SHA384"+ , cipherBulk = bulk_aes256+ , cipherHash = SHA384+ , cipherPRFHash = Just SHA384+ , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA+ , cipherMinVer = Just TLS12 -- RFC 5289+ }++----------------------------------------------------------------++aes128cbc :: BulkDirection -> BulkKey -> BulkBlock+aes128cbc BulkEncrypt key =+ let ctx = noFail (cipherInit key) :: AES128+ in ( \iv input ->+ let output = cbcEncrypt ctx (makeIV_ iv) input in (output, takelast 16 output)+ )+aes128cbc BulkDecrypt key =+ let ctx = noFail (cipherInit key) :: AES128+ in ( \iv input ->+ let output = cbcDecrypt ctx (makeIV_ iv) input in (output, takelast 16 input)+ )++aes256cbc :: BulkDirection -> BulkKey -> BulkBlock+aes256cbc BulkEncrypt key =+ let ctx = noFail (cipherInit key) :: AES256+ in ( \iv input ->+ let output = cbcEncrypt ctx (makeIV_ iv) input in (output, takelast 16 output)+ )+aes256cbc BulkDecrypt key =+ let ctx = noFail (cipherInit key) :: AES256+ in ( \iv input ->+ let output = cbcDecrypt ctx (makeIV_ iv) input in (output, takelast 16 input)+ )++makeIV_ :: BlockCipher a => B.ByteString -> IV a+makeIV_ = fromMaybe (error "makeIV_") . makeIV++takelast :: Int -> B.ByteString -> B.ByteString+takelast i b = B.drop (B.length b - i) b++noFail :: CryptoFailable a -> a+noFail = throwCryptoError++----------------------------------------------------------------++bulk_aes128 :: Bulk+bulk_aes128 =+ Bulk+ { bulkName = "AES128"+ , bulkKeySize = 16+ , bulkIVSize = 16+ , bulkExplicitIV = 0+ , bulkAuthTagLen = 0+ , bulkBlockSize = 16+ , bulkF = BulkBlockF aes128cbc+ }++bulk_aes256 :: Bulk+bulk_aes256 =+ Bulk+ { bulkName = "AES256"+ , bulkKeySize = 32+ , bulkIVSize = 16+ , bulkExplicitIV = 0+ , bulkAuthTagLen = 0+ , bulkBlockSize = 16+ , bulkF = BulkBlockF aes256cbc+ }
Network/TLS/Handshake/Certificate.hs view
@@ -3,13 +3,20 @@ badCertificate, rejectOnException, verifyLeafKeyUsage,+ verifyLeafKeyUsagePurpose, extractCAname, ) where import Control.Exception (SomeException) import Control.Monad (unless) import Control.Monad.State.Strict-import Data.X509 (ExtKeyUsage (..), ExtKeyUsageFlag, extensionGet)+import Data.X509 (+ ExtExtendedKeyUsage (..),+ ExtKeyUsage (..),+ ExtKeyUsageFlag,+ ExtKeyUsagePurpose (..),+ extensionGet,+ ) import Network.TLS.Context.Internal import Network.TLS.Struct@@ -46,6 +53,19 @@ case extensionGet (certExtensions cert) of Nothing -> True -- unrestricted cert Just (ExtKeyUsage flags) -> any (`elem` validFlags) flags++verifyLeafKeyUsagePurpose+ :: MonadIO m => ExtKeyUsagePurpose -> CertificateChain -> m ()+verifyLeafKeyUsagePurpose _ (CertificateChain []) = return ()+verifyLeafKeyUsagePurpose validPurpose (CertificateChain (signed : _)) =+ unless verified $+ badCertificate $+ "certificate is not allowed for " ++ show validPurpose+ where+ cert = getCertificate signed+ verified = case extensionGet (certExtensions cert) of+ Nothing -> True+ Just (ExtExtendedKeyUsage purposes) -> validPurpose `elem` purposes extractCAname :: SignedCertificate -> DistinguishedName extractCAname cert = certSubjectDN $ getCertificate cert
Network/TLS/Handshake/Client.hs view
@@ -102,7 +102,7 @@ case ver of TLS13 | hrr ->- helloRetry cparams ctx mparams ver crand (grpsSupported \\ grpsSelected)+ helloRetry cparams ctx mparams ver crand grpsSupported grpsSelected | otherwise -> do recvServerSecondFlight13 cparams ctx grpsSelected sendClientSecondFlight13 cparams ctx@@ -126,8 +126,9 @@ -> Version -> ClientRandom -> [Group]+ -> [Group] -> IO ()-helloRetry cparams ctx mparams ver crand groupsSupported = do+helloRetry cparams ctx mparams ver crand groupsSupported groupsSelected = do when (null groupsSupported) $ throwCore $ Error_Protocol "no supported groups on the client side" IllegalParameter@@ -137,18 +138,22 @@ mks <- usingState_ ctx getTLS13KeyShare case mks of Just (KeyShareHRR selectedGroup)- | selectedGroup `elem` groupsSupported -> do+ -- RFC 8446 Sec 4.1.4: the selected_group MUST be in supported_groups+ -- and MUST NOT already have been offered in the initial key_share.+ | selectedGroup `elem` groupsSupported+ && selectedGroup `notElem` groupsSelected -> do usingHState ctx $ setTLS13HandshakeMode HelloRetryRequest clearTxRecordState ctx let cparams' = cparams{clientUseEarlyData = False} runPacketFlight ctx $ sendChangeCipherSpec13 ctx clientSession <- tls13stSession <$> getTLS13State ctx- let groupsSupported' = selectedGroup : filter (/= selectedGroup) groupsSupported- groupsSelected' = [selectedGroup]- grps =+ -- RFC 8446 Sec 4.1.2: the second ClientHello MUST be identical+ -- to the first except for the specific listed changes.+ -- supported_groups is NOT on that list, so it must be unchanged.+ let grps = Groups- { grpsSupported = groupsSupported'- , grpsSelected = groupsSelected'+ { grpsSupported = groupsSupported+ , grpsSelected = [selectedGroup] } handshake@@ -156,6 +161,11 @@ ctx grps (Just (crand, clientSession, ver))+ | selectedGroup `elem` groupsSelected ->+ throwCore $+ Error_Protocol+ "server selected a group already offered in key_share"+ IllegalParameter | otherwise -> throwCore $ Error_Protocol "server-selected group is not supported" IllegalParameter
Network/TLS/Handshake/Client/ClientHello.hs view
@@ -262,11 +262,12 @@ Nothing -> return Nothing Just siz -> return $ Just $ toExtensionRaw $ RecordSizeLimit $ fromIntegral siz - sessionTicketExt = do+ sessionTicketExt = case clientSessions cparams of (sidOrTkt, _) : _ | isTicket sidOrTkt -> return $ Just $ toExtensionRaw $ SessionTicket sidOrTkt- _ -> return $ Just $ toExtensionRaw $ SessionTicket ""+ _ | clientWantTicket cparams -> return $ Just $ toExtensionRaw $ SessionTicket ""+ | otherwise -> return $ Nothing earlyDataExt | rtt0 = return $ Just $ toExtensionRaw (EarlyDataIndication Nothing)
Network/TLS/Handshake/Server.hs view
@@ -45,9 +45,9 @@ -- | Put the server context in handshake mode. -- -- Expect a client hello message as parameter.--- This is useful when the client hello has been already poped from the recv layer to inspect the packet.+-- This is useful when the client hello has been already popped from the recv layer to inspect the packet. ----- When the function returns, a new handshake has been succesfully negociated.+-- When the function returns, a new handshake has been successfully negotiated. -- On any error, a HandshakeFailed exception is raised. handshake :: ServerParams -> Context -> HandshakeR -> IO () handshake sparams ctx chb@(ClientHello ch, bs) = do@@ -66,7 +66,7 @@ SelectKeyShareHRR g -> do sendHRR ctx g r0 chI $ isJust mcrnd -- Don't reset ctxEstablished since 0-RTT data- -- would be comming, which should be ignored.+ -- would be coming, which should be ignored. handshakeServer sparams ctx SelectKeyShareFound cliKeyShare -> do unless (checkClientKeyShareKeyLength cliKeyShare) $
Network/TLS/Handshake/Server/ClientHello12.hs view
@@ -101,7 +101,7 @@ -- Cipher selection is performed in two steps: first server credentials -- are flagged as not suitable for signature if not compatible with- -- negotiated signature parameters. Then ciphers are evalutated from+ -- negotiated signature parameters. Then ciphers are evaluated from -- the resulting credentials. supported = serverSupported sparams
Network/TLS/Handshake/Server/Common.hs view
@@ -15,7 +15,7 @@ ) where import Control.Monad.State.Strict-import Data.X509 (ExtKeyUsageFlag (..))+import Data.X509 (ExtKeyUsageFlag (..), ExtKeyUsagePurpose (..)) import Network.TLS.Context.Internal import Network.TLS.Credentials@@ -151,7 +151,9 @@ (onClientCertificate (serverHooks sparams) certs) rejectOnException case usage of- CertificateUsageAccept -> verifyLeafKeyUsage [KeyUsage_digitalSignature] certs+ CertificateUsageAccept -> do+ verifyLeafKeyUsage [KeyUsage_digitalSignature] certs+ verifyLeafKeyUsagePurpose KeyUsagePurpose_ClientAuth certs CertificateUsageReject reason -> certificateRejected reason -- Remember cert chain for later use.
Network/TLS/Handshake/Server/ServerHello12.hs view
@@ -93,7 +93,7 @@ | TLS12 < sessionVersion sd = return Nothing -- fixme | CipherId (sessionCipher sd) `notElem` ciphers = throwCore $- Error_Protocol "new cipher is diffrent from the old one" IllegalParameter+ Error_Protocol "new cipher is different from the old one" IllegalParameter | isJust sni && sessionClientSNI sd /= sni = do usingState_ ctx clearClientSNI return Nothing
Network/TLS/Handshake/Server/TLS13.hs view
@@ -369,7 +369,7 @@ TwoWay deriving (Eq, Show) --- | Updating appication traffic secrets for TLS 1.3.+-- | Updating application traffic secrets for TLS 1.3. -- If this API is called for TLS 1.3, 'True' is returned. -- Otherwise, 'False' is returned. updateKey :: MonadIO m => Context -> KeyUpdateRequest -> m Bool
Network/TLS/Parameters.hs view
@@ -65,7 +65,7 @@ -- -- Default: 'Nothing' , debugPrintSeed :: Seed -> IO ()- -- ^ Add a way to print the seed that was randomly generated. re-using the same seed+ -- ^ Add a way to print the seed that was randomly generated. reusing the same seed -- will reproduce the same randomness with 'debugSeed' -- -- Default: no printing@@ -153,6 +153,16 @@ -- specified for TLS 1.2 but only the first entry is used. -- -- Default: '[]'+ , clientWantTicket :: Bool+ -- ^ Whether to solicit TLS 1.2 session tickets (or TLS 1.3+ -- resumption PSKs) from servers. With a 'False' setting,+ -- stateless clients that never do resumption can avoid+ -- wasting server and client resources used to generate,+ -- transmit and process tickets that will never be used.+ --+ -- Default: 'True'+ --+ -- @since 2.4.1 , clientShared :: Shared -- ^ See the default value of 'Shared'. , clientHooks :: ClientHooks@@ -192,6 +202,7 @@ , clientUseServerNameIndication = True , clientWantSessionResume = Nothing , clientWantSessionResumeList = []+ , clientWantTicket = True , clientShared = def , clientHooks = def , clientSupported = def@@ -401,8 +412,9 @@ -- -- Default: @[X25519,P256,P384,X448,P521,FFDHE3072,FFDHE4096,FFDHE6144,FFDHE8192,X25519MLKEM768,P256MLKEM768,P384MLKEM1024,MLKEM768,MLKEM1024]@ , supportedGroupsTLS13 :: [[Group]]- -- ^ @[Group]@ contains @Group@s of the same level in preferred order.- -- @[Group]@ is also listed in preferred order.+ -- ^ The inside @[Group]@ is the list of @Group@ at the same level+ -- in preferred order. The inside @[Group]@s are also listed in+ -- preferred order. -- -- TLS 1.3 server: this is used as the 1st argument to -- 'onSelectKeyShare'.@@ -657,7 +669,7 @@ -- (3) rejecting unless 1 < dh_p && pub < dh_p - 1 -- (4) rejecting if dh_size < 1024 (to prevent Logjam attack) --- -- See RFC 7919 section 3.1 for recommandations.+ -- See RFC 7919 section 3.1 for recommendations. , onServerFinished :: Information -> IO () -- ^ When a handshake is done, this hook can check `Information`. , onSelectKeyShareGroups :: [Group] -> [Group]@@ -722,7 +734,7 @@ -- of the certificate. This verification is performed by the -- library internally. --- -- Default: returns the followings:+ -- Default: returns the following: -- -- @ -- CertificateUsageReject (CertificateRejectOther "no client certificates expected")@@ -738,7 +750,7 @@ -- client version and the client list of ciphers. -- -- This could be useful with old clients and as a workaround to- -- the BEAST (where RC4 is sometimes prefered with TLS < 1.1)+ -- the BEAST (where RC4 is sometimes preferred with TLS < 1.1) -- -- The client cipher list cannot be empty. --
Network/TLS/QUIC.hs view
@@ -116,7 +116,7 @@ { quicSend :: [(CryptLevel, ByteString)] -> IO () -- ^ Called by TLS so that QUIC sends one or more handshake fragments. The -- content transiting on this API is the plaintext of the fragments and- -- QUIC responsability is to encrypt this payload with the key material+ -- QUIC responsibility is to encrypt this payload with the key material -- given for the specified level and an appropriate encryption scheme. -- -- The size of the fragments may exceed QUIC datagram limits so QUIC may@@ -194,7 +194,7 @@ let qexts = filterQTP exts when (null qexts) $ do throwCore $- Error_Protocol "QUIC transport parameters are mssing" MissingExtension+ Error_Protocol "QUIC transport parameters are missing" MissingExtension quicNotifyExtensions callbacks ctx qexts quicInstallKeys callbacks ctx (InstallApplicationKeys appSecInfo) @@ -222,7 +222,7 @@ let qexts = filterQTP exts when (null qexts) $ do throwCore $- Error_Protocol "QUIC transport parameters are mssing" MissingExtension+ Error_Protocol "QUIC transport parameters are missing" MissingExtension quicNotifyExtensions callbacks ctx qexts quicInstallKeys callbacks ctx (InstallEarlyKeys mEarlySecInfo) quicInstallKeys callbacks ctx (InstallHandshakeKeys handSecInfo)
test/HandshakeSpec.hs view
@@ -11,6 +11,7 @@ import Data.X509 (ExtKeyUsageFlag (..)) import Network.TLS import Network.TLS.Extra.Cipher+import Network.TLS.Extra.CipherCBC import Network.TLS.Internal import Test.Hspec import Test.Hspec.QuickCheck@@ -47,6 +48,7 @@ prop "can resume with extended main secret" handshake_resumption_ems prop "can handle ALPN" handshake_alpn prop "can handle SNI" handshake_sni+ prop "can handshake with TLS 1.2 CBC" handshake_cbc prop "can re-negotiate with TLS 1.2" handshake12_renegotiation prop "can resume session with TLS 1.2" handshake12_session_resumption prop "can resume session ticket with TLS 1.2" handshake12_session_ticket@@ -102,6 +104,48 @@ -------------------------------------------------------------- +handshake_cbc :: IO ()+handshake_cbc = do+ clientCiphers <- generate $ cipherGen >>= shuffle+ serverCiphers <- generate $ cipherGen >>= shuffle+ clientGroups <- generate $ groupGen >>= shuffle+ serverGroups <- generate $ groupGen >>= shuffle+ (clientParam, serverParam) <- generate $+ arbitraryPairParamsWithVersionsAndCiphers+ ([TLS12], [TLS12])+ (clientCiphers, serverCiphers)+ let clientParam' = clientParam {+ clientSupported = (clientSupported clientParam)+ { supportedGroups = clientGroups } }+ serverParam' = serverParam {+ serverSupported = (serverSupported serverParam)+ { supportedGroups = serverGroups } }+ let ciphers = clientCiphers `intersect` serverCiphers+ groups = clientGroups `intersect` serverGroups+ in if compat ciphers groups+ then runTLSSimple (clientParam', serverParam')+ else runTLSFailure (clientParam', serverParam') handshake handshake+ where+ groupGen :: Gen [Group]+ groupGen = sublistOf grps `suchThat` (not . null)+ where+ grps = [X25519, P256, P384, FFDHE2048, FFDHE3072, FFDHE4096]++ cipherGen :: Gen [Cipher]+ cipherGen = sublistOf ciphersuite_pfs_sha2_cbc `suchThat` (not . null)++ compat :: [Cipher] -> [Group] -> Bool+ compat [] _ = False+ compat _ [] = False+ compat ciphers groups =+ let mustdh = all (== CipherKeyExchange_DHE_RSA) $ map cipherKeyExchange ciphers+ mustec = all (/= CipherKeyExchange_DHE_RSA) $ map cipherKeyExchange ciphers+ havedh = any (`elem` [FFDHE2048, FFDHE3072, FFDHE4096]) groups+ haveec = any (`elem` [X25519, P256, P384]) groups+ in ((not mustdh || havedh) && (not mustec || haveec))++--------------------------------------------------------------+ handshake13_downgrade :: (ClientParams, ServerParams) -> IO () handshake13_downgrade (cparam, sparam) = do versionForced <-@@ -958,7 +1002,7 @@ , srv{serverSupported = svrSupported} ) (_, serverMessages) <- runTLSCapture13 params- -- The server should tell X25519 in supported_groups in EE to clinet+ -- The server should tell X25519 in supported_groups in EE to client let isSupportedGroups (ExtensionRaw eid _) = eid == EID_SupportedGroups eeMessagesHaveExt = [ any isSupportedGroups exts
tls.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: tls-version: 2.3.1+version: 2.4.3 license: BSD3 license-file: LICENSE copyright: Vincent Hanquez <vincent@snarc.org>@@ -34,6 +34,7 @@ Network.TLS.Internal Network.TLS.Extra Network.TLS.Extra.Cipher+ Network.TLS.Extra.CipherCBC Network.TLS.Extra.FFDHE Network.TLS.QUIC @@ -137,7 +138,7 @@ random >=1.2 && <1.4, serialise >=0.2 && <0.3, transformers >=0.5 && <0.7,- unix-time >=0.4.11 && <0.5,+ unix-time >=0.4.11 && <0.6, zlib >=0.7 && <0.8 executable tls-server
util/Common.hs view
@@ -111,7 +111,7 @@ minfo <- contextGetInformation ctx case minfo of Nothing -> do- putStrLn "Erro: information cannot be obtained"+ putStrLn "Error: information cannot be obtained" exitFailure Just info -> return info