tls 2.1.5 → 2.1.6

raw patch · 52 files changed

+2463/−1884 lines, 52 files

Files

• CHANGELOG.md +8/−0
• Network/TLS/Cipher.hs +17/−75
• Network/TLS/Context.hs +5/−1
• Network/TLS/Core.hs +23/−15
• Network/TLS/Crypto/Types.hs +12/−1
• Network/TLS/Error.hs +194/−0
• Network/TLS/Extension.hs +530/−251
• Network/TLS/Extension.hs-boot +22/−0
• Network/TLS/Extra/Cipher.hs +498/−311
• Network/TLS/Handshake/Client/ClientHello.hs +3/−6
• Network/TLS/Handshake/Client/Common.hs +10/−4
• Network/TLS/Handshake/Client/ServerHello.hs +13/−9
• Network/TLS/Handshake/Client/TLS12.hs +2/−2
• Network/TLS/Handshake/Client/TLS13.hs +5/−6
• Network/TLS/Handshake/Common.hs +23/−15
• Network/TLS/Handshake/Common13.hs +13/−10
• Network/TLS/Handshake/Key.hs +1/−1
• Network/TLS/Handshake/Server.hs +1/−2
• Network/TLS/Handshake/Server/ClientHello.hs +29/−15
• Network/TLS/Handshake/Server/ClientHello12.hs +38/−48
• Network/TLS/Handshake/Server/ClientHello13.hs +22/−18
• Network/TLS/Handshake/Server/Common.hs +71/−33
• Network/TLS/Handshake/Server/ServerHello12.hs +54/−61
• Network/TLS/Handshake/Server/ServerHello13.hs +78/−68
• Network/TLS/Handshake/Server/TLS12.hs +12/−10
• Network/TLS/Handshake/Server/TLS13.hs +3/−3
• Network/TLS/HashAndSignature.hs +145/−0
• Network/TLS/Internal.hs +13/−2
• Network/TLS/Packet.hs +36/−32
• Network/TLS/Packet13.hs +10/−9
• Network/TLS/Parameters.hs +4/−2
• Network/TLS/QUIC.hs +4/−3
• Network/TLS/Receiving.hs +4/−1
• Network/TLS/Record/Disengage.hs +9/−0
• Network/TLS/State.hs +9/−5
• Network/TLS/Struct.hs +57/−527
• Network/TLS/Struct13.hs +7/−4
• Network/TLS/Types.hs +26/−161
• Network/TLS/Types/Cipher.hs +120/−0
• Network/TLS/Types/Secret.hs +43/−0
• Network/TLS/Types/Session.hs +72/−0
• Network/TLS/Types/Version.hs +40/−0
• Network/TLS/Wire.hs +7/−2
• test/Arbitrary.hs +27/−15
• test/HandshakeSpec.hs +47/−48
• test/Run.hs +2/−3
• tls.cabal +8/−5
• util/Client.hs +5/−3
• util/Common.hs +2/−48
• util/Server.hs +19/−10
• util/tls-client.hs +38/−24
• util/tls-server.hs +22/−15

@@ -1,3 +1,11 @@+## Version 2.1.6++* Testing with "tlsfuzzer" again. Now don't send an alert agaist 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.+* `tls-client -d` and `tls-server -d` pretty-prints `Handshake`.+ ## Version 2.1.5  * Removing the dependency on the async package.

@@ -22,19 +22,14 @@     cipherAllowedForVersion,     hasMAC,     hasRecordIV,+    elemCipher,+    intersectCiphers,+    findCipher, ) where -import Crypto.Cipher.Types (AuthTag) import Network.TLS.Crypto (Hash (..), hashDigestSize)-import Network.TLS.Types (CipherID, Version (..))--import qualified Data.ByteString as B---- FIXME convert to newtype-type BulkKey = B.ByteString-type BulkIV = B.ByteString-type BulkNonce = B.ByteString-type BulkAdditionalData = B.ByteString+import Network.TLS.Imports+import Network.TLS.Types  data BulkState     = BulkStateStream BulkStream@@ -48,16 +43,6 @@     show (BulkStateAEAD _) = "BulkStateAEAD"     show BulkStateUninitialized = "BulkStateUninitialized" -newtype BulkStream = BulkStream (B.ByteString -> (B.ByteString, BulkStream))--type BulkBlock = BulkIV -> B.ByteString -> (B.ByteString, BulkIV)--type BulkAEAD =-    BulkNonce -> B.ByteString -> BulkAdditionalData -> (B.ByteString, AuthTag)--data BulkDirection = BulkEncrypt | BulkDecrypt-    deriving (Show, Eq)- bulkInit :: Bulk -> BulkDirection -> BulkKey -> BulkState bulkInit bulk direction key =     case bulkF bulk of@@ -65,63 +50,12 @@         BulkStreamF ini -> BulkStateStream (ini direction key)         BulkAeadF ini -> BulkStateAEAD (ini direction key) -data BulkFunctions-    = BulkBlockF (BulkDirection -> BulkKey -> BulkBlock)-    | BulkStreamF (BulkDirection -> BulkKey -> BulkStream)-    | BulkAeadF (BulkDirection -> BulkKey -> BulkAEAD)- hasMAC, hasRecordIV :: BulkFunctions -> Bool hasMAC (BulkBlockF _) = True hasMAC (BulkStreamF _) = True hasMAC (BulkAeadF _) = False hasRecordIV = hasMAC -data CipherKeyExchangeType-    = CipherKeyExchange_RSA-    | CipherKeyExchange_DH_Anon-    | CipherKeyExchange_DHE_RSA-    | CipherKeyExchange_ECDHE_RSA-    | CipherKeyExchange_DHE_DSA-    | CipherKeyExchange_DH_DSA-    | CipherKeyExchange_DH_RSA-    | CipherKeyExchange_ECDH_ECDSA-    | CipherKeyExchange_ECDH_RSA-    | CipherKeyExchange_ECDHE_ECDSA-    | CipherKeyExchange_TLS13 -- not expressed in cipher suite-    deriving (Show, Eq)--data Bulk = Bulk-    { bulkName :: String-    , bulkKeySize :: Int-    , bulkIVSize :: Int-    , bulkExplicitIV :: Int -- Explicit size for IV for AEAD Cipher, 0 otherwise-    , bulkAuthTagLen :: Int -- Authentication tag length in bytes for AEAD Cipher, 0 otherwise-    , bulkBlockSize :: Int-    , bulkF :: BulkFunctions-    }--instance Show Bulk where-    show bulk = bulkName bulk-instance Eq Bulk where-    b1 == b2 =-        and-            [ bulkName b1 == bulkName b2-            , bulkKeySize b1 == bulkKeySize b2-            , bulkIVSize b1 == bulkIVSize b2-            , bulkBlockSize b1 == bulkBlockSize b2-            ]---- | Cipher algorithm-data Cipher = Cipher-    { cipherID :: CipherID-    , cipherName :: String-    , cipherHash :: Hash-    , cipherBulk :: Bulk-    , cipherKeyExchange :: CipherKeyExchangeType-    , cipherMinVer :: Maybe Version-    , cipherPRFHash :: Maybe Hash-    }- cipherKeyBlockSize :: Cipher -> Int cipherKeyBlockSize cipher = 2 * (hashDigestSize (cipherHash cipher) + bulkIVSize bulk + bulkKeySize bulk)   where@@ -135,8 +69,16 @@         Nothing -> ver < TLS13         Just cVer -> cVer <= ver && (ver < TLS13 || cVer >= TLS13) -instance Show Cipher where-    show c = cipherName c+eqCipher :: CipherID -> Cipher -> Bool+eqCipher cid c = cipherID c == cid -instance Eq Cipher where-    (==) c1 c2 = cipherID c1 == cipherID c2+elemCipher :: [CipherId] -> Cipher -> Bool+elemCipher cids c = cid `elem` cids+  where+    cid = CipherId $ cipherID c++intersectCiphers :: [CipherId] -> [Cipher] -> [Cipher]+intersectCiphers peerCiphers myCiphers = filter (elemCipher peerCiphers) myCiphers++findCipher :: CipherID -> [Cipher] -> Maybe Cipher+findCipher cid = find $ eqCipher cid

@@ -252,7 +252,11 @@ getTLSUnique ctx = do     ver <- liftIO $ usingState_ ctx getVersion     if ver == TLS12-        then usingState_ ctx getFirstVerifyData+        then do+            mx <- usingState_ ctx getFirstVerifyData+            case mx of+                Nothing -> return Nothing+                Just (VerifyData verifyData) -> return $ Just verifyData         else return Nothing  -- | Getting the "tls-exporter" channel binding for TLS 1.3 (RFC9266).

@@ -27,7 +27,6 @@ ) where  import qualified Control.Exception as E-import Control.Monad (unless, void, when) import Control.Monad.State.Strict import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C8@@ -47,6 +46,7 @@ import Network.TLS.Handshake.State import Network.TLS.Handshake.State13 import Network.TLS.IO+import Network.TLS.Imports import Network.TLS.KeySchedule import Network.TLS.Parameters import Network.TLS.PostHandshake@@ -314,12 +314,18 @@         withWriteLock ctx $ do             Just resumptionSecret <- usingHState ctx getTLS13ResumptionSecret             (_, usedCipher, _, _) <- getTxRecordState ctx+            -- mMaxSize is always Just, but anyway+            let extract (EarlyDataIndication mMaxSize) =+                    maybe 0 (fromIntegral . safeNonNegative32) mMaxSize             let choice = makeCipherChoice TLS13 usedCipher                 psk = derivePSK choice resumptionSecret nonce-                maxSize = case extensionLookup EID_EarlyData exts-                    >>= extensionDecode MsgTNewSessionTicket of-                    Just (EarlyDataIndication (Just ms)) -> fromIntegral $ safeNonNegative32 ms-                    _ -> 0+                maxSize =+                    lookupAndDecode+                        EID_EarlyData+                        MsgTNewSessionTicket+                        exts+                        0+                        extract                 life7d = min life 604800 -- 7 days max             tinfo <- createTLS13TicketInfo life7d (Right add) Nothing             sdata <- getSessionData13 ctx usedCipher tinfo maxSize psk@@ -397,10 +403,13 @@             (_, usedCipher, _, _) <- getTxRecordState ctx             let choice = makeCipherChoice TLS13 usedCipher                 psk = derivePSK choice resumptionSecret nonce-                maxSize = case extensionLookup EID_EarlyData exts-                    >>= extensionDecode MsgTNewSessionTicket of-                    Just (EarlyDataIndication (Just ms)) -> fromIntegral $ safeNonNegative32 ms-                    _ -> 0+                maxSize =+                    lookupAndDecode+                        EID_EarlyData+                        MsgTNewSessionTicket+                        exts+                        0+                        (\(EarlyDataIndication mms) -> fromIntegral $ safeNonNegative32 $ fromJust mms)                 life7d = min life 604800 -- 7 days max             tinfo <- createTLS13TicketInfo life7d (Right add) Nothing             sdata <- getSessionData13 ctx usedCipher tinfo maxSize psk@@ -483,12 +492,11 @@         --         -- TLS 1.3 changes session data for every resumed session.         session <- usingState_ ctx getSession-        withWriteLock ctx $ do-            case session of-                Session Nothing -> return ()-                Session (Just sid) ->-                    -- calling even session ticket manager anyway-                    sessionInvalidate (sharedSessionManager $ ctxShared ctx) sid+        case session of+            Session Nothing -> return ()+            Session (Just sid) ->+                -- calling even session ticket manager anyway+                sessionInvalidate (sharedSessionManager $ ctxShared ctx) sid     catchException (send [(level, desc)]) (\_ -> return ())     setEOF ctx     E.throwIO (Terminated False reason err)

@@ -77,7 +77,18 @@ availableECGroups = [P256, P384, P521, X25519, X448]  supportedNamedGroups :: [Group]-supportedNamedGroups = [X25519, X448, P256, FFDHE3072, FFDHE4096, P384, FFDHE6144, FFDHE8192, P521]+supportedNamedGroups =+    [ X25519+    , X448+    , P256+    , FFDHE2048+    , FFDHE3072+    , FFDHE4096+    , P384+    , FFDHE6144+    , FFDHE8192+    , P521+    ]  -- Key-exchange signature algorithm, in close relation to ciphers -- (before TLS 1.3).

@@ -0,0 +1,194 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE PatternSynonyms #-}++module Network.TLS.Error where++import Control.Exception (Exception (..))+import Data.Typeable+import Network.TLS.Imports++----------------------------------------------------------------++-- | TLSError that might be returned through the TLS stack.+--+-- Prior to version 1.8.0, this type had an @Exception@ instance.+-- In version 1.8.0, this instance was removed, and functions in+-- this library now only throw 'TLSException'.+data TLSError+    = -- | mainly for instance of Error+      Error_Misc String+    | -- | A fatal error condition was encountered at a low level.  The+      -- elements of the tuple give (freeform text description, structured+      -- error description).+      Error_Protocol String AlertDescription+    | -- | A non-fatal error condition was encountered at a low level at a low+      -- level.  The elements of the tuple give (freeform text description,+      -- structured error description).+      Error_Protocol_Warning String AlertDescription+    | Error_Certificate String+    | -- | handshake policy failed.+      Error_HandshakePolicy String+    | Error_EOF+    | Error_Packet String+    | Error_Packet_unexpected String String+    | Error_Packet_Parsing String+    | Error_TCP_Terminate+    deriving (Eq, Show, Typeable)++----------------------------------------------------------------++-- | TLS Exceptions. Some of the data constructors indicate incorrect use of+--   the library, and the documentation for those data constructors calls+--   this out. The others wrap 'TLSError' with some kind of context to explain+--   when the exception occurred.+data TLSException+    = -- | Early termination exception with the reason and the error associated+      Terminated Bool String TLSError+    | -- | Handshake failed for the reason attached.+      HandshakeFailed TLSError+    | -- | Failure occurred while sending or receiving data after the+      --   TLS handshake succeeded.+      PostHandshake TLSError+    | -- | Lifts a 'TLSError' into 'TLSException' without provided any context+      --   around when the error happened.+      Uncontextualized TLSError+    | -- | Usage error when the connection has not been established+      --   and the user is trying to send or receive data.+      --   Indicates that this library has been used incorrectly.+      ConnectionNotEstablished+    | -- | Expected that a TLS handshake had already taken place, but no TLS+      --   handshake had occurred.+      --   Indicates that this library has been used incorrectly.+      MissingHandshake+    deriving (Show, Eq, Typeable)++instance Exception TLSException++----------------------------------------------------------------++newtype AlertLevel = AlertLevel {fromAlertLevel :: Word8} deriving (Eq)++{- FOURMOLU_DISABLE -}+pattern AlertLevel_Warning :: AlertLevel+pattern AlertLevel_Warning  = AlertLevel 1+pattern AlertLevel_Fatal   :: AlertLevel+pattern AlertLevel_Fatal    = AlertLevel 2++instance Show AlertLevel where+    show AlertLevel_Warning = "AlertLevel_Warning"+    show AlertLevel_Fatal   = "AlertLevel_Fatal"+    show (AlertLevel x)     = "AlertLevel " ++ show x+{- FOURMOLU_ENABLE -}++----------------------------------------------------------------++newtype AlertDescription = AlertDescription {fromAlertDescription :: Word8}+    deriving (Eq)++{- FOURMOLU_DISABLE -}+pattern CloseNotify                  :: AlertDescription+pattern CloseNotify                   = AlertDescription 0+pattern UnexpectedMessage            :: AlertDescription+pattern UnexpectedMessage             = AlertDescription 10+pattern BadRecordMac                 :: AlertDescription+pattern BadRecordMac                  = AlertDescription 20+pattern DecryptionFailed             :: AlertDescription+pattern DecryptionFailed              = AlertDescription 21+pattern RecordOverflow               :: AlertDescription+pattern RecordOverflow                = AlertDescription 22+pattern DecompressionFailure         :: AlertDescription+pattern DecompressionFailure          = AlertDescription 30+pattern HandshakeFailure             :: AlertDescription+pattern HandshakeFailure              = AlertDescription 40+pattern BadCertificate               :: AlertDescription+pattern BadCertificate                = AlertDescription 42+pattern UnsupportedCertificate       :: AlertDescription+pattern UnsupportedCertificate        = AlertDescription 43+pattern CertificateRevoked           :: AlertDescription+pattern CertificateRevoked            = AlertDescription 44+pattern CertificateExpired           :: AlertDescription+pattern CertificateExpired            = AlertDescription 45+pattern CertificateUnknown           :: AlertDescription+pattern CertificateUnknown            = AlertDescription 46+pattern IllegalParameter             :: AlertDescription+pattern IllegalParameter              = AlertDescription 47+pattern UnknownCa                    :: AlertDescription+pattern UnknownCa                     = AlertDescription 48+pattern AccessDenied                 :: AlertDescription+pattern AccessDenied                  = AlertDescription 49+pattern DecodeError                  :: AlertDescription+pattern DecodeError                   = AlertDescription 50+pattern DecryptError                 :: AlertDescription+pattern DecryptError                  = AlertDescription 51+pattern ExportRestriction            :: AlertDescription+pattern ExportRestriction             = AlertDescription 60+pattern ProtocolVersion              :: AlertDescription+pattern ProtocolVersion               = AlertDescription 70+pattern InsufficientSecurity         :: AlertDescription+pattern InsufficientSecurity          = AlertDescription 71+pattern InternalError                :: AlertDescription+pattern InternalError                 = AlertDescription 80+pattern InappropriateFallback        :: AlertDescription+pattern InappropriateFallback         = AlertDescription 86  -- RFC7507+pattern UserCanceled                 :: AlertDescription+pattern UserCanceled                  = AlertDescription 90+pattern NoRenegotiation              :: AlertDescription+pattern NoRenegotiation               = AlertDescription 100+pattern MissingExtension             :: AlertDescription+pattern MissingExtension              = AlertDescription 109+pattern UnsupportedExtension         :: AlertDescription+pattern UnsupportedExtension          = AlertDescription 110+pattern CertificateUnobtainable      :: AlertDescription+pattern CertificateUnobtainable       = AlertDescription 111+pattern UnrecognizedName             :: AlertDescription+pattern UnrecognizedName              = AlertDescription 112+pattern BadCertificateStatusResponse :: AlertDescription+pattern BadCertificateStatusResponse  = AlertDescription 113+pattern BadCertificateHashValue      :: AlertDescription+pattern BadCertificateHashValue       = AlertDescription 114+pattern UnknownPskIdentity           :: AlertDescription+pattern UnknownPskIdentity            = AlertDescription 115+pattern CertificateRequired          :: AlertDescription+pattern CertificateRequired           = AlertDescription 116+pattern GeneralError                 :: AlertDescription+pattern GeneralError                  = AlertDescription 117+pattern NoApplicationProtocol        :: AlertDescription+pattern NoApplicationProtocol         = AlertDescription 120 -- RFC7301++instance Show AlertDescription where+    show CloseNotify                  = "CloseNotify"+    show UnexpectedMessage            = "UnexpectedMessage"+    show BadRecordMac                 = "BadRecordMac"+    show DecryptionFailed             = "DecryptionFailed"+    show RecordOverflow               = "RecordOverflow"+    show DecompressionFailure         = "DecompressionFailure"+    show HandshakeFailure             = "HandshakeFailure"+    show BadCertificate               = "BadCertificate"+    show UnsupportedCertificate       = "UnsupportedCertificate"+    show CertificateRevoked           = "CertificateRevoked"+    show CertificateExpired           = "CertificateExpired"+    show CertificateUnknown           = "CertificateUnknown"+    show IllegalParameter             = "IllegalParameter"+    show UnknownCa                    = "UnknownCa"+    show AccessDenied                 = "AccessDenied"+    show DecodeError                  = "DecodeError"+    show DecryptError                 = "DecryptError"+    show ExportRestriction            = "ExportRestriction"+    show ProtocolVersion              = "ProtocolVersion"+    show InsufficientSecurity         = "InsufficientSecurity"+    show InternalError                = "InternalError"+    show InappropriateFallback        = "InappropriateFallback"+    show UserCanceled                 = "UserCanceled"+    show NoRenegotiation              = "NoRenegotiation"+    show MissingExtension             = "MissingExtension"+    show UnsupportedExtension         = "UnsupportedExtension"+    show CertificateUnobtainable      = "CertificateUnobtainable"+    show UnrecognizedName             = "UnrecognizedName"+    show BadCertificateStatusResponse = "BadCertificateStatusResponse"+    show BadCertificateHashValue      = "BadCertificateHashValue"+    show UnknownPskIdentity           = "UnknownPskIdentity"+    show CertificateRequired          = "CertificateRequired"+    show GeneralError                 = "GeneralError"+    show NoApplicationProtocol        = "NoApplicationProtocol"+    show (AlertDescription x)         = "AlertDescription " ++ show x+{- FOURMOLU_ENABLE -}

@@ -3,10 +3,61 @@  -- | Basic extensions are defined in RFC 6066 module Network.TLS.Extension (-    Extension (..),-    supportedExtensions,+    -- * Extension identifiers+    ExtensionID (+        ..,+        EID_ServerName,+        EID_MaxFragmentLength,+        EID_ClientCertificateUrl,+        EID_TrustedCAKeys,+        EID_TruncatedHMAC,+        EID_StatusRequest,+        EID_UserMapping,+        EID_ClientAuthz,+        EID_ServerAuthz,+        EID_CertType,+        EID_SupportedGroups,+        EID_EcPointFormats,+        EID_SRP,+        EID_SignatureAlgorithms,+        EID_SRTP,+        EID_Heartbeat,+        EID_ApplicationLayerProtocolNegotiation,+        EID_StatusRequestv2,+        EID_SignedCertificateTimestamp,+        EID_ClientCertificateType,+        EID_ServerCertificateType,+        EID_Padding,+        EID_EncryptThenMAC,+        EID_ExtendedMainSecret,+        EID_SessionTicket,+        EID_PreSharedKey,+        EID_EarlyData,+        EID_SupportedVersions,+        EID_Cookie,+        EID_PskKeyExchangeModes,+        EID_CertificateAuthorities,+        EID_OidFilters,+        EID_PostHandshakeAuth,+        EID_SignatureAlgorithmsCert,+        EID_KeyShare,+        EID_QuicTransportParameters,+        EID_SecureRenegotiation+    ),     definedExtensions,-    -- all implemented extensions+    supportedExtensions,++    -- * Extension raw+    ExtensionRaw (..),+    toExtensionRaw,+    extensionLookup,+    lookupAndDecode,+    lookupAndDecodeAndDo,++    -- * Class+    Extension (..),++    -- * Extensions     ServerNameType (..),     ServerName (..),     MaxFragmentLength (..),@@ -46,13 +97,14 @@     CertificateAuthorities (..), ) where +import qualified Control.Exception as E import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC+import Data.X509 (DistinguishedName)  import Network.TLS.Crypto.Types-import Network.TLS.Struct-import Network.TLS.Types (HostName, Ticket)-+import Network.TLS.Error+import Network.TLS.HashAndSignature import Network.TLS.Imports import Network.TLS.Packet (     getBinaryVersion,@@ -62,8 +114,133 @@     putDNames,     putSignatureHashAlgorithm,  )+import Network.TLS.Types (HostName, Ticket, Version) import Network.TLS.Wire +----------------------------------------------------------------+-- Extension identifiers++-- | Identifier of a TLS extension.+--   <http://www.iana.org/assignments/tls-extensiontype-values/tls-extensiontype-values.txt>+newtype ExtensionID = ExtensionID {fromExtensionID :: Word16} deriving (Eq)++{- FOURMOLU_DISABLE -}+pattern EID_ServerName                          :: ExtensionID -- RFC6066+pattern EID_ServerName                           = ExtensionID 0x0+pattern EID_MaxFragmentLength                   :: ExtensionID -- RFC6066+pattern EID_MaxFragmentLength                    = ExtensionID 0x1+pattern EID_ClientCertificateUrl                :: ExtensionID -- RFC6066+pattern EID_ClientCertificateUrl                 = ExtensionID 0x2+pattern EID_TrustedCAKeys                       :: ExtensionID -- RFC6066+pattern EID_TrustedCAKeys                        = ExtensionID 0x3+pattern EID_TruncatedHMAC                       :: ExtensionID -- RFC6066+pattern EID_TruncatedHMAC                        = ExtensionID 0x4+pattern EID_StatusRequest                       :: ExtensionID -- RFC6066+pattern EID_StatusRequest                        = ExtensionID 0x5+pattern EID_UserMapping                         :: ExtensionID -- RFC4681+pattern EID_UserMapping                          = ExtensionID 0x6+pattern EID_ClientAuthz                         :: ExtensionID -- RFC5878+pattern EID_ClientAuthz                          = ExtensionID 0x7+pattern EID_ServerAuthz                         :: ExtensionID -- RFC5878+pattern EID_ServerAuthz                          = ExtensionID 0x8+pattern EID_CertType                            :: ExtensionID -- RFC6091+pattern EID_CertType                             = ExtensionID 0x9+pattern EID_SupportedGroups                     :: ExtensionID -- RFC8422,8446+pattern EID_SupportedGroups                      = ExtensionID 0xa+pattern EID_EcPointFormats                      :: ExtensionID -- RFC4492+pattern EID_EcPointFormats                       = ExtensionID 0xb+pattern EID_SRP                                 :: ExtensionID -- RFC5054+pattern EID_SRP                                  = ExtensionID 0xc+pattern EID_SignatureAlgorithms                 :: ExtensionID -- RFC5246,8446+pattern EID_SignatureAlgorithms                  = ExtensionID 0xd+pattern EID_SRTP                                :: ExtensionID -- RFC5764+pattern EID_SRTP                                 = ExtensionID 0xe+pattern EID_Heartbeat                           :: ExtensionID -- RFC6520+pattern EID_Heartbeat                            = ExtensionID 0xf+pattern EID_ApplicationLayerProtocolNegotiation :: ExtensionID -- RFC7301+pattern EID_ApplicationLayerProtocolNegotiation  = ExtensionID 0x10+pattern EID_StatusRequestv2                     :: ExtensionID -- RFC6961+pattern EID_StatusRequestv2                      = ExtensionID 0x11+pattern EID_SignedCertificateTimestamp          :: ExtensionID -- RFC6962+pattern EID_SignedCertificateTimestamp           = ExtensionID 0x12+pattern EID_ClientCertificateType               :: ExtensionID -- RFC7250+pattern EID_ClientCertificateType                = ExtensionID 0x13+pattern EID_ServerCertificateType               :: ExtensionID -- RFC7250+pattern EID_ServerCertificateType                = ExtensionID 0x14+pattern EID_Padding                             :: ExtensionID -- RFC5246+pattern EID_Padding                              = ExtensionID 0x15+pattern EID_EncryptThenMAC                      :: ExtensionID -- RFC7366+pattern EID_EncryptThenMAC                       = ExtensionID 0x16+pattern EID_ExtendedMainSecret                  :: ExtensionID -- REF7627+pattern EID_ExtendedMainSecret                   = ExtensionID 0x17+pattern EID_SessionTicket                       :: ExtensionID -- RFC4507+pattern EID_SessionTicket                        = ExtensionID 0x23+pattern EID_PreSharedKey                        :: ExtensionID -- RFC8446+pattern EID_PreSharedKey                         = ExtensionID 0x29+pattern EID_EarlyData                           :: ExtensionID -- RFC8446+pattern EID_EarlyData                            = ExtensionID 0x2a+pattern EID_SupportedVersions                   :: ExtensionID -- RFC8446+pattern EID_SupportedVersions                    = ExtensionID 0x2b+pattern EID_Cookie                              :: ExtensionID -- RFC8446+pattern EID_Cookie                               = ExtensionID 0x2c+pattern EID_PskKeyExchangeModes                 :: ExtensionID -- RFC8446+pattern EID_PskKeyExchangeModes                  = ExtensionID 0x2d+pattern EID_CertificateAuthorities              :: ExtensionID -- RFC8446+pattern EID_CertificateAuthorities               = ExtensionID 0x2f+pattern EID_OidFilters                          :: ExtensionID -- RFC8446+pattern EID_OidFilters                           = ExtensionID 0x30+pattern EID_PostHandshakeAuth                   :: ExtensionID -- RFC8446+pattern EID_PostHandshakeAuth                    = ExtensionID 0x31+pattern EID_SignatureAlgorithmsCert             :: ExtensionID -- RFC8446+pattern EID_SignatureAlgorithmsCert              = ExtensionID 0x32+pattern EID_KeyShare                            :: ExtensionID -- RFC8446+pattern EID_KeyShare                             = ExtensionID 0x33+pattern EID_QuicTransportParameters             :: ExtensionID -- RFC9001+pattern EID_QuicTransportParameters              = ExtensionID 0x39+pattern EID_SecureRenegotiation                 :: ExtensionID -- RFC5746+pattern EID_SecureRenegotiation                  = ExtensionID 0xff01++instance Show ExtensionID where+    show EID_ServerName              = "ServerName"+    show EID_MaxFragmentLength       = "MaxFragmentLength"+    show EID_ClientCertificateUrl    = "ClientCertificateUrl"+    show EID_TrustedCAKeys           = "TrustedCAKeys"+    show EID_TruncatedHMAC           = "TruncatedHMAC"+    show EID_StatusRequest           = "StatusRequest"+    show EID_UserMapping             = "UserMapping"+    show EID_ClientAuthz             = "ClientAuthz"+    show EID_ServerAuthz             = "ServerAuthz"+    show EID_CertType                = "CertType"+    show EID_SupportedGroups         = "SupportedGroups"+    show EID_EcPointFormats          = "EcPointFormats"+    show EID_SRP                     = "SRP"+    show EID_SignatureAlgorithms     = "SignatureAlgorithms"+    show EID_SRTP                    = "SRTP"+    show EID_Heartbeat               = "Heartbeat"+    show EID_ApplicationLayerProtocolNegotiation = "ApplicationLayerProtocolNegotiation"+    show EID_StatusRequestv2         = "StatusRequestv2"+    show EID_SignedCertificateTimestamp = "SignedCertificateTimestamp"+    show EID_ClientCertificateType   = "ClientCertificateType"+    show EID_ServerCertificateType   = "ServerCertificateType"+    show EID_Padding                 = "Padding"+    show EID_EncryptThenMAC          = "EncryptThenMAC"+    show EID_ExtendedMainSecret      = "ExtendedMainSecret"+    show EID_SessionTicket           = "SessionTicket"+    show EID_PreSharedKey            = "PreSharedKey"+    show EID_EarlyData               = "EarlyData"+    show EID_SupportedVersions       = "SupportedVersions"+    show EID_Cookie                  = "Cookie"+    show EID_PskKeyExchangeModes     = "PskKeyExchangeModes"+    show EID_CertificateAuthorities  = "CertificateAuthorities"+    show EID_OidFilters              = "OidFilters"+    show EID_PostHandshakeAuth       = "PostHandshakeAuth"+    show EID_SignatureAlgorithmsCert = "SignatureAlgorithmsCert"+    show EID_KeyShare                = "KeyShare"+    show EID_QuicTransportParameters = "QuicTransportParameters"+    show EID_SecureRenegotiation     = "SecureRenegotiation"+    show (ExtensionID x)         = "ExtensionID " ++ show x+{- FOURMOLU_ENABLE -}+ ------------------------------------------------------------  definedExtensions :: [ExtensionID]@@ -98,37 +275,127 @@     , EID_SupportedVersions     , EID_Cookie     , EID_PskKeyExchangeModes-    , EID_KeyShare-    , EID_SignatureAlgorithmsCert     , EID_CertificateAuthorities-    , EID_SecureRenegotiation+    , EID_OidFilters+    , EID_PostHandshakeAuth+    , EID_SignatureAlgorithmsCert+    , EID_KeyShare     , EID_QuicTransportParameters+    , EID_SecureRenegotiation     ]  -- | all supported extensions by the implementation+{- FOURMOLU_DISABLE -} supportedExtensions :: [ExtensionID] supportedExtensions =-    [ EID_ServerName-    , EID_MaxFragmentLength-    , EID_ApplicationLayerProtocolNegotiation-    , EID_ExtendedMainSecret-    , EID_SecureRenegotiation-    , EID_SupportedGroups-    , EID_EcPointFormats-    , EID_SignatureAlgorithms-    , EID_SignatureAlgorithmsCert-    , EID_KeyShare-    , EID_PreSharedKey-    , EID_EarlyData-    , EID_SupportedVersions-    , EID_Cookie-    , EID_PskKeyExchangeModes-    , EID_CertificateAuthorities-    , EID_QuicTransportParameters+    [ EID_ServerName                          -- 0x00+    , EID_MaxFragmentLength                   -- 0x01+    , EID_SupportedGroups                     -- 0x0a+    , EID_EcPointFormats                      -- 0x0b+    , EID_SignatureAlgorithms                 -- 0x0d+    , EID_Heartbeat                           -- 0x0f+    , EID_ApplicationLayerProtocolNegotiation -- 0x10+    , EID_ExtendedMainSecret                  -- 0x17+    , EID_SessionTicket                       -- 0x23+    , EID_PreSharedKey                        -- 0x29+    , EID_EarlyData                           -- 0x2a+    , EID_SupportedVersions                   -- 0x2b+    , EID_Cookie                              -- 0x2c+    , EID_PskKeyExchangeModes                 -- 0x2d+    , EID_CertificateAuthorities              -- 0x2f+    , EID_PostHandshakeAuth                   -- 0x31+    , EID_SignatureAlgorithmsCert             -- 0x32+    , EID_KeyShare                            -- 0x33+    , EID_QuicTransportParameters             -- 0x39+    , EID_SecureRenegotiation                 -- 0xff01     ]+{- FOURMOLU_ENABLE -} +----------------------------------------------------------------++-- | The raw content of a TLS extension.+data ExtensionRaw = ExtensionRaw ExtensionID ByteString+    deriving (Eq)++instance Show ExtensionRaw where+    show (ExtensionRaw eid@EID_ServerName bs) = showExtensionRaw eid bs decodeServerName+    show (ExtensionRaw eid@EID_MaxFragmentLength bs) = showExtensionRaw eid bs decodeMaxFragmentLength+    show (ExtensionRaw eid@EID_SupportedGroups bs) = showExtensionRaw eid bs decodeSupportedGroups+    show (ExtensionRaw eid@EID_EcPointFormats bs) = showExtensionRaw eid bs decodeEcPointFormatsSupported+    show (ExtensionRaw eid@EID_SignatureAlgorithms bs) = showExtensionRaw eid bs decodeSignatureAlgorithms+    show (ExtensionRaw eid@EID_Heartbeat bs) = showExtensionRaw eid bs decodeHeartBeat+    show (ExtensionRaw eid@EID_ApplicationLayerProtocolNegotiation bs) = showExtensionRaw eid bs decodeApplicationLayerProtocolNegotiation+    show (ExtensionRaw eid@EID_ExtendedMainSecret _) = show eid+    show (ExtensionRaw eid@EID_SessionTicket bs) = showExtensionRaw eid bs decodeSessionTicket+    show (ExtensionRaw eid@EID_PreSharedKey bs) = show eid ++ " " ++ showBytesHex bs+    show (ExtensionRaw eid@EID_EarlyData _) = show eid+    show (ExtensionRaw eid@EID_SupportedVersions bs) = show eid ++ " " ++ showBytesHex bs+    show (ExtensionRaw eid@EID_Cookie bs) = show eid ++ " " ++ showBytesHex bs+    show (ExtensionRaw eid@EID_PskKeyExchangeModes bs) = showExtensionRaw eid bs decodePskKeyExchangeModes+    show (ExtensionRaw eid@EID_CertificateAuthorities bs) = showExtensionRaw eid bs decodeCertificateAuthorities+    show (ExtensionRaw eid@EID_PostHandshakeAuth _) = show eid+    show (ExtensionRaw eid@EID_SignatureAlgorithmsCert bs) = showExtensionRaw eid bs decodeSignatureAlgorithmsCert+    show (ExtensionRaw eid@EID_KeyShare bs) = show eid ++ " " ++ showBytesHex bs+    show (ExtensionRaw eid@EID_SecureRenegotiation bs) = show eid ++ " " ++ showBytesHex bs+    show (ExtensionRaw eid bs) = "ExtensionRaw " ++ show eid ++ " " ++ showBytesHex bs++showExtensionRaw+    :: Show a => ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String+showExtensionRaw eid bs decode = case decode bs of+    Nothing -> show eid ++ " broken"+    Just x -> show x++toExtensionRaw :: Extension e => e -> ExtensionRaw+toExtensionRaw ext = ExtensionRaw (extensionID ext) (extensionEncode ext)++extensionLookup :: ExtensionID -> [ExtensionRaw] -> Maybe ByteString+extensionLookup toFind exts = extract <$> find idEq exts+  where+    extract (ExtensionRaw _ content) = content+    idEq (ExtensionRaw eid _) = eid == toFind++lookupAndDecode+    :: Extension e+    => ExtensionID+    -> MessageType+    -> [ExtensionRaw]+    -> a+    -> (e -> a)+    -> a+lookupAndDecode eid msgtyp exts defval conv = case extensionLookup eid exts of+    Nothing -> defval+    Just bs -> case extensionDecode msgtyp bs of+        Nothing ->+            E.throw $+                Uncontextualized $+                    Error_Protocol ("Illegal " ++ show eid) DecodeError+        Just val -> conv val++lookupAndDecodeAndDo+    :: Extension a+    => ExtensionID+    -> MessageType+    -> [ExtensionRaw]+    -> IO b+    -> (a -> IO b)+    -> IO b+lookupAndDecodeAndDo eid msgtyp exts defAction action = case extensionLookup eid exts of+    Nothing -> defAction+    Just bs -> case extensionDecode msgtyp bs of+        Nothing ->+            E.throwIO $+                Uncontextualized $+                    Error_Protocol ("Illegal " ++ show eid) DecodeError+        Just val -> action val+ ------------------------------------------------------------ +-- | Extension class to transform bytes to and from a high level Extension type.+class Extension a where+    extensionID :: a -> ExtensionID+    extensionDecode :: MessageType -> ByteString -> Maybe a+    extensionEncode :: a -> ByteString+ data MessageType     = MsgTClientHello     | MsgTServerHello@@ -138,12 +405,6 @@     | MsgTCertificateRequest     deriving (Eq, Show) --- | Extension class to transform bytes to and from a high level Extension type.-class Extension a where-    extensionID :: a -> ExtensionID-    extensionDecode :: MessageType -> ByteString -> Maybe a-    extensionEncode :: a -> ByteString- ------------------------------------------------------------  -- | Server Name extension including the name type and the associated name.@@ -154,10 +415,18 @@ data ServerNameType     = ServerNameHostName HostName     | ServerNameOther (Word8, ByteString)-    deriving (Show, Eq)+    deriving (Eq) +instance Show ServerNameType where+    show (ServerNameHostName host) = "\"" ++ host ++ "\""+    show (ServerNameOther (w, _)) = "(" ++ show w ++ ", )"+ instance Extension ServerName where     extensionID _ = EID_ServerName++    -- dirty hack for servers+    extensionEncode (ServerName []) = ""+    -- for clients     extensionEncode (ServerName l) = runPut $ putOpaque16 (runPut $ mapM_ encodeNameType l)       where         encodeNameType (ServerNameHostName hn) = putWord8 0 >> putOpaque16 (BC.pack hn) -- FIXME: should be puny code conversion@@ -168,10 +437,12 @@     extensionDecode _ = error "extensionDecode: ServerName"  decodeServerName :: ByteString -> Maybe ServerName-decodeServerName = runGetMaybe $ do-    len <- fromIntegral <$> getWord16-    ServerName <$> getList len getServerName+decodeServerName "" = Just $ ServerName [] -- dirty hack for servers+decodeServerName bs = runGetMaybe decode bs   where+    decode = do+        len <- fromIntegral <$> getWord16+        ServerName <$> getList len getServerName     getServerName = do         ty <- getWord8         snameParsed <- getOpaque16@@ -228,64 +499,6 @@  ------------------------------------------------------------ --- | Secure Renegotiation-data SecureRenegotiation = SecureRenegotiation ByteString ByteString-    deriving (Show, Eq)--instance Extension SecureRenegotiation where-    extensionID _ = EID_SecureRenegotiation-    extensionEncode (SecureRenegotiation cvd svd) =-        runPut $ putOpaque8 (cvd `B.append` svd)-    extensionDecode msgtype = runGetMaybe $ do-        opaque <- getOpaque8-        case msgtype of-            MsgTServerHello ->-                let (cvd, svd) = B.splitAt (B.length opaque `div` 2) opaque-                 in return $ SecureRenegotiation cvd svd-            MsgTClientHello -> return $ SecureRenegotiation opaque ""-            _ -> error "extensionDecode: SecureRenegotiation"------------------------------------------------------------------ | Application Layer Protocol Negotiation (ALPN)-newtype ApplicationLayerProtocolNegotiation-    = ApplicationLayerProtocolNegotiation [ByteString]-    deriving (Show, Eq)--instance Extension ApplicationLayerProtocolNegotiation where-    extensionID _ = EID_ApplicationLayerProtocolNegotiation-    extensionEncode (ApplicationLayerProtocolNegotiation bytes) =-        runPut $ putOpaque16 $ runPut $ mapM_ putOpaque8 bytes-    extensionDecode MsgTClientHello = decodeApplicationLayerProtocolNegotiation-    extensionDecode MsgTServerHello = decodeApplicationLayerProtocolNegotiation-    extensionDecode MsgTEncryptedExtensions = decodeApplicationLayerProtocolNegotiation-    extensionDecode _ = error "extensionDecode: ApplicationLayerProtocolNegotiation"--decodeApplicationLayerProtocolNegotiation-    :: ByteString -> Maybe ApplicationLayerProtocolNegotiation-decodeApplicationLayerProtocolNegotiation = runGetMaybe $ do-    len <- getWord16-    ApplicationLayerProtocolNegotiation <$> getList (fromIntegral len) getALPN-  where-    getALPN = do-        alpnParsed <- getOpaque8-        let alpn = B.copy alpnParsed-        return (B.length alpn + 1, alpn)------------------------------------------------------------------ | Extended Main Secret-data ExtendedMainSecret = ExtendedMainSecret deriving (Show, Eq)--instance Extension ExtendedMainSecret where-    extensionID _ = EID_ExtendedMainSecret-    extensionEncode ExtendedMainSecret = B.empty-    extensionDecode MsgTClientHello _ = Just ExtendedMainSecret-    extensionDecode MsgTServerHello _ = Just ExtendedMainSecret-    extensionDecode _ _ = error "extensionDecode: ExtendedMainSecret"--------------------------------------------------------------- newtype SupportedGroups = SupportedGroups [Group] deriving (Show, Eq)  -- on decode, filter all unknown curves@@ -337,17 +550,28 @@  ------------------------------------------------------------ -newtype SessionTicket = SessionTicket Ticket+newtype SignatureAlgorithms = SignatureAlgorithms [HashAndSignatureAlgorithm]     deriving (Show, Eq) --- https://datatracker.ietf.org/doc/html/rfc5077#appendix-A-instance Extension SessionTicket where-    extensionID _ = EID_SessionTicket-    extensionEncode (SessionTicket ticket) = runPut $ putBytes ticket-    extensionDecode MsgTClientHello = runGetMaybe $ SessionTicket <$> (remaining >>= getBytes)-    extensionDecode MsgTServerHello = runGetMaybe $ SessionTicket <$> (remaining >>= getBytes)-    extensionDecode _ = error "extensionDecode: SessionTicket"+instance Extension SignatureAlgorithms where+    extensionID _ = EID_SignatureAlgorithms+    extensionEncode (SignatureAlgorithms algs) =+        runPut $+            putWord16 (fromIntegral (length algs * 2))+                >> mapM_ putSignatureHashAlgorithm algs+    extensionDecode MsgTClientHello = decodeSignatureAlgorithms+    extensionDecode MsgTCertificateRequest = decodeSignatureAlgorithms+    extensionDecode _ = error "extensionDecode: SignatureAlgorithms" +decodeSignatureAlgorithms :: ByteString -> Maybe SignatureAlgorithms+decodeSignatureAlgorithms = runGetMaybe $ do+    len <- getWord16+    sas <-+        getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))+    leftoverLen <- remaining+    when (leftoverLen /= 0) $ fail "decodeSignatureAlgorithms: broken length"+    return $ SignatureAlgorithms sas+ ------------------------------------------------------------  newtype HeartBeat = HeartBeat HeartBeatMode deriving (Show, Eq)@@ -379,165 +603,58 @@  ------------------------------------------------------------ -newtype SignatureAlgorithms = SignatureAlgorithms [HashAndSignatureAlgorithm]-    deriving (Show, Eq)--instance Extension SignatureAlgorithms where-    extensionID _ = EID_SignatureAlgorithms-    extensionEncode (SignatureAlgorithms algs) =-        runPut $-            putWord16 (fromIntegral (length algs * 2))-                >> mapM_ putSignatureHashAlgorithm algs-    extensionDecode MsgTClientHello = decodeSignatureAlgorithms-    extensionDecode MsgTCertificateRequest = decodeSignatureAlgorithms-    extensionDecode _ = error "extensionDecode: SignatureAlgorithms"--decodeSignatureAlgorithms :: ByteString -> Maybe SignatureAlgorithms-decodeSignatureAlgorithms = runGetMaybe $ do-    len <- getWord16-    sas <--        getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))-    leftoverLen <- remaining-    when (leftoverLen /= 0) $ fail "decodeSignatureAlgorithms: broken length"-    return $ SignatureAlgorithms sas----------------------------------------------------------------data PostHandshakeAuth = PostHandshakeAuth deriving (Show, Eq)--instance Extension PostHandshakeAuth where-    extensionID _ = EID_PostHandshakeAuth-    extensionEncode _ = B.empty-    extensionDecode MsgTClientHello = runGetMaybe $ return PostHandshakeAuth-    extensionDecode _ = error "extensionDecode: PostHandshakeAuth"----------------------------------------------------------------newtype SignatureAlgorithmsCert = SignatureAlgorithmsCert [HashAndSignatureAlgorithm]+-- | Application Layer Protocol Negotiation (ALPN)+newtype ApplicationLayerProtocolNegotiation+    = ApplicationLayerProtocolNegotiation [ByteString]     deriving (Show, Eq) -instance Extension SignatureAlgorithmsCert where-    extensionID _ = EID_SignatureAlgorithmsCert-    extensionEncode (SignatureAlgorithmsCert algs) =-        runPut $-            putWord16 (fromIntegral (length algs * 2))-                >> mapM_ putSignatureHashAlgorithm algs-    extensionDecode MsgTClientHello = decodeSignatureAlgorithmsCert-    extensionDecode MsgTCertificateRequest = decodeSignatureAlgorithmsCert-    extensionDecode _ = error "extensionDecode: SignatureAlgorithmsCert"+instance Extension ApplicationLayerProtocolNegotiation where+    extensionID _ = EID_ApplicationLayerProtocolNegotiation+    extensionEncode (ApplicationLayerProtocolNegotiation bytes) =+        runPut $ putOpaque16 $ runPut $ mapM_ putOpaque8 bytes+    extensionDecode MsgTClientHello = decodeApplicationLayerProtocolNegotiation+    extensionDecode MsgTServerHello = decodeApplicationLayerProtocolNegotiation+    extensionDecode MsgTEncryptedExtensions = decodeApplicationLayerProtocolNegotiation+    extensionDecode _ = error "extensionDecode: ApplicationLayerProtocolNegotiation" -decodeSignatureAlgorithmsCert :: ByteString -> Maybe SignatureAlgorithmsCert-decodeSignatureAlgorithmsCert = runGetMaybe $ do+decodeApplicationLayerProtocolNegotiation+    :: ByteString -> Maybe ApplicationLayerProtocolNegotiation+decodeApplicationLayerProtocolNegotiation = runGetMaybe $ do     len <- getWord16-    SignatureAlgorithmsCert-        <$> getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))+    ApplicationLayerProtocolNegotiation <$> getList (fromIntegral len) getALPN+  where+    getALPN = do+        alpnParsed <- getOpaque8+        let alpn = B.copy alpnParsed+        return (B.length alpn + 1, alpn)  ------------------------------------------------------------ -data SupportedVersions-    = SupportedVersionsClientHello [Version]-    | SupportedVersionsServerHello Version-    deriving (Show, Eq)+-- | Extended Main Secret+data ExtendedMainSecret = ExtendedMainSecret deriving (Show, Eq) -instance Extension SupportedVersions where-    extensionID _ = EID_SupportedVersions-    extensionEncode (SupportedVersionsClientHello vers) = runPut $ do-        putWord8 (fromIntegral (length vers * 2))-        mapM_ putBinaryVersion vers-    extensionEncode (SupportedVersionsServerHello ver) =-        runPut $-            putBinaryVersion ver-    extensionDecode MsgTClientHello = runGetMaybe $ do-        len <- fromIntegral <$> getWord8-        SupportedVersionsClientHello <$> getList len getVer-      where-        getVer = do-            ver <- getBinaryVersion-            return (2, ver)-    extensionDecode MsgTServerHello =-        runGetMaybe (SupportedVersionsServerHello <$> getBinaryVersion)-    extensionDecode _ = error "extensionDecode: SupportedVersionsServerHello"+instance Extension ExtendedMainSecret where+    extensionID _ = EID_ExtendedMainSecret+    extensionEncode ExtendedMainSecret = B.empty+    extensionDecode MsgTClientHello "" = Just ExtendedMainSecret+    extensionDecode MsgTServerHello "" = Just ExtendedMainSecret+    extensionDecode _ _ = error "extensionDecode: ExtendedMainSecret"  ------------------------------------------------------------ -data KeyShareEntry = KeyShareEntry-    { keyShareEntryGroup :: Group-    , keyShareEntryKeyExchange :: ByteString-    }-    deriving (Show, Eq)--getKeyShareEntry :: Get (Int, Maybe KeyShareEntry)-getKeyShareEntry = do-    grp <- Group <$> getWord16-    l <- fromIntegral <$> getWord16-    key <- getBytes l-    let len = l + 4-    return (len, Just $ KeyShareEntry grp key)--putKeyShareEntry :: KeyShareEntry -> Put-putKeyShareEntry (KeyShareEntry (Group grp) key) = do-    putWord16 grp-    putWord16 $ fromIntegral $ B.length key-    putBytes key--data KeyShare-    = KeyShareClientHello [KeyShareEntry]-    | KeyShareServerHello KeyShareEntry-    | KeyShareHRR Group+newtype SessionTicket = SessionTicket Ticket     deriving (Show, Eq) -instance Extension KeyShare where-    extensionID _ = EID_KeyShare-    extensionEncode (KeyShareClientHello kses) = runPut $ do-        let len = sum [B.length key + 4 | KeyShareEntry _ key <- kses]-        putWord16 $ fromIntegral len-        mapM_ putKeyShareEntry kses-    extensionEncode (KeyShareServerHello kse) = runPut $ putKeyShareEntry kse-    extensionEncode (KeyShareHRR (Group grp)) = runPut $ putWord16 grp-    extensionDecode MsgTServerHello = runGetMaybe $ do-        (_, ment) <- getKeyShareEntry-        case ment of-            Nothing -> fail "decoding KeyShare for ServerHello"-            Just ent -> return $ KeyShareServerHello ent-    extensionDecode MsgTClientHello = runGetMaybe $ do-        len <- fromIntegral <$> getWord16-        --      len == 0 allows for HRR-        grps <- getList len getKeyShareEntry-        return $ KeyShareClientHello $ catMaybes grps-    extensionDecode MsgTHelloRetryRequest =-        runGetMaybe $-            KeyShareHRR . Group <$> getWord16-    extensionDecode _ = error "extensionDecode: KeyShare"----------------------------------------------------------------newtype PskKexMode = PskKexMode {fromPskKexMode :: Word8} deriving (Eq)--{- FOURMOLU_DISABLE -}-pattern PSK_KE     :: PskKexMode-pattern PSK_KE      = PskKexMode 0-pattern PSK_DHE_KE :: PskKexMode-pattern PSK_DHE_KE  = PskKexMode 1--instance Show PskKexMode where-    show PSK_KE     = "PSK_KE"-    show PSK_DHE_KE = "PSK_DHE_KE"-    show (PskKexMode x) = "PskKexMode " ++ show x-{- FOURMOLU_ENABLE -}--newtype PskKeyExchangeModes = PskKeyExchangeModes [PskKexMode]-    deriving (Eq, Show)+-- https://datatracker.ietf.org/doc/html/rfc5077#appendix-A+instance Extension SessionTicket where+    extensionID _ = EID_SessionTicket+    extensionEncode (SessionTicket ticket) = runPut $ putBytes ticket+    extensionDecode MsgTClientHello = decodeSessionTicket+    extensionDecode MsgTServerHello = decodeSessionTicket+    extensionDecode _ = error "extensionDecode: SessionTicket" -instance Extension PskKeyExchangeModes where-    extensionID _ = EID_PskKeyExchangeModes-    extensionEncode (PskKeyExchangeModes pkms) =-        runPut $-            putWords8 $-                map fromPskKexMode pkms-    extensionDecode MsgTClientHello =-        runGetMaybe $-            PskKeyExchangeModes . map PskKexMode <$> getWords8-    extensionDecode _ = error "extensionDecode: PskKeyExchangeModes"+decodeSessionTicket :: ByteString -> Maybe SessionTicket+decodeSessionTicket = runGetMaybe $ SessionTicket <$> (remaining >>= getBytes)  ------------------------------------------------------------ @@ -602,6 +719,32 @@  ------------------------------------------------------------ +data SupportedVersions+    = SupportedVersionsClientHello [Version]+    | SupportedVersionsServerHello Version+    deriving (Show, Eq)++instance Extension SupportedVersions where+    extensionID _ = EID_SupportedVersions+    extensionEncode (SupportedVersionsClientHello vers) = runPut $ do+        putWord8 (fromIntegral (length vers * 2))+        mapM_ putBinaryVersion vers+    extensionEncode (SupportedVersionsServerHello ver) =+        runPut $+            putBinaryVersion ver+    extensionDecode MsgTClientHello = runGetMaybe $ do+        len <- fromIntegral <$> getWord8+        SupportedVersionsClientHello <$> getList len getVer+      where+        getVer = do+            ver <- getBinaryVersion+            return (2, ver)+    extensionDecode MsgTServerHello =+        runGetMaybe (SupportedVersionsServerHello <$> getBinaryVersion)+    extensionDecode _ = error "extensionDecode: SupportedVersionsServerHello"++------------------------------------------------------------+ newtype Cookie = Cookie ByteString deriving (Eq, Show)  instance Extension Cookie where@@ -612,6 +755,39 @@  ------------------------------------------------------------ +newtype PskKexMode = PskKexMode {fromPskKexMode :: Word8} deriving (Eq)++{- FOURMOLU_DISABLE -}+pattern PSK_KE     :: PskKexMode+pattern PSK_KE      = PskKexMode 0+pattern PSK_DHE_KE :: PskKexMode+pattern PSK_DHE_KE  = PskKexMode 1++instance Show PskKexMode where+    show PSK_KE     = "PSK_KE"+    show PSK_DHE_KE = "PSK_DHE_KE"+    show (PskKexMode x) = "PskKexMode " ++ show x+{- FOURMOLU_ENABLE -}++newtype PskKeyExchangeModes = PskKeyExchangeModes [PskKexMode]+    deriving (Eq, Show)++instance Extension PskKeyExchangeModes where+    extensionID _ = EID_PskKeyExchangeModes+    extensionEncode (PskKeyExchangeModes pkms) =+        runPut $+            putWords8 $+                map fromPskKexMode pkms+    extensionDecode MsgTClientHello = decodePskKeyExchangeModes+    extensionDecode _ = error "extensionDecode: PskKeyExchangeModes"++decodePskKeyExchangeModes :: ByteString -> Maybe PskKeyExchangeModes+decodePskKeyExchangeModes =+    runGetMaybe $+        PskKeyExchangeModes . map PskKexMode <$> getWords8++------------------------------------------------------------+ newtype CertificateAuthorities = CertificateAuthorities [DistinguishedName]     deriving (Eq, Show) @@ -620,8 +796,111 @@     extensionEncode (CertificateAuthorities names) =         runPut $             putDNames names-    extensionDecode MsgTClientHello =-        runGetMaybe (CertificateAuthorities <$> getDNames)-    extensionDecode MsgTCertificateRequest =-        runGetMaybe (CertificateAuthorities <$> getDNames)+    extensionDecode MsgTClientHello = decodeCertificateAuthorities+    extensionDecode MsgTCertificateRequest = decodeCertificateAuthorities     extensionDecode _ = error "extensionDecode: CertificateAuthorities"++decodeCertificateAuthorities :: ByteString -> Maybe CertificateAuthorities+decodeCertificateAuthorities =+    runGetMaybe (CertificateAuthorities <$> getDNames)++------------------------------------------------------------++data PostHandshakeAuth = PostHandshakeAuth deriving (Show, Eq)++instance Extension PostHandshakeAuth where+    extensionID _ = EID_PostHandshakeAuth+    extensionEncode _ = B.empty+    extensionDecode MsgTClientHello = runGetMaybe $ return PostHandshakeAuth+    extensionDecode _ = error "extensionDecode: PostHandshakeAuth"++------------------------------------------------------------++newtype SignatureAlgorithmsCert = SignatureAlgorithmsCert [HashAndSignatureAlgorithm]+    deriving (Show, Eq)++instance Extension SignatureAlgorithmsCert where+    extensionID _ = EID_SignatureAlgorithmsCert+    extensionEncode (SignatureAlgorithmsCert algs) =+        runPut $+            putWord16 (fromIntegral (length algs * 2))+                >> mapM_ putSignatureHashAlgorithm algs+    extensionDecode MsgTClientHello = decodeSignatureAlgorithmsCert+    extensionDecode MsgTCertificateRequest = decodeSignatureAlgorithmsCert+    extensionDecode _ = error "extensionDecode: SignatureAlgorithmsCert"++decodeSignatureAlgorithmsCert :: ByteString -> Maybe SignatureAlgorithmsCert+decodeSignatureAlgorithmsCert = runGetMaybe $ do+    len <- getWord16+    SignatureAlgorithmsCert+        <$> getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))++------------------------------------------------------------++data KeyShareEntry = KeyShareEntry+    { keyShareEntryGroup :: Group+    , keyShareEntryKeyExchange :: ByteString+    }+    deriving (Show, Eq)++getKeyShareEntry :: Get (Int, Maybe KeyShareEntry)+getKeyShareEntry = do+    grp <- Group <$> getWord16+    l <- fromIntegral <$> getWord16+    key <- getBytes l+    let len = l + 4+    return (len, Just $ KeyShareEntry grp key)++putKeyShareEntry :: KeyShareEntry -> Put+putKeyShareEntry (KeyShareEntry (Group grp) key) = do+    putWord16 grp+    putWord16 $ fromIntegral $ B.length key+    putBytes key++data KeyShare+    = KeyShareClientHello [KeyShareEntry]+    | KeyShareServerHello KeyShareEntry+    | KeyShareHRR Group+    deriving (Show, Eq)++instance Extension KeyShare where+    extensionID _ = EID_KeyShare+    extensionEncode (KeyShareClientHello kses) = runPut $ do+        let len = sum [B.length key + 4 | KeyShareEntry _ key <- kses]+        putWord16 $ fromIntegral len+        mapM_ putKeyShareEntry kses+    extensionEncode (KeyShareServerHello kse) = runPut $ putKeyShareEntry kse+    extensionEncode (KeyShareHRR (Group grp)) = runPut $ putWord16 grp+    extensionDecode MsgTServerHello = runGetMaybe $ do+        (_, ment) <- getKeyShareEntry+        case ment of+            Nothing -> fail "decoding KeyShare for ServerHello"+            Just ent -> return $ KeyShareServerHello ent+    extensionDecode MsgTClientHello = runGetMaybe $ do+        len <- fromIntegral <$> getWord16+        --      len == 0 allows for HRR+        grps <- getList len getKeyShareEntry+        return $ KeyShareClientHello $ catMaybes grps+    extensionDecode MsgTHelloRetryRequest =+        runGetMaybe $+            KeyShareHRR . Group <$> getWord16+    extensionDecode _ = error "extensionDecode: KeyShare"++------------------------------------------------------------++-- | Secure Renegotiation+data SecureRenegotiation = SecureRenegotiation ByteString ByteString+    deriving (Show, Eq)++instance Extension SecureRenegotiation where+    extensionID _ = EID_SecureRenegotiation+    extensionEncode (SecureRenegotiation cvd svd) =+        runPut $ putOpaque8 (cvd `B.append` svd)+    extensionDecode MsgTClientHello = runGetMaybe $ do+        opaque <- getOpaque8+        return $ SecureRenegotiation opaque ""+    extensionDecode MsgTServerHello = runGetMaybe $ do+        opaque <- getOpaque8+        let (cvd, svd) = B.splitAt (B.length opaque `div` 2) opaque+        return $ SecureRenegotiation cvd svd+    extensionDecode _ = error "extensionDecode: SecureRenegotiation"

@@ -0,0 +1,22 @@+-- This is a breaker for cyclic imports:+--+-- - Network.TLS.Extension imports Network.TLS.Struct+-- - Network.TLS.Extension imports Network.TLS.Packet+--+-- - Network.TLS.Struct imports Network.TLS.Extension+--+-- - Network.TLS.Packet imports Network.TLS.Struct+--+-- Originally, ExtensionRaw was defined in Network.TLS.Struct and no+-- cyclic imports exist. It is moved into Network.TLS.Extension for+-- pretty-printing, so the cyclic imports happen.+module Network.TLS.Extension where++import Data.ByteString+import Data.Word++data ExtensionRaw = ExtensionRaw ExtensionID ByteString+instance Eq ExtensionRaw+instance Show ExtensionRaw++newtype ExtensionID = ExtensionID {fromExtensionID :: Word16}

@@ -1,5 +1,5 @@ module Network.TLS.Extra.Cipher (-    -- * cipher suite+    -- * Cipher suite     ciphersuite_default,     ciphersuite_default_det,     ciphersuite_all,@@ -8,33 +8,72 @@     ciphersuite_strong_det,     ciphersuite_dhe_rsa, -    -- * individual ciphers+    -- * Individual ciphers++    -- ** RFC 5288+    cipher_DHE_RSA_WITH_AES_128_GCM_SHA256,+    cipher_DHE_RSA_WITH_AES_256_GCM_SHA384,++    -- ** RFC 8446+    cipher13_AES_128_GCM_SHA256,+    cipher13_AES_256_GCM_SHA384,+    cipher13_CHACHA20_POLY1305_SHA256,+    cipher13_AES_128_CCM_SHA256,+    cipher13_AES_128_CCM_8_SHA256,++    -- ** RFC 5289+    cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256,+    cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384,+    cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256,+    cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384,++    -- ** RFC 7251+    cipher_ECDHE_ECDSA_WITH_AES_128_CCM,+    cipher_ECDHE_ECDSA_WITH_AES_256_CCM,+    cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8,+    cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8,++    -- ** RFC 7905+    cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256,+    cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256,+    cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256,++    -- * Deprecated names++    -- ** RFC 5288     cipher_DHE_RSA_AES128GCM_SHA256,     cipher_DHE_RSA_AES256GCM_SHA384,-    cipher_DHE_RSA_CHACHA20POLY1305_SHA256,++    -- ** RFC 8446+    cipher_TLS13_AES128GCM_SHA256,+    cipher_TLS13_AES256GCM_SHA384,+    cipher_TLS13_CHACHA20POLY1305_SHA256,+    cipher_TLS13_AES128CCM_SHA256,+    cipher_TLS13_AES128CCM8_SHA256,++    -- ** RFC 5289+    cipher_ECDHE_ECDSA_AES128GCM_SHA256,+    cipher_ECDHE_ECDSA_AES256GCM_SHA384,     cipher_ECDHE_RSA_AES128GCM_SHA256,     cipher_ECDHE_RSA_AES256GCM_SHA384,-    cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256,++    -- ** RFC 7251     cipher_ECDHE_ECDSA_AES128CCM_SHA256,-    cipher_ECDHE_ECDSA_AES128CCM8_SHA256,-    cipher_ECDHE_ECDSA_AES128GCM_SHA256,     cipher_ECDHE_ECDSA_AES256CCM_SHA256,+    cipher_ECDHE_ECDSA_AES128CCM8_SHA256,     cipher_ECDHE_ECDSA_AES256CCM8_SHA256,-    cipher_ECDHE_ECDSA_AES256GCM_SHA384,++    -- ** RFC 7905+    cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256,     cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256,-    -- TLS 1.3-    cipher_TLS13_AES128GCM_SHA256,-    cipher_TLS13_AES256GCM_SHA384,-    cipher_TLS13_CHACHA20POLY1305_SHA256,-    cipher_TLS13_AES128CCM_SHA256,-    cipher_TLS13_AES128CCM8_SHA256,+    cipher_DHE_RSA_CHACHA20POLY1305_SHA256, ) where  import qualified Data.ByteString as B  import Data.Tuple (swap) import Network.TLS.Cipher-import Network.TLS.Types (Version (..))+import Network.TLS.Types  import Crypto.Cipher.AES import qualified Crypto.Cipher.ChaChaPoly1305 as ChaChaPoly1305@@ -45,151 +84,6 @@  ---------------------------------------------------------------- -aes128ccm :: BulkDirection -> BulkKey -> BulkAEAD-aes128ccm BulkEncrypt key =-    let ctx = noFail (cipherInit key) :: AES128-     in ( \nonce d ad ->-            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3-                aeadIni = noFail (aeadInit mode ctx nonce)-             in swap $ aeadSimpleEncrypt aeadIni ad d 16-        )-aes128ccm BulkDecrypt key =-    let ctx = noFail (cipherInit key) :: AES128-     in ( \nonce d ad ->-            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3-                aeadIni = noFail (aeadInit mode ctx nonce)-             in simpleDecrypt aeadIni ad d 16-        )--aes128ccm8 :: BulkDirection -> BulkKey -> BulkAEAD-aes128ccm8 BulkEncrypt key =-    let ctx = noFail (cipherInit key) :: AES128-     in ( \nonce d ad ->-            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3-                aeadIni = noFail (aeadInit mode ctx nonce)-             in swap $ aeadSimpleEncrypt aeadIni ad d 8-        )-aes128ccm8 BulkDecrypt key =-    let ctx = noFail (cipherInit key) :: AES128-     in ( \nonce d ad ->-            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3-                aeadIni = noFail (aeadInit mode ctx nonce)-             in simpleDecrypt aeadIni ad d 8-        )--aes128gcm :: BulkDirection -> BulkKey -> BulkAEAD-aes128gcm BulkEncrypt key =-    let ctx = noFail (cipherInit key) :: AES128-     in ( \nonce d ad ->-            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)-             in swap $ aeadSimpleEncrypt aeadIni ad d 16-        )-aes128gcm BulkDecrypt key =-    let ctx = noFail (cipherInit key) :: AES128-     in ( \nonce d ad ->-            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)-             in simpleDecrypt aeadIni ad d 16-        )--aes256ccm :: BulkDirection -> BulkKey -> BulkAEAD-aes256ccm BulkEncrypt key =-    let ctx = noFail (cipherInit key) :: AES256-     in ( \nonce d ad ->-            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3-                aeadIni = noFail (aeadInit mode ctx nonce)-             in swap $ aeadSimpleEncrypt aeadIni ad d 16-        )-aes256ccm BulkDecrypt key =-    let ctx = noFail (cipherInit key) :: AES256-     in ( \nonce d ad ->-            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3-                aeadIni = noFail (aeadInit mode ctx nonce)-             in simpleDecrypt aeadIni ad d 16-        )--aes256ccm8 :: BulkDirection -> BulkKey -> BulkAEAD-aes256ccm8 BulkEncrypt key =-    let ctx = noFail (cipherInit key) :: AES256-     in ( \nonce d ad ->-            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3-                aeadIni = noFail (aeadInit mode ctx nonce)-             in swap $ aeadSimpleEncrypt aeadIni ad d 8-        )-aes256ccm8 BulkDecrypt key =-    let ctx = noFail (cipherInit key) :: AES256-     in ( \nonce d ad ->-            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3-                aeadIni = noFail (aeadInit mode ctx nonce)-             in simpleDecrypt aeadIni ad d 8-        )--aes256gcm :: BulkDirection -> BulkKey -> BulkAEAD-aes256gcm BulkEncrypt key =-    let ctx = noFail (cipherInit key) :: AES256-     in ( \nonce d ad ->-            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)-             in swap $ aeadSimpleEncrypt aeadIni ad d 16-        )-aes256gcm BulkDecrypt key =-    let ctx = noFail (cipherInit key) :: AES256-     in ( \nonce d ad ->-            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)-             in simpleDecrypt aeadIni ad d 16-        )--simpleDecrypt-    :: AEAD cipher -> B.ByteString -> B.ByteString -> Int -> (B.ByteString, AuthTag)-simpleDecrypt aeadIni header input taglen = (output, tag)-  where-    aead = aeadAppendHeader aeadIni header-    (output, aeadFinal) = aeadDecrypt aead input-    tag = aeadFinalize aeadFinal taglen--noFail :: CryptoFailable a -> a-noFail = throwCryptoError--chacha20poly1305 :: BulkDirection -> BulkKey -> BulkAEAD-chacha20poly1305 BulkEncrypt key nonce =-    let st = noFail (ChaChaPoly1305.nonce12 nonce >>= ChaChaPoly1305.initialize key)-     in ( \input ad ->-            let st2 = ChaChaPoly1305.finalizeAAD (ChaChaPoly1305.appendAAD ad st)-                (output, st3) = ChaChaPoly1305.encrypt input st2-                Poly1305.Auth tag = ChaChaPoly1305.finalize st3-             in (output, AuthTag tag)-        )-chacha20poly1305 BulkDecrypt key nonce =-    let st = noFail (ChaChaPoly1305.nonce12 nonce >>= ChaChaPoly1305.initialize key)-     in ( \input ad ->-            let st2 = ChaChaPoly1305.finalizeAAD (ChaChaPoly1305.appendAAD ad st)-                (output, st3) = ChaChaPoly1305.decrypt input st2-                Poly1305.Auth tag = ChaChaPoly1305.finalize st3-             in (output, AuthTag tag)-        )--------------------------------------------------------------------data CipherSet-    = SetAead [Cipher] [Cipher] [Cipher] -- gcm, chacha, ccm-    | SetOther [Cipher]---- Preference between AEAD ciphers having equivalent properties is based on--- hardware-acceleration support in the crypton implementation.-sortOptimized :: [CipherSet] -> [Cipher]-sortOptimized = concatMap f-  where-    f (SetAead gcm chacha ccm)-        | AESNI `notElem` processorOptions = chacha ++ gcm ++ ccm-        | PCLMUL `notElem` processorOptions = ccm ++ chacha ++ gcm-        | otherwise = gcm ++ ccm ++ chacha-    f (SetOther ciphers) = ciphers---- Order which is deterministic but not optimized for the CPU.-sortDeterministic :: [CipherSet] -> [Cipher]-sortDeterministic = concatMap f-  where-    f (SetAead gcm chacha ccm) = gcm ++ chacha ++ ccm-    f (SetOther ciphers) = ciphers- -- | All AES and ChaCha20-Poly1305 ciphers supported ordered from strong to -- weak.  This choice of ciphersuites should satisfy most normal needs.  For -- otherwise strong ciphers we make little distinction between AES128 and@@ -224,9 +118,9 @@  complement_all :: [Cipher] complement_all =-    [ cipher_ECDHE_ECDSA_AES128CCM8_SHA256-    , cipher_ECDHE_ECDSA_AES256CCM8_SHA256-    , cipher_TLS13_AES128CCM8_SHA256+    [ cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8+    , cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8+    , cipher13_AES_128_CCM_8_SHA256     ]  -- | The strongest ciphers supported.  For ciphers with PFS, AEAD and SHA2, we@@ -248,30 +142,30 @@ sets_strong =     [ -- If we have PFS + AEAD + SHA2, then allow AES128, else just 256       SetAead-        [cipher_ECDHE_ECDSA_AES256GCM_SHA384]-        [cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256]-        [cipher_ECDHE_ECDSA_AES256CCM_SHA256]+        [cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384]+        [cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256]+        [cipher_ECDHE_ECDSA_WITH_AES_256_CCM]     , SetAead-        [cipher_ECDHE_ECDSA_AES128GCM_SHA256]+        [cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256]         []-        [cipher_ECDHE_ECDSA_AES128CCM_SHA256]+        [cipher_ECDHE_ECDSA_WITH_AES_128_CCM]     , SetAead-        [cipher_ECDHE_RSA_AES256GCM_SHA384]-        [cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256]+        [cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384]+        [cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256]         []     , SetAead-        [cipher_ECDHE_RSA_AES128GCM_SHA256]+        [cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256]         []         []     , -- TLS13 (listed at the end but version is negotiated first)       SetAead-        [cipher_TLS13_AES256GCM_SHA384]-        [cipher_TLS13_CHACHA20POLY1305_SHA256]+        [cipher13_AES_256_GCM_SHA384]+        [cipher13_CHACHA20_POLY1305_SHA256]         []     , SetAead-        [cipher_TLS13_AES128GCM_SHA256]+        [cipher13_AES_128_GCM_SHA256]         []-        [cipher_TLS13_AES128CCM_SHA256]+        [cipher13_AES_128_CCM_SHA256]     ]  -- | DHE-RSA cipher suite.  This only includes ciphers bound specifically to@@ -280,110 +174,12 @@ -- @since 2.1.5 ciphersuite_dhe_rsa :: [Cipher] ciphersuite_dhe_rsa =-    [ cipher_DHE_RSA_AES256GCM_SHA384-    , cipher_DHE_RSA_CHACHA20POLY1305_SHA256-    , cipher_DHE_RSA_AES128GCM_SHA256+    [ cipher_DHE_RSA_WITH_AES_256_GCM_SHA384+    , cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256+    , cipher_DHE_RSA_WITH_AES_128_GCM_SHA256     ]  ------------------------------------------------------------------bulk_aes128ccm :: Bulk-bulk_aes128ccm =-    Bulk-        { bulkName = "AES128CCM"-        , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN-        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length-        , bulkExplicitIV = 8-        , bulkAuthTagLen = 16-        , bulkBlockSize = 0 -- dummy, not used-        , bulkF = BulkAeadF aes128ccm-        }--bulk_aes128ccm8 :: Bulk-bulk_aes128ccm8 =-    Bulk-        { bulkName = "AES128CCM8"-        , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN-        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length-        , bulkExplicitIV = 8-        , bulkAuthTagLen = 8-        , bulkBlockSize = 0 -- dummy, not used-        , bulkF = BulkAeadF aes128ccm8-        }--bulk_aes128gcm :: Bulk-bulk_aes128gcm =-    Bulk-        { bulkName = "AES128GCM"-        , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN-        , bulkIVSize = 4 -- RFC 5288 GCMNonce.salt, fixed_iv_length-        , bulkExplicitIV = 8-        , bulkAuthTagLen = 16-        , bulkBlockSize = 0 -- dummy, not used-        , bulkF = BulkAeadF aes128gcm-        }--bulk_aes256ccm :: Bulk-bulk_aes256ccm =-    Bulk-        { bulkName = "AES256CCM"-        , bulkKeySize = 32 -- RFC 5116 Sec 5.1: K_LEN-        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length-        , bulkExplicitIV = 8-        , bulkAuthTagLen = 16-        , bulkBlockSize = 0 -- dummy, not used-        , bulkF = BulkAeadF aes256ccm-        }--bulk_aes256ccm8 :: Bulk-bulk_aes256ccm8 =-    Bulk-        { bulkName = "AES256CCM8"-        , bulkKeySize = 32 -- RFC 5116 Sec 5.1: K_LEN-        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length-        , bulkExplicitIV = 8-        , bulkAuthTagLen = 8-        , bulkBlockSize = 0 -- dummy, not used-        , bulkF = BulkAeadF aes256ccm8-        }--bulk_aes256gcm :: Bulk-bulk_aes256gcm =-    Bulk-        { bulkName = "AES256GCM"-        , bulkKeySize = 32 -- RFC 5116 Sec 5.1: K_LEN-        , bulkIVSize = 4 -- RFC 5288 GCMNonce.salt, fixed_iv_length-        , bulkExplicitIV = 8-        , bulkAuthTagLen = 16-        , bulkBlockSize = 0 -- dummy, not used-        , bulkF = BulkAeadF aes256gcm-        }--bulk_chacha20poly1305 :: Bulk-bulk_chacha20poly1305 =-    Bulk-        { bulkName = "CHACHA20POLY1305"-        , bulkKeySize = 32-        , bulkIVSize = 12 -- RFC 7905 section 2, fixed_iv_length-        , bulkExplicitIV = 0-        , bulkAuthTagLen = 16-        , bulkBlockSize = 0 -- dummy, not used-        , bulkF = BulkAeadF chacha20poly1305-        }---- TLS13 bulks are same as TLS12 except they never have explicit IV-bulk_aes128gcm_13 :: Bulk-bulk_aes128gcm_13 = bulk_aes128gcm{bulkIVSize = 12, bulkExplicitIV = 0}--bulk_aes256gcm_13 :: Bulk-bulk_aes256gcm_13 = bulk_aes256gcm{bulkIVSize = 12, bulkExplicitIV = 0}--bulk_aes128ccm_13 :: Bulk-bulk_aes128ccm_13 = bulk_aes128ccm{bulkIVSize = 12, bulkExplicitIV = 0}--bulk_aes128ccm8_13 :: Bulk-bulk_aes128ccm8_13 = bulk_aes128ccm8{bulkIVSize = 12, bulkExplicitIV = 0}- ----------------------------------------------------------------  -- A list of cipher suite is found from:@@ -392,8 +188,9 @@ ---------------------------------------------------------------- -- RFC 5288 -cipher_DHE_RSA_AES128GCM_SHA256 :: Cipher-cipher_DHE_RSA_AES128GCM_SHA256 =+-- TLS_DHE_RSA_WITH_AES_128_GCM_SHA256+cipher_DHE_RSA_WITH_AES_128_GCM_SHA256 :: Cipher+cipher_DHE_RSA_WITH_AES_128_GCM_SHA256 =     Cipher         { cipherID = 0x009E         , cipherName = "TLS_DHE_RSA_WITH_AES_128_GCM_SHA256"@@ -404,8 +201,16 @@         , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4         } -cipher_DHE_RSA_AES256GCM_SHA384 :: Cipher-cipher_DHE_RSA_AES256GCM_SHA384 =+{-# DEPRECATED+    cipher_DHE_RSA_AES128GCM_SHA256+    "Use cipher_DHE_RSA_WITH_AES_128_GCM_SHA256 instead"+    #-}+cipher_DHE_RSA_AES128GCM_SHA256 :: Cipher+cipher_DHE_RSA_AES128GCM_SHA256 = cipher_DHE_RSA_WITH_AES_128_GCM_SHA256++-- TLS_DHE_RSA_WITH_AES_256_GCM_SHA384+cipher_DHE_RSA_WITH_AES_256_GCM_SHA384 :: Cipher+cipher_DHE_RSA_WITH_AES_256_GCM_SHA384 =     Cipher         { cipherID = 0x009F         , cipherName = "TLS_DHE_RSA_WITH_AES_256_GCM_SHA384"@@ -416,11 +221,19 @@         , cipherMinVer = Just TLS12         } +{-# DEPRECATED+    cipher_DHE_RSA_AES256GCM_SHA384+    "Use cipher_DHE_RSA_WITH_AES_256_GCM_SHA384 instead"+    #-}+cipher_DHE_RSA_AES256GCM_SHA384 :: Cipher+cipher_DHE_RSA_AES256GCM_SHA384 = cipher_DHE_RSA_WITH_AES_256_GCM_SHA384+ ---------------------------------------------------------------- -- RFC 8446 -cipher_TLS13_AES128GCM_SHA256 :: Cipher-cipher_TLS13_AES128GCM_SHA256 =+-- TLS_AES_128_GCM_SHA256+cipher13_AES_128_GCM_SHA256 :: Cipher+cipher13_AES_128_GCM_SHA256 =     Cipher         { cipherID = 0x1301         , cipherName = "TLS_AES_128_GCM_SHA256"@@ -431,8 +244,16 @@         , cipherMinVer = Just TLS13         } -cipher_TLS13_AES256GCM_SHA384 :: Cipher-cipher_TLS13_AES256GCM_SHA384 =+cipher_TLS13_AES128GCM_SHA256 :: Cipher+cipher_TLS13_AES128GCM_SHA256 = cipher13_AES_128_GCM_SHA256+{-# DEPRECATED+    cipher_TLS13_AES128GCM_SHA256+    "Use cipher13_AES_128_GCM_SHA256 instead"+    #-}++-- TLS_AES_256_GCM_SHA384+cipher13_AES_256_GCM_SHA384 :: Cipher+cipher13_AES_256_GCM_SHA384 =     Cipher         { cipherID = 0x1302         , cipherName = "TLS_AES_256_GCM_SHA384"@@ -443,8 +264,16 @@         , cipherMinVer = Just TLS13         } -cipher_TLS13_CHACHA20POLY1305_SHA256 :: Cipher-cipher_TLS13_CHACHA20POLY1305_SHA256 =+cipher_TLS13_AES256GCM_SHA384 :: Cipher+cipher_TLS13_AES256GCM_SHA384 = cipher13_AES_256_GCM_SHA384+{-# DEPRECATED+    cipher_TLS13_AES256GCM_SHA384+    "Use cipher13_AES_256_GCM_SHA384 instead"+    #-}++-- TLS_CHACHA20_POLY1305_SHA256+cipher13_CHACHA20_POLY1305_SHA256 :: Cipher+cipher13_CHACHA20_POLY1305_SHA256 =     Cipher         { cipherID = 0x1303         , cipherName = "TLS_CHACHA20_POLY1305_SHA256"@@ -455,8 +284,16 @@         , cipherMinVer = Just TLS13         } -cipher_TLS13_AES128CCM_SHA256 :: Cipher-cipher_TLS13_AES128CCM_SHA256 =+cipher_TLS13_CHACHA20POLY1305_SHA256 :: Cipher+cipher_TLS13_CHACHA20POLY1305_SHA256 = cipher13_CHACHA20_POLY1305_SHA256+{-# DEPRECATED+    cipher_TLS13_CHACHA20POLY1305_SHA256+    "Use cipher13_CHACHA20_POLY1305_SHA256 instead"+    #-}++-- TLS_AES_128_CCM_SHA256+cipher13_AES_128_CCM_SHA256 :: Cipher+cipher13_AES_128_CCM_SHA256 =     Cipher         { cipherID = 0x1304         , cipherName = "TLS_AES_128_CCM_SHA256"@@ -467,8 +304,16 @@         , cipherMinVer = Just TLS13         } -cipher_TLS13_AES128CCM8_SHA256 :: Cipher-cipher_TLS13_AES128CCM8_SHA256 =+cipher_TLS13_AES128CCM_SHA256 :: Cipher+cipher_TLS13_AES128CCM_SHA256 = cipher13_AES_128_CCM_SHA256+{-# DEPRECATED+    cipher_TLS13_AES128CCM_SHA256+    "Use cipher13_AES_128_CCM_SHA256 instead"+    #-}++-- TLS_AES_128_CCM_8_SHA256+cipher13_AES_128_CCM_8_SHA256 :: Cipher+cipher13_AES_128_CCM_8_SHA256 =     Cipher         { cipherID = 0x1305         , cipherName = "TLS_AES_128_CCM_8_SHA256"@@ -479,11 +324,19 @@         , cipherMinVer = Just TLS13         } +cipher_TLS13_AES128CCM8_SHA256 :: Cipher+cipher_TLS13_AES128CCM8_SHA256 = cipher13_AES_128_CCM_8_SHA256+{-# DEPRECATED+    cipher_TLS13_AES128CCM8_SHA256+    "Use cipher13_AES_128_CCM_8_SHA256 instead"+    #-}+ ---------------------------------------------------------------- -- GCM: RFC 5289 -cipher_ECDHE_ECDSA_AES128GCM_SHA256 :: Cipher-cipher_ECDHE_ECDSA_AES128GCM_SHA256 =+-- TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256+cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 :: Cipher+cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 =     Cipher         { cipherID = 0xC02B         , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256"@@ -494,8 +347,16 @@         , cipherMinVer = Just TLS12 -- RFC 5289         } -cipher_ECDHE_ECDSA_AES256GCM_SHA384 :: Cipher-cipher_ECDHE_ECDSA_AES256GCM_SHA384 =+cipher_ECDHE_ECDSA_AES128GCM_SHA256 :: Cipher+cipher_ECDHE_ECDSA_AES128GCM_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256+{-# DEPRECATED+    cipher_ECDHE_ECDSA_AES128GCM_SHA256+    "Use cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 instead"+    #-}++-- TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384+cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 :: Cipher+cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 =     Cipher         { cipherID = 0xC02C         , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384"@@ -506,8 +367,16 @@         , cipherMinVer = Just TLS12 -- RFC 5289         } -cipher_ECDHE_RSA_AES128GCM_SHA256 :: Cipher-cipher_ECDHE_RSA_AES128GCM_SHA256 =+cipher_ECDHE_ECDSA_AES256GCM_SHA384 :: Cipher+cipher_ECDHE_ECDSA_AES256GCM_SHA384 = cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384+{-# DEPRECATED+    cipher_ECDHE_ECDSA_AES256GCM_SHA384+    "Use cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 instead"+    #-}++-- TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256+cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256 :: Cipher+cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256 =     Cipher         { cipherID = 0xC02F         , cipherName = "TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256"@@ -518,8 +387,16 @@         , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4         } -cipher_ECDHE_RSA_AES256GCM_SHA384 :: Cipher-cipher_ECDHE_RSA_AES256GCM_SHA384 =+cipher_ECDHE_RSA_AES128GCM_SHA256 :: Cipher+cipher_ECDHE_RSA_AES128GCM_SHA256 = cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256+{-# DEPRECATED+    cipher_ECDHE_RSA_AES128GCM_SHA256+    "Use cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256 instead"+    #-}++-- TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384+cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384 :: Cipher+cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384 =     Cipher         { cipherID = 0xC030         , cipherName = "TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384"@@ -530,11 +407,19 @@         , cipherMinVer = Just TLS12 -- RFC 5289         } +cipher_ECDHE_RSA_AES256GCM_SHA384 :: Cipher+cipher_ECDHE_RSA_AES256GCM_SHA384 = cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384+{-# DEPRECATED+    cipher_ECDHE_RSA_AES256GCM_SHA384+    "Use cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384 instead"+    #-}+ ---------------------------------------------------------------- -- CCM/ECC: RFC 7251 -cipher_ECDHE_ECDSA_AES128CCM_SHA256 :: Cipher-cipher_ECDHE_ECDSA_AES128CCM_SHA256 =+-- TLS_ECDHE_ECDSA_WITH_AES_128_CCM+cipher_ECDHE_ECDSA_WITH_AES_128_CCM :: Cipher+cipher_ECDHE_ECDSA_WITH_AES_128_CCM =     Cipher         { cipherID = 0xC0AC         , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_128_CCM"@@ -545,8 +430,16 @@         , cipherMinVer = Just TLS12 -- RFC 7251         } -cipher_ECDHE_ECDSA_AES256CCM_SHA256 :: Cipher-cipher_ECDHE_ECDSA_AES256CCM_SHA256 =+cipher_ECDHE_ECDSA_AES128CCM_SHA256 :: Cipher+cipher_ECDHE_ECDSA_AES128CCM_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_128_CCM+{-# DEPRECATED+    cipher_ECDHE_ECDSA_AES128CCM_SHA256+    "User cipher_ECDHE_ECDSA_WITH_AES_128_CCM instead"+    #-}++-- TLS_ECDHE_ECDSA_WITH_AES_256_CCM+cipher_ECDHE_ECDSA_WITH_AES_256_CCM :: Cipher+cipher_ECDHE_ECDSA_WITH_AES_256_CCM =     Cipher         { cipherID = 0xC0AD         , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_256_CCM"@@ -557,8 +450,16 @@         , cipherMinVer = Just TLS12 -- RFC 7251         } -cipher_ECDHE_ECDSA_AES128CCM8_SHA256 :: Cipher-cipher_ECDHE_ECDSA_AES128CCM8_SHA256 =+cipher_ECDHE_ECDSA_AES256CCM_SHA256 :: Cipher+cipher_ECDHE_ECDSA_AES256CCM_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_256_CCM+{-# DEPRECATED+    cipher_ECDHE_ECDSA_AES256CCM_SHA256+    "Use cipher_ECDHE_ECDSA_WITH_AES_256_CCM instead"+    #-}++-- TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8+cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8 :: Cipher+cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8 =     Cipher         { cipherID = 0xC0AE         , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8"@@ -569,8 +470,16 @@         , cipherMinVer = Just TLS12 -- RFC 7251         } -cipher_ECDHE_ECDSA_AES256CCM8_SHA256 :: Cipher-cipher_ECDHE_ECDSA_AES256CCM8_SHA256 =+cipher_ECDHE_ECDSA_AES128CCM8_SHA256 :: Cipher+cipher_ECDHE_ECDSA_AES128CCM8_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8+{-# DEPRECATED+    cipher_ECDHE_ECDSA_AES128CCM8_SHA256+    "Use cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8 instead"+    #-}++-- TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8+cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8 :: Cipher+cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8 =     Cipher         { cipherID = 0xC0AF         , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8"@@ -581,11 +490,19 @@         , cipherMinVer = Just TLS12 -- RFC 7251         } +cipher_ECDHE_ECDSA_AES256CCM8_SHA256 :: Cipher+cipher_ECDHE_ECDSA_AES256CCM8_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8+{-# DEPRECATED+    cipher_ECDHE_ECDSA_AES256CCM8_SHA256+    "Use cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8 instead"+    #-}+ ---------------------------------------------------------------- -- RFC 7905 -cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 :: Cipher-cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 =+-- TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256+cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 :: Cipher+cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 =     Cipher         { cipherID = 0xCCA8         , cipherName = "TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256"@@ -596,8 +513,16 @@         , cipherMinVer = Just TLS12         } -cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 :: Cipher-cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 =+cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 :: Cipher+cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 = cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256+{-# DEPRECATED+    cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256+    "Use cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 instead"+    #-}++-- TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256+cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 :: Cipher+cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 =     Cipher         { cipherID = 0xCCA9         , cipherName = "TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256"@@ -608,8 +533,16 @@         , cipherMinVer = Just TLS12         } -cipher_DHE_RSA_CHACHA20POLY1305_SHA256 :: Cipher-cipher_DHE_RSA_CHACHA20POLY1305_SHA256 =+cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 :: Cipher+cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 = cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256+{-# DEPRECATED+    cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256+    "Use cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 instead"+    #-}++-- TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256+cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 :: Cipher+cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 =     Cipher         { cipherID = 0xCCAA         , cipherName = "TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256"@@ -619,3 +552,257 @@         , cipherKeyExchange = CipherKeyExchange_DHE_RSA         , cipherMinVer = Just TLS12         }++cipher_DHE_RSA_CHACHA20POLY1305_SHA256 :: Cipher+cipher_DHE_RSA_CHACHA20POLY1305_SHA256 = cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256+{-# DEPRECATED+    cipher_DHE_RSA_CHACHA20POLY1305_SHA256+    "Use cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 instead"+    #-}++----------------------------------------------------------------+----------------------------------------------------------------++data CipherSet+    = SetAead [Cipher] [Cipher] [Cipher] -- gcm, chacha, ccm+    | SetOther [Cipher]++-- Preference between AEAD ciphers having equivalent properties is based on+-- hardware-acceleration support in the crypton implementation.+sortOptimized :: [CipherSet] -> [Cipher]+sortOptimized = concatMap f+  where+    f (SetAead gcm chacha ccm)+        | AESNI `notElem` processorOptions = chacha ++ gcm ++ ccm+        | PCLMUL `notElem` processorOptions = ccm ++ chacha ++ gcm+        | otherwise = gcm ++ ccm ++ chacha+    f (SetOther ciphers) = ciphers++-- Order which is deterministic but not optimized for the CPU.+sortDeterministic :: [CipherSet] -> [Cipher]+sortDeterministic = concatMap f+  where+    f (SetAead gcm chacha ccm) = gcm ++ chacha ++ ccm+    f (SetOther ciphers) = ciphers++----------------------------------------------------------------++aes128ccm :: BulkDirection -> BulkKey -> BulkAEAD+aes128ccm BulkEncrypt key =+    let ctx = noFail (cipherInit key) :: AES128+     in ( \nonce d ad ->+            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3+                aeadIni = noFail (aeadInit mode ctx nonce)+             in swap $ aeadSimpleEncrypt aeadIni ad d 16+        )+aes128ccm BulkDecrypt key =+    let ctx = noFail (cipherInit key) :: AES128+     in ( \nonce d ad ->+            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3+                aeadIni = noFail (aeadInit mode ctx nonce)+             in simpleDecrypt aeadIni ad d 16+        )++aes128ccm8 :: BulkDirection -> BulkKey -> BulkAEAD+aes128ccm8 BulkEncrypt key =+    let ctx = noFail (cipherInit key) :: AES128+     in ( \nonce d ad ->+            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3+                aeadIni = noFail (aeadInit mode ctx nonce)+             in swap $ aeadSimpleEncrypt aeadIni ad d 8+        )+aes128ccm8 BulkDecrypt key =+    let ctx = noFail (cipherInit key) :: AES128+     in ( \nonce d ad ->+            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3+                aeadIni = noFail (aeadInit mode ctx nonce)+             in simpleDecrypt aeadIni ad d 8+        )++aes128gcm :: BulkDirection -> BulkKey -> BulkAEAD+aes128gcm BulkEncrypt key =+    let ctx = noFail (cipherInit key) :: AES128+     in ( \nonce d ad ->+            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)+             in swap $ aeadSimpleEncrypt aeadIni ad d 16+        )+aes128gcm BulkDecrypt key =+    let ctx = noFail (cipherInit key) :: AES128+     in ( \nonce d ad ->+            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)+             in simpleDecrypt aeadIni ad d 16+        )++aes256ccm :: BulkDirection -> BulkKey -> BulkAEAD+aes256ccm BulkEncrypt key =+    let ctx = noFail (cipherInit key) :: AES256+     in ( \nonce d ad ->+            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3+                aeadIni = noFail (aeadInit mode ctx nonce)+             in swap $ aeadSimpleEncrypt aeadIni ad d 16+        )+aes256ccm BulkDecrypt key =+    let ctx = noFail (cipherInit key) :: AES256+     in ( \nonce d ad ->+            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3+                aeadIni = noFail (aeadInit mode ctx nonce)+             in simpleDecrypt aeadIni ad d 16+        )++aes256ccm8 :: BulkDirection -> BulkKey -> BulkAEAD+aes256ccm8 BulkEncrypt key =+    let ctx = noFail (cipherInit key) :: AES256+     in ( \nonce d ad ->+            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3+                aeadIni = noFail (aeadInit mode ctx nonce)+             in swap $ aeadSimpleEncrypt aeadIni ad d 8+        )+aes256ccm8 BulkDecrypt key =+    let ctx = noFail (cipherInit key) :: AES256+     in ( \nonce d ad ->+            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3+                aeadIni = noFail (aeadInit mode ctx nonce)+             in simpleDecrypt aeadIni ad d 8+        )++aes256gcm :: BulkDirection -> BulkKey -> BulkAEAD+aes256gcm BulkEncrypt key =+    let ctx = noFail (cipherInit key) :: AES256+     in ( \nonce d ad ->+            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)+             in swap $ aeadSimpleEncrypt aeadIni ad d 16+        )+aes256gcm BulkDecrypt key =+    let ctx = noFail (cipherInit key) :: AES256+     in ( \nonce d ad ->+            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)+             in simpleDecrypt aeadIni ad d 16+        )++simpleDecrypt+    :: AEAD cipher -> B.ByteString -> B.ByteString -> Int -> (B.ByteString, AuthTag)+simpleDecrypt aeadIni header input taglen = (output, tag)+  where+    aead = aeadAppendHeader aeadIni header+    (output, aeadFinal) = aeadDecrypt aead input+    tag = aeadFinalize aeadFinal taglen++noFail :: CryptoFailable a -> a+noFail = throwCryptoError++chacha20poly1305 :: BulkDirection -> BulkKey -> BulkAEAD+chacha20poly1305 BulkEncrypt key nonce =+    let st = noFail (ChaChaPoly1305.nonce12 nonce >>= ChaChaPoly1305.initialize key)+     in ( \input ad ->+            let st2 = ChaChaPoly1305.finalizeAAD (ChaChaPoly1305.appendAAD ad st)+                (output, st3) = ChaChaPoly1305.encrypt input st2+                Poly1305.Auth tag = ChaChaPoly1305.finalize st3+             in (output, AuthTag tag)+        )+chacha20poly1305 BulkDecrypt key nonce =+    let st = noFail (ChaChaPoly1305.nonce12 nonce >>= ChaChaPoly1305.initialize key)+     in ( \input ad ->+            let st2 = ChaChaPoly1305.finalizeAAD (ChaChaPoly1305.appendAAD ad st)+                (output, st3) = ChaChaPoly1305.decrypt input st2+                Poly1305.Auth tag = ChaChaPoly1305.finalize st3+             in (output, AuthTag tag)+        )++----------------------------------------------------------------++bulk_aes128ccm :: Bulk+bulk_aes128ccm =+    Bulk+        { bulkName = "AES128CCM"+        , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN+        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length+        , bulkExplicitIV = 8+        , bulkAuthTagLen = 16+        , bulkBlockSize = 0 -- dummy, not used+        , bulkF = BulkAeadF aes128ccm+        }++bulk_aes128ccm8 :: Bulk+bulk_aes128ccm8 =+    Bulk+        { bulkName = "AES128CCM8"+        , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN+        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length+        , bulkExplicitIV = 8+        , bulkAuthTagLen = 8+        , bulkBlockSize = 0 -- dummy, not used+        , bulkF = BulkAeadF aes128ccm8+        }++bulk_aes128gcm :: Bulk+bulk_aes128gcm =+    Bulk+        { bulkName = "AES128GCM"+        , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN+        , bulkIVSize = 4 -- RFC 5288 GCMNonce.salt, fixed_iv_length+        , bulkExplicitIV = 8+        , bulkAuthTagLen = 16+        , bulkBlockSize = 0 -- dummy, not used+        , bulkF = BulkAeadF aes128gcm+        }++bulk_aes256ccm :: Bulk+bulk_aes256ccm =+    Bulk+        { bulkName = "AES256CCM"+        , bulkKeySize = 32 -- RFC 5116 Sec 5.1: K_LEN+        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length+        , bulkExplicitIV = 8+        , bulkAuthTagLen = 16+        , bulkBlockSize = 0 -- dummy, not used+        , bulkF = BulkAeadF aes256ccm+        }++bulk_aes256ccm8 :: Bulk+bulk_aes256ccm8 =+    Bulk+        { bulkName = "AES256CCM8"+        , bulkKeySize = 32 -- RFC 5116 Sec 5.1: K_LEN+        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length+        , bulkExplicitIV = 8+        , bulkAuthTagLen = 8+        , bulkBlockSize = 0 -- dummy, not used+        , bulkF = BulkAeadF aes256ccm8+        }++bulk_aes256gcm :: Bulk+bulk_aes256gcm =+    Bulk+        { bulkName = "AES256GCM"+        , bulkKeySize = 32 -- RFC 5116 Sec 5.1: K_LEN+        , bulkIVSize = 4 -- RFC 5288 GCMNonce.salt, fixed_iv_length+        , bulkExplicitIV = 8+        , bulkAuthTagLen = 16+        , bulkBlockSize = 0 -- dummy, not used+        , bulkF = BulkAeadF aes256gcm+        }++bulk_chacha20poly1305 :: Bulk+bulk_chacha20poly1305 =+    Bulk+        { bulkName = "CHACHA20POLY1305"+        , bulkKeySize = 32+        , bulkIVSize = 12 -- RFC 7905 section 2, fixed_iv_length+        , bulkExplicitIV = 0+        , bulkAuthTagLen = 16+        , bulkBlockSize = 0 -- dummy, not used+        , bulkF = BulkAeadF chacha20poly1305+        }++-- TLS13 bulks are same as TLS12 except they never have explicit IV+bulk_aes128gcm_13 :: Bulk+bulk_aes128gcm_13 = bulk_aes128gcm{bulkIVSize = 12, bulkExplicitIV = 0}++bulk_aes256gcm_13 :: Bulk+bulk_aes256gcm_13 = bulk_aes256gcm{bulkIVSize = 12, bulkExplicitIV = 0}++bulk_aes128ccm_13 :: Bulk+bulk_aes128ccm_13 = bulk_aes128ccm{bulkIVSize = 12, bulkExplicitIV = 0}++bulk_aes128ccm8_13 :: Bulk+bulk_aes128ccm8_13 = bulk_aes128ccm8{bulkIVSize = 12, bulkExplicitIV = 0}

@@ -86,7 +86,7 @@     hrr <- usingState_ ctx getTLS13HRR     unless hrr $ startHandshake ctx ver crand     usingState_ ctx $ setVersionIfUnset highestVer-    let cipherIds = map cipherID ciphers+    let cipherIds = map (CipherId . cipherID) ciphers         compIds = map compressionID compressions         mkClientHello exts = ClientHello ver crand compIds $ CH clientSession cipherIds exts     extensions0 <- catMaybes <$> getExtensions@@ -135,13 +135,10 @@             , preSharedKeyExtension -- MUST be last (RFC 8446)             ] -    toExtensionRaw :: Extension e => e -> ExtensionRaw-    toExtensionRaw ext = ExtensionRaw (extensionID ext) (extensionEncode ext)-     secureReneg =         if supportedSecureRenegotiation $ ctxSupported ctx             then do-                cvd <- usingState_ ctx $ getVerifyData ClientRole+                VerifyData cvd <- usingState_ ctx $ getVerifyData ClientRole                 return $ Just $ toExtensionRaw $ SecureRenegotiation cvd ""             else return Nothing     alpnExtension = do@@ -303,7 +300,7 @@             guard (sessionVersion sdata >= TLS13)             let cid = sessionCipher sdata                 sids = map fst xs-            sCipher <- find (\c -> cipherID c == cid) ciphers+            sCipher <- findCipher cid ciphers             Just (sid : sids, sdata, sCipher)      getPskInfo = case sessions of

@@ -334,16 +334,22 @@ ----------------------------------------------------------------  setALPN :: Context -> MessageType -> [ExtensionRaw] -> IO ()-setALPN ctx msgt exts = case extensionLookup EID_ApplicationLayerProtocolNegotiation exts-    >>= extensionDecode msgt of-    Just (ApplicationLayerProtocolNegotiation [proto]) -> usingState_ ctx $ do+setALPN ctx msgt exts =+    lookupAndDecodeAndDo+        EID_ApplicationLayerProtocolNegotiation+        msgt+        exts+        (return ())+        setAlpn+  where+    setAlpn (ApplicationLayerProtocolNegotiation [proto]) = usingState_ ctx $ do         mprotos <- getClientALPNSuggest         case mprotos of             Just protos -> when (proto `elem` protos) $ do                 setExtensionALPN True                 setNegotiatedProtocol proto             _ -> return ()-    _ -> return ()+    setAlpn _ = return ()  ---------------------------------------------------------------- 

@@ -66,7 +66,7 @@ -- 4) process the session parameter to see if the server want to start a new session or can resume processServerHello     :: ClientParams -> Context -> Handshake -> IO ()-processServerHello cparams ctx (ServerHello rver serverRan serverSession cipher compression exts) = do+processServerHello cparams ctx (ServerHello rver serverRan serverSession (CipherId cid) compression exts) = do     -- A server which receives a legacy_version value not equal to     -- 0x0303 MUST abort the handshake with an "illegal_parameter"     -- alert.@@ -76,7 +76,8 @@     -- find the compression and cipher methods that the server want to use.     clientSession <- tls13stSession <$> getTLS13State ctx     sentExts <- tls13stSentExtensions <$> getTLS13State ctx-    cipherAlg <- case find ((==) cipher . cipherID) (supportedCiphers $ ctxSupported ctx) of+    let clientCiphers = supportedCiphers $ ctxSupported ctx+    cipherAlg <- case findCipher cid clientCiphers of         Nothing -> throwCore $ Error_Protocol "server choose unknown cipher" IllegalParameter         Just alg -> return alg     compressAlg <- case find@@ -99,11 +100,14 @@     let isHRR = isHelloRetryRequest serverRan     usingState_ ctx $ do         setTLS13HRR isHRR-        setTLS13Cookie-            ( guard isHRR-                >> extensionLookup EID_Cookie exts-                >>= extensionDecode MsgTServerHello-            )+        when (not isHRR) $+            setTLS13Cookie $+                lookupAndDecode+                    EID_Cookie+                    MsgTServerHello+                    exts+                    Nothing+                    (\cookie@(Cookie _) -> Just cookie)         setVersion rver -- must be before processing supportedVersions ext         mapM_ processServerExtension exts @@ -163,8 +167,8 @@ processServerExtension :: ExtensionRaw -> TLSSt () processServerExtension (ExtensionRaw extID content)     | extID == EID_SecureRenegotiation = do-        cvd <- getVerifyData ClientRole-        svd <- getVerifyData ServerRole+        VerifyData cvd <- getVerifyData ClientRole+        VerifyData svd <- getVerifyData ServerRole         let bs = extensionEncode $ SecureRenegotiation cvd svd         unless (bs == content) $             throwError $

@@ -42,7 +42,7 @@             runRecvStateHS ctx st hs  expectCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO)-expectCertificate cparams ctx (Certificate certs) = do+expectCertificate cparams ctx (Certificate (TLSCertificateChain certs)) = do     usingState_ ctx $ setServerCertificateChain certs     doCertificate cparams ctx certs     processCertificate ctx ClientRole certs@@ -150,7 +150,7 @@             unless (null certs) $                 usingHState ctx $                     setClientCertSent True-            sendPacket12 ctx $ Handshake [Certificate cc]+            sendPacket12 ctx $ Handshake [Certificate (TLSCertificateChain cc)]  ---------------------------------------------------------------- 

@@ -183,9 +183,7 @@   where     -- setCertReqSigAlgsCert caAlgs -    canames = case extensionLookup-        EID_CertificateAuthorities-        exts of+    canames = case extensionLookup EID_CertificateAuthorities exts of         Nothing -> return []         Just ext -> case extensionDecode MsgTCertificateRequest ext of             Just (CertificateAuthorities names) -> return names@@ -205,7 +203,7 @@ -- not used in 0-RTT expectCertAndVerify     :: MonadIO m => ClientParams -> Context -> Handshake13 -> RecvHandshake13M m ()-expectCertAndVerify cparams ctx (Certificate13 _ cc _) = do+expectCertAndVerify cparams ctx (Certificate13 _ (TLSCertificateChain cc) _) = do     liftIO $ usingState_ ctx $ setServerCertificateChain cc     liftIO $ doCertificate cparams ctx cc     let pubkey = certPubKey $ getCertificate $ getCertificateChainLeaf cc@@ -219,7 +217,7 @@  expectCertVerify     :: MonadIO m => Context -> PubKey -> ByteString -> Handshake13 -> m ()-expectCertVerify ctx pubkey hChSc (CertVerify13 sigAlg sig) = do+expectCertVerify ctx pubkey hChSc (CertVerify13 (DigitallySigned sigAlg sig)) = do     ok <- checkCertVerify ctx pubkey sigAlg sig hChSc     unless ok $ decryptError "cannot verify CertificateVerify" expectCertVerify _ _ _ p = unexpected (show p) (Just "certificate verify")@@ -333,7 +331,8 @@         let (CertificateChain certs) = chain             certExts = replicate (length certs) []             cHashSigs = filter isHashSignatureValid13 $ supportedHashSignatures $ ctxSupported ctx-        loadPacket13 ctx $ Handshake13 [Certificate13 token chain certExts]+        loadPacket13 ctx $+            Handshake13 [Certificate13 token (TLSCertificateChain chain) certExts]         case certs of             [] -> return ()             _ -> do

@@ -21,7 +21,6 @@     onRecvStateHandshake,     ensureRecvComplete,     processExtendedMainSecret,-    extensionLookup,     getSessionData,     storePrivInfo,     isSupportedGroup,@@ -76,7 +75,9 @@         if tls13             then do                 when (established == EarlyDataSending) $ clearTxRecordState ctx-                sendPacket13 ctx $ Alert13 [errorToAlert tlserror]+                when (tlserror /= Error_TCP_Terminate) $+                    sendPacket13 ctx $+                        Alert13 [errorToAlert tlserror]             else sendPacket12 ctx $ Alert [errorToAlert tlserror]     handshakeFailed tlserror   where@@ -139,7 +140,9 @@     sendPacket12 ctx ChangeCipherSpec     contextFlush ctx     verifyData <--        usingState_ ctx getVersion >>= \ver -> usingHState ctx $ getHandshakeDigest ver role+        VerifyData+            <$> ( usingState_ ctx getVersion >>= \ver -> usingHState ctx $ getHandshakeDigest ver role+                )     sendPacket12 ctx (Handshake [Finished verifyData])     usingState_ ctx $ setVerifyDataForSend verifyData     contextFlush ctx@@ -209,14 +212,23 @@     | ver > TLS12 = error "EMS processing is not compatible with TLS 1.3"     | ems == NoEMS = return False     | otherwise =-        case extensionLookup EID_ExtendedMainSecret exts >>= extensionDecode msgt of-            Just ExtendedMainSecret -> usingHState ctx (setExtendedMainSecret True) >> return True-            Nothing-                | ems == RequireEMS -> throwCore $ Error_Protocol err HandshakeFailure-                | otherwise -> return False+        liftIO $+            lookupAndDecodeAndDo+                EID_ExtendedMainSecret+                msgt+                exts+                nonExistAction+                existAction   where-    ems = supportedExtendedMainSecret (ctxSupported ctx)+    ems = supportedExtendedMainSecret $ ctxSupported ctx     err = "peer does not support Extended Main Secret"+    nonExistAction =+        if ems == RequireEMS+            then throwCore $ Error_Protocol err HandshakeFailure+            else return False+    existAction ExtendedMainSecret = do+        usingHState ctx $ setExtendedMainSecret True+        return True  getSessionData :: Context -> IO (Maybe SessionData) getSessionData ctx = do@@ -246,11 +258,6 @@                         , sessionFlags = flags                         } -extensionLookup :: ExtensionID -> [ExtensionRaw] -> Maybe ByteString-extensionLookup toFind =-    fmap (\(ExtensionRaw _ content) -> content)-        . find (\(ExtensionRaw eid _) -> eid == toFind)- -- | Store the specified keypair.  Whether the public key and private key -- actually match is left for the peer to discover.  We're not presently -- burning  CPU to detect that misconfiguration.  We verify only that the@@ -300,7 +307,8 @@ processFinished :: Context -> VerifyData -> IO () processFinished ctx verifyData = do     (cc, ver) <- usingState_ ctx $ (,) <$> getRole <*> getVersion-    expected <- usingHState ctx $ getHandshakeDigest ver $ invertRole cc+    expected <-+        VerifyData <$> (usingHState ctx $ getHandshakeDigest ver $ invertRole cc)     when (expected /= verifyData) $ decryptError "cannot verify finished"     usingState_ ctx $ setVerifyDataForRecv verifyData 

@@ -76,19 +76,20 @@  makeFinished :: MonadIO m => Context -> Hash -> ByteString -> m Handshake13 makeFinished ctx usedHash baseKey = do-    verifyData <- makeVerifyData usedHash baseKey <$> transcriptHash ctx+    verifyData <-+        VerifyData . makeVerifyData usedHash baseKey <$> transcriptHash ctx     liftIO $ usingState_ ctx $ setVerifyDataForSend verifyData     pure $ Finished13 verifyData  checkFinished-    :: MonadIO m => Context -> Hash -> ByteString -> ByteString -> ByteString -> m ()-checkFinished ctx usedHash baseKey hashValue verifyData = do+    :: MonadIO m => Context -> Hash -> ByteString -> ByteString -> VerifyData -> m ()+checkFinished ctx usedHash baseKey hashValue vd@(VerifyData verifyData) = do     let verifyData' = makeVerifyData usedHash baseKey hashValue     when (B.length verifyData /= B.length verifyData') $         throwCore $             Error_Protocol "broken Finished" DecodeError     unless (verifyData' == verifyData) $ decryptError "cannot verify finished"-    liftIO $ usingState_ ctx $ setVerifyDataForRecv verifyData+    liftIO $ usingState_ ctx $ setVerifyDataForRecv vd  makeVerifyData :: Hash -> ByteString -> ByteString -> ByteString makeVerifyData usedHash baseKey = hmac usedHash finishedKey@@ -152,7 +153,7 @@             | role == ClientRole = clientContextString             | otherwise = serverContextString         target = makeTarget ctxStr hashValue-    CertVerify13 hs <$> sign ctx pub hs target+    CertVerify13 <$> DigitallySigned hs <$> sign ctx pub hs target  checkCertVerify     :: MonadIO m@@ -204,11 +205,12 @@     -> Maybe ByteString     -> IO ByteString makePSKBinder ctx (BaseSecret sec) usedHash truncLen mch = do-    rmsgs0 <- usingHState ctx getHandshakeMessagesRev -- fixme-    let rmsgs = case mch of-            Just ch -> trunc ch : rmsgs0-            Nothing -> trunc (head rmsgs0) : tail rmsgs0-        hChTruncated = hash usedHash $ B.concat $ reverse rmsgs+    rmsgs <- case mch of+        Just ch -> (trunc ch :) <$> usingHState ctx getHandshakeMessagesRev+        Nothing -> do+            ch : rs <- usingHState ctx getHandshakeMessagesRev+            return $ trunc ch : rs+    let hChTruncated = hash usedHash $ B.concat $ reverse rmsgs         binderKey = deriveSecret usedHash sec "res binder" (hash usedHash "")     return $ makeVerifyData usedHash binderKey hChTruncated   where@@ -423,6 +425,7 @@             Right (Handshake13 []) -> error "invalid recvPacket13 result"             Right (Handshake13 (h : hs)) -> found h hs             Right ChangeCipherSpec13 -> recvLoop+            Right (Alert13 _) -> throwCore Error_TCP_Terminate             Right x -> unexpected (show x) (Just "handshake 13")             Left err -> throwCore err 

@@ -176,4 +176,4 @@                 (label, key) = labelAndKey logkey             ctxKeyLogger ctx $ label ++ " " ++ dump cr ++ " " ++ dump key   where-    dump = init . tail . showBytesHex+    dump = init . drop 1 . showBytesHex

@@ -25,7 +25,6 @@ import Network.TLS.State import Network.TLS.Struct import Network.TLS.Struct13-import Network.TLS.Types  -- Put the server context in handshake mode. --@@ -69,7 +68,7 @@                     recvClientSecondFlight13 sparams ctx r1 ch         else do             r <--                processClinetHello12 sparams ctx ch+                processClientHello12 sparams ctx ch             resumeSessionData <-                 sendServerHello12 sparams ctx r ch             recvClientSecondFlight12 sparams ctx resumeSessionData

@@ -4,15 +4,16 @@     processClientHello, ) where +import Network.TLS.Compression import Network.TLS.Context.Internal import Network.TLS.Extension-import Network.TLS.Handshake.Common import Network.TLS.Handshake.Process import Network.TLS.Imports import Network.TLS.Measurement import Network.TLS.Parameters import Network.TLS.State import Network.TLS.Struct+import Network.TLS.Types  processClientHello     :: ServerParams -> Context -> Handshake -> IO (Version, CH)@@ -51,16 +52,15 @@     -- TLS_FALLBACK_SCSV: {0x56, 0x00}     when         ( supportedFallbackScsv (ctxSupported ctx)-            && (0x5600 `elem` chCiphers)+            && (CipherId 0x5600 `elem` chCiphers)             && legacyVersion < TLS12         )         $ throwCore         $ Error_Protocol "fallback is not allowed" InappropriateFallback     -- choosing TLS version-    let clientVersions = case extensionLookup EID_SupportedVersions chExtensions-            >>= extensionDecode MsgTClientHello of-            Just (SupportedVersionsClientHello vers) -> vers -- fixme: vers == []-            _ -> []+    let extract (SupportedVersionsClientHello vers) = vers -- fixme: vers == []+        extract _ = []+        clientVersions = lookupAndDecode EID_SupportedVersions MsgTClientHello chExtensions [] extract         clientVersion = min TLS12 legacyVersion         serverVersions             | renegotiation = filter (< TLS13) (supportedVersions $ ctxSupported ctx)@@ -86,15 +86,29 @@                     Just v -> return v      -- SNI (Server Name Indication)-    let serverName = case extensionLookup EID_ServerName chExtensions >>= extensionDecode MsgTClientHello of-            Just (ServerName ns) -> listToMaybe (mapMaybe toHostName ns)-              where-                toHostName (ServerNameHostName hostName) = Just hostName-                toHostName (ServerNameOther _) = Nothing-            _ -> Nothing-    when (chosenVersion == TLS13) $ do-        -- If this is done for TLS12, SSL Labs test does not continue, sigh.-        mapM_ ensureNullCompression compressions+    let extractServerName (ServerName ns) = listToMaybe (mapMaybe toHostName ns)+        toHostName (ServerNameHostName hostName) = Just hostName+        toHostName (ServerNameOther _) = Nothing+        serverName =+            lookupAndDecode+                EID_ServerName+                MsgTClientHello+                chExtensions+                Nothing+                extractServerName+    let nullComp = compressionID nullCompression+    case chosenVersion of+        TLS13 ->+            when (compressions /= [nullComp]) $+                throwCore $+                    Error_Protocol "compression is not allowed in TLS 1.3" IllegalParameter+        _ -> case find (== nullComp) compressions of+            Nothing ->+                throwCore $+                    Error_Protocol+                        "compressions must include nullCompression in TLS 1.2"+                        IllegalParameter+            _ -> return ()     maybe (return ()) (usingState_ ctx . setClientSNI) serverName     return (chosenVersion, ch) processClientHello _ _ _ =

@@ -2,7 +2,7 @@ {-# LANGUAGE RecordWildCards #-}  module Network.TLS.Handshake.Server.ClientHello12 (-    processClinetHello12,+    processClientHello12, ) where  import Network.TLS.Cipher@@ -11,50 +11,52 @@ import Network.TLS.Crypto import Network.TLS.ErrT import Network.TLS.Extension-import Network.TLS.Handshake.Common import Network.TLS.Handshake.Server.Common import Network.TLS.Handshake.Signature import Network.TLS.Imports import Network.TLS.Parameters import Network.TLS.State import Network.TLS.Struct-import Network.TLS.Types (Role (..))+import Network.TLS.Types (CipherId (..), Role (..))  ---------------------------------------------------------------- +-- serverSupported sparams == ctxSupported ctx+ -- TLS 1.2 or earlier-processClinetHello12+processClientHello12     :: ServerParams     -> Context     -> CH     -> IO (Cipher, Maybe Credential)-processClinetHello12 sparams ctx ch = do-    let secureRenegotiation = supportedSecureRenegotiation $ ctxSupported ctx-    when secureRenegotiation $ checkSesecureRenegotiation ctx ch+processClientHello12 sparams ctx ch = do+    let secureRenegotiation = supportedSecureRenegotiation $ serverSupported sparams+    when secureRenegotiation $ checkSecureRenegotiation ctx ch     serverName <- usingState_ ctx getClientSNI-    extraCreds <- onServerNameIndication (serverHooks sparams) serverName+    let hooks = serverHooks sparams+    extraCreds <- onServerNameIndication hooks serverName     let (creds, signatureCreds, ciphersFilteredVersion) =-            credsTriple sparams ctx ch extraCreds+            credsTriple sparams ch extraCreds     -- The shared cipherlist can become empty after filtering for compatible     -- creds, check now before calling onCipherChoosing, which does not handle     -- empty lists.     when (null ciphersFilteredVersion) $         throwCore $             Error_Protocol "no cipher in common with the TLS 1.2 client" HandshakeFailure-    let usedCipher = onCipherChoosing (serverHooks sparams) TLS12 ciphersFilteredVersion+    let usedCipher = onCipherChoosing hooks TLS12 ciphersFilteredVersion     mcred <- chooseCreds usedCipher creds signatureCreds     return (usedCipher, mcred) -checkSesecureRenegotiation :: Context -> CH -> IO ()-checkSesecureRenegotiation ctx CH{..} = do+checkSecureRenegotiation :: Context -> CH -> IO ()+checkSecureRenegotiation ctx CH{..} = do     -- RFC 5746: secure renegotiation     -- TLS_EMPTY_RENEGOTIATION_INFO_SCSV: {0x00, 0xFF}-    when (0xff `elem` chCiphers) $+    when (CipherId 0xff `elem` chCiphers) $         usingState_ ctx $             setSecureRenegotiation True     case extensionLookup EID_SecureRenegotiation chExtensions of         Just content -> usingState_ ctx $ do-            cvd <- getVerifyData ClientRole+            VerifyData cvd <- getVerifyData ClientRole             let bs = extensionEncode (SecureRenegotiation cvd "")             unless (bs == content) $                 throwError $@@ -69,19 +71,22 @@  credsTriple     :: ServerParams-    -> Context     -> CH     -> Credentials     -> (Credentials, Credentials, [Cipher])-credsTriple sparams ctx CH{..} extraCreds+credsTriple sparams CH{..} extraCreds     | cipherListCredentialFallback cltCiphers = (allCreds, sigAllCreds, allCiphers)     | otherwise = (cltCreds, sigCltCreds, cltCiphers)   where-    commonCiphers creds sigCreds = filter ((`elem` chCiphers) . cipherID) (getCiphers sparams creds sigCreds)+    ciphers = supportedCiphers $ serverSupported sparams +    commonCiphers creds sigCreds = intersectCiphers chCiphers availableCiphers+      where+        availableCiphers = getCiphers ciphers creds sigCreds+     allCreds =         filterCredentials (isCredentialAllowed TLS12 chExtensions) $-            extraCreds `mappend` sharedCredentials (ctxShared ctx)+            extraCreds `mappend` sharedCredentials (serverShared sparams)      -- When selecting a cipher we must ensure that it is allowed for the     -- TLS version but also that all its key-exchange requirements@@ -98,7 +103,9 @@     -- negotiated signature parameters.  Then ciphers are evalutated from     -- the resulting credentials. -    possibleGroups = negotiatedGroupsInCommon ctx chExtensions+    supported = serverSupported sparams+    groups = supportedGroups supported+    possibleGroups = negotiatedGroupsInCommon groups chExtensions     possibleECGroups = possibleGroups `intersect` availableECGroups     possibleFFGroups = possibleGroups `intersect` availableFFGroups     hasCommonGroupForECDHE = not (null possibleECGroups)@@ -121,7 +128,8 @@      -- Build a list of all hash/signature algorithms in common between     -- client and server.-    possibleHashSigAlgs = hashAndSignaturesInCommon ctx chExtensions+    hashAndSignatures = supportedHashSignatures supported+    possibleHashSigAlgs = hashAndSignaturesInCommon hashAndSignatures chExtensions      -- Check that a candidate signature credential will be compatible with     -- client & server hash/signature algorithms.  This returns Just Int@@ -162,32 +170,14 @@  ---------------------------------------------------------------- -hashAndSignaturesInCommon-    :: Context -> [ExtensionRaw] -> [HashAndSignatureAlgorithm]-hashAndSignaturesInCommon ctx exts =-    let cHashSigs = case extensionLookup EID_SignatureAlgorithms exts-            >>= extensionDecode MsgTClientHello of-            -- See Section 7.4.1.4.1 of RFC 5246.-            Nothing ->-                [ (HashSHA1, SignatureECDSA)-                , (HashSHA1, SignatureRSA)-                , (HashSHA1, SignatureDSA)-                ]-            Just (SignatureAlgorithms sas) -> sas-        sHashSigs = supportedHashSignatures $ ctxSupported ctx-     in -- The values in the "signature_algorithms" extension-        -- are in descending order of preference.-        -- However here the algorithms are selected according-        -- to server preference in 'supportedHashSignatures'.-        sHashSigs `intersect` cHashSigs--negotiatedGroupsInCommon :: Context -> [ExtensionRaw] -> [Group]-negotiatedGroupsInCommon ctx exts = case extensionLookup EID_SupportedGroups exts-    >>= extensionDecode MsgTClientHello of-    Just (SupportedGroups clientGroups) ->-        let serverGroups = supportedGroups (ctxSupported ctx)-         in serverGroups `intersect` clientGroups-    _ -> []+negotiatedGroupsInCommon :: [Group] -> [ExtensionRaw] -> [Group]+negotiatedGroupsInCommon serverGroups exts =+    lookupAndDecode+        EID_SupportedGroups+        MsgTClientHello+        exts+        []+        (\(SupportedGroups clientGroups) -> serverGroups `intersect` clientGroups)  ---------------------------------------------------------------- @@ -217,8 +207,8 @@ -- subset of this list named 'sigCreds'.  This list has been filtered in order -- to remove certificates that are not compatible with hash/signature -- restrictions (TLS 1.2).-getCiphers :: ServerParams -> Credentials -> Credentials -> [Cipher]-getCiphers sparams creds sigCreds = filter authorizedCKE (supportedCiphers $ serverSupported sparams)+getCiphers :: [Cipher] -> Credentials -> Credentials -> [Cipher]+getCiphers ciphers creds sigCreds = filter authorizedCKE ciphers   where     authorizedCKE cipher =         case cipherKeyExchange cipher of

@@ -10,7 +10,6 @@ import Network.TLS.Context.Internal import Network.TLS.Crypto import Network.TLS.Extension-import Network.TLS.Handshake.Common import Network.TLS.Handshake.Common13 import Network.TLS.Handshake.Random import Network.TLS.Handshake.State@@ -21,6 +20,7 @@ import Network.TLS.State import Network.TLS.Struct import Network.TLS.Struct13+import Network.TLS.Types  -- TLS 1.3 or later processClientHello13@@ -42,30 +42,31 @@             Error_Protocol "no cipher in common with the TLS 1.3 client" HandshakeFailure     let usedCipher = onCipherChoosing (serverHooks sparams) TLS13 ciphersFilteredVersion         usedHash = cipherHash usedCipher-        rtt0 = case extensionLookup EID_EarlyData chExtensions >>= extensionDecode MsgTClientHello of-            Just (EarlyDataIndication _) -> True-            Nothing -> False+        rtt0 =+            lookupAndDecode+                EID_EarlyData+                MsgTClientHello+                chExtensions+                False+                (\(EarlyDataIndication _) -> True)     when rtt0 $         -- mark a 0-RTT attempt before a possible HRR, and before updating the         -- status again if 0-RTT successful         setEstablished ctx (EarlyDataNotAllowed 3) -- hardcoding         -- Deciding key exchange from key shares-    keyShares <- case extensionLookup EID_KeyShare chExtensions of-        Nothing ->+    let require =             throwCore $                 Error_Protocol                     "key exchange not implemented, expected key_share extension"                     MissingExtension-        Just kss -> case extensionDecode MsgTClientHello kss of-            Just (KeyShareClientHello kses) -> return kses-            Just _ ->-                error "processClientHello13: invalid KeyShare value"-            _ ->-                throwCore $ Error_Protocol "broken key_share" DecodeError+        extract (KeyShareClientHello kses) = return kses+        extract _ = require+    keyShares <-+        lookupAndDecodeAndDo EID_KeyShare MsgTClientHello chExtensions require extract     mshare <- findKeyShare keyShares serverGroups     return (mshare, (usedCipher, usedHash, rtt0))   where-    ciphersFilteredVersion = filter ((`elem` chCiphers) . cipherID) serverCiphers+    ciphersFilteredVersion = intersectCiphers chCiphers serverCiphers     serverCiphers =         filter             (cipherAllowedForVersion TLS13)@@ -94,10 +95,13 @@             Error_Protocol "Hello retry not allowed again" HandshakeFailure     usingState_ ctx $ setTLS13HRR True     failOnEitherError $ usingHState ctx $ setHelloParameters13 usedCipher-    let clientGroups = case extensionLookup EID_SupportedGroups chExtensions-            >>= extensionDecode MsgTClientHello of-            Just (SupportedGroups gs) -> gs-            Nothing -> []+    let clientGroups =+            lookupAndDecode+                EID_SupportedGroups+                MsgTClientHello+                chExtensions+                []+                (\(SupportedGroups gs) -> gs)         possibleGroups = serverGroups `intersect` clientGroups     case possibleGroups of         [] ->@@ -110,7 +114,7 @@                     [ ExtensionRaw EID_KeyShare serverKeyShare                     , ExtensionRaw EID_SupportedVersions selectedVersion                     ]-                hrr = ServerHello13 hrrRandom chSession (cipherID usedCipher) extensions+                hrr = ServerHello13 hrrRandom chSession (CipherId $ cipherID usedCipher) extensions             usingHState ctx $ setTLS13HandshakeMode HelloRetryRequest             runPacketFlight ctx $ do                 loadPacket13 ctx $ Handshake13 [hrr]

@@ -9,6 +9,7 @@     filterCredentialsWithHashSignatures,     isCredentialAllowed,     storePrivInfoServer,+    hashAndSignaturesInCommon, ) where  import Control.Monad.State.Strict@@ -59,10 +60,13 @@     -- not after.  With TLS13, the curve is linked to the signature algorithm     -- and client support is tested with signatureCompatible13.     p-        | ver < TLS13 = case extensionLookup EID_SupportedGroups exts-            >>= extensionDecode MsgTClientHello of-            Nothing -> const True-            Just (SupportedGroups sg) -> (`elem` sg)+        | ver < TLS13 =+            lookupAndDecode+                EID_SupportedGroups+                MsgTClientHello+                exts+                (const True)+                (\(SupportedGroups sg) -> (`elem` sg))         | otherwise = const True  -- Filters a list of candidate credentials with credentialMatchesHashSignatures.@@ -86,42 +90,52 @@ filterCredentialsWithHashSignatures     :: [ExtensionRaw] -> Credentials -> Credentials filterCredentialsWithHashSignatures exts =-    case withExt EID_SignatureAlgorithmsCert of-        Just (SignatureAlgorithmsCert sas) -> withAlgs sas-        Nothing ->-            case withExt EID_SignatureAlgorithms of-                Nothing -> id-                Just (SignatureAlgorithms sas) -> withAlgs sas+    lookupAndDecode+        EID_SignatureAlgorithmsCert+        MsgTClientHello+        exts+        lookupSignatureAlgorithms+        (\(SignatureAlgorithmsCert sas) -> withAlgs sas)   where-    withExt extId = extensionLookup extId exts >>= extensionDecode MsgTClientHello+    lookupSignatureAlgorithms =+        lookupAndDecode+            EID_SignatureAlgorithms+            MsgTClientHello+            exts+            id+            (\(SignatureAlgorithms sas) -> withAlgs sas)     withAlgs sas = filterCredentials (credentialMatchesHashSignatures sas)  storePrivInfoServer :: MonadIO m => Context -> Credential -> m () storePrivInfoServer ctx (cc, privkey) = void (storePrivInfo ctx cc privkey) +-- ALPN (Application Layer Protocol Negotiation) applicationProtocol-    :: Context -> [ExtensionRaw] -> ServerParams -> IO [ExtensionRaw]-applicationProtocol ctx exts sparams = do-    -- ALPN (Application Layer Protocol Negotiation)-    case extensionLookup EID_ApplicationLayerProtocolNegotiation exts-        >>= extensionDecode MsgTClientHello of-        Nothing -> return []-        Just (ApplicationLayerProtocolNegotiation protos) -> do-            case onALPNClientSuggest $ serverHooks sparams of-                Just io -> do-                    proto <- io protos-                    when (proto == "") $-                        throwCore $-                            Error_Protocol "no supported application protocols" NoApplicationProtocol-                    usingState_ ctx $ do-                        setExtensionALPN True-                        setNegotiatedProtocol proto-                    return-                        [ ExtensionRaw-                            EID_ApplicationLayerProtocolNegotiation-                            (extensionEncode $ ApplicationLayerProtocolNegotiation [proto])-                        ]-                _ -> return []+    :: Context -> [ExtensionRaw] -> ServerParams -> IO (Maybe ExtensionRaw)+applicationProtocol ctx exts sparams = case onALPN of+    Nothing -> return Nothing+    Just io ->+        lookupAndDecodeAndDo+            EID_ApplicationLayerProtocolNegotiation+            MsgTClientHello+            exts+            (return Nothing)+            $ select io+  where+    onALPN = onALPNClientSuggest $ serverHooks sparams+    select io (ApplicationLayerProtocolNegotiation protos) = do+        proto <- io protos+        when (proto == "") $+            throwCore $+                Error_Protocol "no supported application protocols" NoApplicationProtocol+        usingState_ ctx $ do+            setExtensionALPN True+            setNegotiatedProtocol proto+        return $+            Just $+                ExtensionRaw+                    EID_ApplicationLayerProtocolNegotiation+                    (extensionEncode $ ApplicationLayerProtocolNegotiation [proto])  clientCertificate :: ServerParams -> Context -> CertificateChain -> IO () clientCertificate sparams ctx certs = do@@ -142,3 +156,27 @@     -- Remember cert chain for later use.     --     usingHState ctx $ setClientCertChain certs++----------------------------------------------------------------++-- The values in the "signature_algorithms" extension+-- are in descending order of preference.+-- However here the algorithms are selected according+-- to server preference in 'supportedHashSignatures'.+hashAndSignaturesInCommon+    :: [HashAndSignatureAlgorithm] -> [ExtensionRaw] -> [HashAndSignatureAlgorithm]+hashAndSignaturesInCommon sHashSigs exts = sHashSigs `intersect` cHashSigs+  where+    -- See Section 7.4.1.4.1 of RFC 5246.+    defVal =+        [ (HashSHA1, SignatureECDSA)+        , (HashSHA1, SignatureRSA)+        , (HashSHA1, SignatureDSA)+        ]+    cHashSigs =+        lookupAndDecode+            EID_SignatureAlgorithms+            MsgTClientHello+            exts+            defVal+            (\(SignatureAlgorithms sas) -> sas)

@@ -62,34 +62,40 @@ recoverSessionData ctx CH{..} = do     serverName <- usingState_ ctx getClientSNI     ems <- processExtendedMainSecret ctx TLS12 MsgTClientHello chExtensions-    let mSessionTicket =-            extensionLookup EID_SessionTicket chExtensions-                >>= extensionDecode MsgTClientHello-        mticket = case mSessionTicket of-            Nothing -> Nothing-            Just (SessionTicket ticket) -> Just ticket+    let mticket =+            lookupAndDecode+                EID_SessionTicket+                MsgTClientHello+                chExtensions+                Nothing+                (\(SessionTicket ticket) -> Just ticket)         midentity = ticketOrSessionID12 mticket chSession     case midentity of         Nothing -> return Nothing         Just identity -> do             sd <- sessionResume (sharedSessionManager $ ctxShared ctx) identity-            validateSession chCiphers serverName ems sd+            validateSession ctx chCiphers serverName ems sd  validateSession-    :: [CipherID]+    :: Context+    -> [CipherId]     -> Maybe HostName     -> Bool     -> Maybe SessionData     -> IO (Maybe SessionData)-validateSession _ _ _ Nothing = return Nothing-validateSession ciphers sni ems m@(Just sd)+validateSession _ _ _ _ Nothing = return Nothing+validateSession ctx ciphers sni ems m@(Just sd)     -- SessionData parameters are assumed to match the local server configuration     -- so we need to compare only to ClientHello inputs.  Abbreviated handshake     -- uses the same server_name than full handshake so the same     -- credentials (and thus ciphers) are available.     | TLS12 < sessionVersion sd = return Nothing -- fixme-    | sessionCipher sd `notElem` ciphers = return Nothing-    | isJust sni && sessionClientSNI sd /= sni = return Nothing+    | CipherId (sessionCipher sd) `notElem` ciphers =+        throwCore $+            Error_Protocol "new cipher is diffrent from the old one" IllegalParameter+    | isJust sni && sessionClientSNI sd /= sni = do+        usingState_ ctx clearClientSNI+        return Nothing     | ems && not emsSession = return Nothing     | not ems && emsSession =         let err = "client resumes an EMS session without EMS"@@ -110,7 +116,7 @@     let cc = case mcred of             Just (srvCerts, _) -> srvCerts             _ -> CertificateChain []-    let b1 = b0 . (Certificate cc :)+    let b1 = b0 . (Certificate (TLSCertificateChain cc) :)     usingState_ ctx $ setServerCertificateChain cc      -- send server key exchange if needed@@ -176,7 +182,7 @@     -- If RSA is also used for key exchange, this function is     -- not called.     decideHashSig pubKey = do-        let hashSigs = hashAndSignaturesInCommon ctx chExts+        let hashSigs = hashAndSignaturesInCommon (supportedHashSignatures $ ctxSupported ctx) chExts         case filter (pubKey `signatureCompatible`) hashSigs of             [] -> error ("no hash signature for " ++ pubkeyType pubKey)             x : _ -> return x@@ -245,21 +251,19 @@         if secReneg             then do                 vd <- usingState_ ctx $ do-                    cvd <- getVerifyData ClientRole-                    svd <- getVerifyData ServerRole-                    return $ extensionEncode $ SecureRenegotiation cvd svd-                return [ExtensionRaw EID_SecureRenegotiation vd]-            else return []+                    VerifyData cvd <- getVerifyData ClientRole+                    VerifyData svd <- getVerifyData ServerRole+                    return $ SecureRenegotiation cvd svd+                return $ Just $ toExtensionRaw vd+            else return Nothing     ems <- usingHState ctx getExtendedMainSecret     let emsExt-            | ems =-                let raw = extensionEncode ExtendedMainSecret-                 in [ExtensionRaw EID_ExtendedMainSecret raw]-            | otherwise = []+            | ems = Just $ toExtensionRaw ExtendedMainSecret+            | otherwise = Nothing     protoExt <- applicationProtocol ctx chExts sparams     sniExt <- do         if resuming-            then return []+            then return Nothing             else do                 msni <- usingState_ ctx getClientSNI                 case msni of@@ -267,21 +271,25 @@                     -- an extension of type "server_name" in the                     -- (extended) server hello. The "extension_data"                     -- field of this extension SHALL be empty.-                    Just _ -> return [ExtensionRaw EID_ServerName ""]-                    Nothing -> return []+                    Just _ -> return $ Just $ toExtensionRaw $ ServerName []+                    Nothing -> return Nothing     let useTicket = sessionUseTicket $ sharedSessionManager $ serverShared sparams         ticktExt-            | not resuming && useTicket =-                let raw = extensionEncode $ SessionTicket ""-                 in [ExtensionRaw EID_SessionTicket raw]-            | otherwise = []+            | not resuming && useTicket = Just $ toExtensionRaw $ SessionTicket ""+            | otherwise = Nothing+    let eccExt = case extensionLookup EID_EcPointFormats chExts of+            Nothing -> Nothing+            Just _ -> Just $ toExtensionRaw $ EcPointFormatsSupported [EcPointFormat_Uncompressed]     let shExts =             sharedHelloExtensions (serverShared sparams)-                ++ secRengExt-                ++ emsExt-                ++ protoExt-                ++ sniExt-                ++ ticktExt+                ++ catMaybes+                    [ secRengExt+                    , emsExt+                    , protoExt+                    , sniExt+                    , ticktExt+                    , eccExt+                    ]     usingState_ ctx $ setVersion TLS12     usingHState ctx $         setServerHelloParameters TLS12 srand usedCipher nullCompression@@ -290,33 +298,18 @@             TLS12             srand             session-            (cipherID usedCipher)+            (CipherId (cipherID usedCipher))             (compressionID nullCompression)             shExts -hashAndSignaturesInCommon-    :: Context -> [ExtensionRaw] -> [HashAndSignatureAlgorithm]-hashAndSignaturesInCommon ctx chExts =-    let cHashSigs = case extensionLookup EID_SignatureAlgorithms chExts-            >>= extensionDecode MsgTClientHello of-            -- See Section 7.4.1.4.1 of RFC 5246.-            Nothing ->-                [ (HashSHA1, SignatureECDSA)-                , (HashSHA1, SignatureRSA)-                , (HashSHA1, SignatureDSA)-                ]-            Just (SignatureAlgorithms sas) -> sas-        sHashSigs = supportedHashSignatures $ ctxSupported ctx-     in -- The values in the "signature_algorithms" extension-        -- are in descending order of preference.-        -- However here the algorithms are selected according-        -- to server preference in 'supportedHashSignatures'.-        sHashSigs `intersect` cHashSigs- negotiatedGroupsInCommon :: Context -> [ExtensionRaw] -> [Group]-negotiatedGroupsInCommon ctx chExts = case extensionLookup EID_SupportedGroups chExts-    >>= extensionDecode MsgTClientHello of-    Just (SupportedGroups clientGroups) ->-        let serverGroups = supportedGroups (ctxSupported ctx)-         in serverGroups `intersect` clientGroups-    _ -> []+negotiatedGroupsInCommon ctx chExts =+    lookupAndDecode+        EID_SupportedGroups+        MsgTClientHello+        chExts+        []+        common+  where+    serverGroups = supportedGroups (ctxSupported ctx)+    common (SupportedGroups clientGroups) = serverGroups `intersect` clientGroups

@@ -134,49 +134,59 @@         failOnEitherError $ usingHState ctx $ setHelloParameters13 usedCipher         return srand -    supportsPHA = case extensionLookup EID_PostHandshakeAuth chExtensions-        >>= extensionDecode MsgTClientHello of-        Just PostHandshakeAuth -> True-        Nothing -> False+    supportsPHA =+        lookupAndDecode+            EID_PostHandshakeAuth+            MsgTClientHello+            chExtensions+            False+            (\PostHandshakeAuth -> True) -    choosePSK = case extensionLookup EID_PreSharedKey chExtensions-        >>= extensionDecode MsgTClientHello of-        Just (PreSharedKeyClientHello (PskIdentity identity obfAge : _) bnds@(bnd : _)) -> do-            when (null dhModes) $-                throwCore $-                    Error_Protocol "no psk_key_exchange_modes extension" MissingExtension-            if PSK_DHE_KE `elem` dhModes-                then do-                    let len = sum (map (\x -> B.length x + 1) bnds) + 2-                        mgr = sharedSessionManager $ serverShared sparams-                    -- sessionInvalidate is not used for TLS 1.3-                    -- because PSK is always changed.-                    -- So, identity is not stored in Context.-                    msdata <--                        if rtt0-                            then sessionResumeOnlyOnce mgr identity-                            else sessionResume mgr identity-                    case msdata of-                        Just sdata -> do-                            let tinfo = fromJust $ sessionTicketInfo sdata-                                psk = sessionSecret sdata-                            isFresh <- checkFreshness tinfo obfAge-                            (isPSKvalid, is0RTTvalid) <- checkSessionEquality sdata-                            if isPSKvalid && isFresh-                                then return (psk, Just (bnd, 0 :: Int, len), is0RTTvalid)-                                else -- fall back to full handshake-                                    return (zero, Nothing, False)-                        _ -> return (zero, Nothing, False)-                else return (zero, Nothing, False)-        _ -> return (zero, Nothing, False)+    selectPSK (PreSharedKeyClientHello (PskIdentity identity obfAge : _) bnds@(bnd : _)) = do+        when (null dhModes) $+            throwCore $+                Error_Protocol "no psk_key_exchange_modes extension" MissingExtension+        if PSK_DHE_KE `elem` dhModes+            then do+                let len = sum (map (\x -> B.length x + 1) bnds) + 2+                    mgr = sharedSessionManager $ serverShared sparams+                -- sessionInvalidate is not used for TLS 1.3+                -- because PSK is always changed.+                -- So, identity is not stored in Context.+                msdata <-+                    if rtt0+                        then sessionResumeOnlyOnce mgr identity+                        else sessionResume mgr identity+                case msdata of+                    Just sdata -> do+                        let tinfo = fromJust $ sessionTicketInfo sdata+                            psk = sessionSecret sdata+                        isFresh <- checkFreshness tinfo obfAge+                        (isPSKvalid, is0RTTvalid) <- checkSessionEquality sdata+                        if isPSKvalid && isFresh+                            then return (psk, Just (bnd, 0 :: Int, len), is0RTTvalid)+                            else -- fall back to full handshake+                                return (zero, Nothing, False)+                    _ -> return (zero, Nothing, False)+            else return (zero, Nothing, False)+    selectPSK _ = return (zero, Nothing, False) +    choosePSK =+        lookupAndDecodeAndDo+            EID_PreSharedKey+            MsgTClientHello+            chExtensions+            (return (zero, Nothing, False))+            selectPSK+     checkSessionEquality sdata = do         msni <- usingState_ ctx getClientSNI         malpn <- usingState_ ctx getNegotiatedProtocol         let isSameSNI = sessionClientSNI sdata == msni             isSameCipher = sessionCipher sdata == cipherID usedCipher             ciphers = supportedCiphers $ serverSupported sparams-            isSameKDF = case find (\c -> cipherID c == sessionCipher sdata) ciphers of+            scid = sessionCipher sdata+            isSameKDF = case findCipher scid ciphers of                 Nothing -> False                 Just c -> cipherHash c == cipherHash usedCipher             isSameVersion = TLS13 == sessionVersion sdata@@ -193,17 +203,18 @@         binder' <- makePSKBinder ctx earlySecret usedHash tlen Nothing         unless (binder == binder') $             decryptError "PSK binder validation failed"-        let selectedIdentity = extensionEncode $ PreSharedKeyServerHello $ fromIntegral n-        return [ExtensionRaw EID_PreSharedKey selectedIdentity]+        return [toExtensionRaw $ PreSharedKeyServerHello $ fromIntegral n]      decideCredentialInfo allCreds = do-        cHashSigs <- case extensionLookup EID_SignatureAlgorithms chExtensions of-            Nothing ->-                throwCore $ Error_Protocol "no signature_algorithms extension" MissingExtension-            Just sa -> case extensionDecode MsgTClientHello sa of-                Nothing ->-                    throwCore $ Error_Protocol "broken signature_algorithms extension" DecodeError-                Just (SignatureAlgorithms sas) -> return sas+        let err =+                throwCore $ Error_Protocol "broken signature_algorithms extension" DecodeError+        cHashSigs <-+            lookupAndDecodeAndDo+                EID_SignatureAlgorithms+                MsgTClientHello+                chExtensions+                err+                (\(SignatureAlgorithms sas) -> return sas)         -- When deciding signature algorithm and certificate, 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@@ -219,13 +230,11 @@             mcs -> return mcs      sendServerHello keyShare srand extensions = do-        let serverKeyShare = extensionEncode $ KeyShareServerHello keyShare-            selectedVersion = extensionEncode $ SupportedVersionsServerHello TLS13-            extensions' =-                ExtensionRaw EID_KeyShare serverKeyShare-                    : ExtensionRaw EID_SupportedVersions selectedVersion+        let extensions' =+                toExtensionRaw (KeyShareServerHello keyShare)+                    : toExtensionRaw (SupportedVersionsServerHello TLS13)                     : extensions-            helo = ServerHello13 srand chSession (cipherID usedCipher) extensions'+            helo = ServerHello13 srand chSession (CipherId (cipherID usedCipher)) extensions'         loadPacket13 ctx $ Handshake13 [helo]      sendCertAndVerify cred@(certChain, _) hashSig = do@@ -238,7 +247,8 @@          let CertificateChain cs = certChain             ess = replicate (length cs) []-        loadPacket13 ctx $ Handshake13 [Certificate13 "" certChain ess]+        loadPacket13 ctx $+            Handshake13 [Certificate13 "" (TLSCertificateChain certChain) ess]         liftIO $ usingState_ ctx $ setServerCertificateChain certChain         hChSc <- transcriptHash ctx         pubkey <- getLocalPublicKey ctx@@ -252,22 +262,19 @@                 -- an extension of type "server_name" in the                 -- (extended) server hello. The "extension_data"                 -- field of this extension SHALL be empty.-                Just _ -> Just $ ExtensionRaw EID_ServerName ""+                Just _ -> Just $ toExtensionRaw $ ServerName []                 Nothing -> Nothing         mgroup <- usingHState ctx getSupportedGroup         let serverGroups = supportedGroups (ctxSupported ctx)-            groupExtension-                | null serverGroups = Nothing-                | maybe True (== head serverGroups) mgroup = Nothing-                | otherwise =-                    Just $-                        ExtensionRaw EID_SupportedGroups $-                            extensionEncode (SupportedGroups serverGroups)+            groupExtension = case serverGroups of+                [] -> Nothing+                rg : _ -> case mgroup of+                    Nothing -> Nothing+                    Just grp+                        | grp == rg -> Nothing+                        | otherwise -> Just $ toExtensionRaw $ SupportedGroups serverGroups         let earlyDataExtension-                | rtt0OK =-                    Just $-                        ExtensionRaw EID_EarlyData $-                            extensionEncode (EarlyDataIndication Nothing)+                | rtt0OK = Just $ toExtensionRaw $ EarlyDataIndication Nothing                 | otherwise = Nothing         let extensions =                 sharedHelloExtensions (serverShared sparams)@@ -275,16 +282,19 @@                         [ earlyDataExtension                         , groupExtension                         , sniExtension+                        , protoExt                         ]-                    ++ protoExt         extensions' <-             liftIO $ onEncryptedExtensionsCreating (serverHooks sparams) extensions         loadPacket13 ctx $ Handshake13 [EncryptedExtensions13 extensions'] -    dhModes = case extensionLookup EID_PskKeyExchangeModes chExtensions-        >>= extensionDecode MsgTClientHello of-        Just (PskKeyExchangeModes ms) -> ms-        Nothing -> []+    dhModes =+        lookupAndDecode+            EID_PskKeyExchangeModes+            MsgTClientHello+            chExtensions+            []+            (\(PskKeyExchangeModes ms) -> ms)      hashSize = hashDigestSize usedHash     zero = B.replicate hashSize 0

@@ -83,7 +83,7 @@ recvClientCCC :: ServerParams -> Context -> IO () recvClientCCC sparams ctx = runRecvState ctx (RecvStateHandshake expectClientCertificate)   where-    expectClientCertificate (Certificate certs) = do+    expectClientCertificate (Certificate (TLSCertificateChain certs)) = do         clientCertificate sparams ctx certs         processCertificate ctx ServerRole certs @@ -135,15 +135,17 @@     (rver, role, random) <- usingState_ ctx $ do         (,,) <$> getVersion <*> getRole <*> genRandom 48     ePreMain <- decryptRSA ctx encryptedPreMain-    mainSecret <- usingHState ctx $ do-        expectedVer <- gets hstClientVersion-        case ePreMain of-            Left _ -> setMainSecretFromPre rver role random-            Right preMain -> case decodePreMainSecret preMain of-                Left _ -> setMainSecretFromPre rver role random-                Right (ver, _)-                    | ver /= expectedVer -> setMainSecretFromPre rver role random-                    | otherwise -> setMainSecretFromPre rver role preMain+    expectedVer <- usingHState ctx $ gets hstClientVersion+    mainSecret <- case ePreMain of+        Left _ ->+            -- BadRecordMac is nonsense but for tlsfuzzer+            throwCore $+                Error_Protocol "invalid client public key" BadRecordMac+        Right preMain -> case decodePreMainSecret preMain of+            Left _ -> usingHState ctx $ setMainSecretFromPre rver role random+            Right (ver, _)+                | ver /= expectedVer -> usingHState ctx $ setMainSecretFromPre rver role random+                | otherwise -> usingHState ctx $ setMainSecretFromPre rver role preMain     logKey ctx (MainSecret mainSecret) processClientKeyXchg ctx (CKX_DH clientDHValue) = do     rver <- usingState_ ctx getVersion

@@ -95,7 +95,7 @@  expectCertificate     :: MonadIO m => ServerParams -> Context -> Handshake13 -> m Bool-expectCertificate sparams ctx (Certificate13 certCtx certs _ext) = liftIO $ do+expectCertificate sparams ctx (Certificate13 certCtx (TLSCertificateChain certs) _ext) = liftIO $ do     when (certCtx /= "") $         throwCore $             Error_Protocol "certificate request context MUST be empty" IllegalParameter@@ -153,7 +153,7 @@  expectCertVerify     :: MonadIO m => ServerParams -> Context -> ByteString -> Handshake13 -> m ()-expectCertVerify sparams ctx hChCc (CertVerify13 sigAlg sig) = liftIO $ do+expectCertVerify sparams ctx hChCc (CertVerify13 (DigitallySigned sigAlg sig)) = liftIO $ do     certs@(CertificateChain cc) <-         checkValidClientCertChain ctx "finished 13 message expected"     pubkey <- case cc of@@ -192,7 +192,7 @@                 else decryptError "verification failed"  postHandshakeAuthServerWith :: ServerParams -> Context -> Handshake13 -> IO ()-postHandshakeAuthServerWith sparams ctx h@(Certificate13 certCtx certs _ext) = do+postHandshakeAuthServerWith sparams ctx h@(Certificate13 certCtx (TLSCertificateChain certs) _ext) = do     mCertReq <- getCertRequest13 ctx certCtx     when (isNothing mCertReq) $         throwCore $

@@ -0,0 +1,145 @@+{-# LANGUAGE PatternSynonyms #-}++module Network.TLS.HashAndSignature (+    HashAlgorithm (+        ..,+        HashNone,+        HashMD5,+        HashSHA1,+        HashSHA224,+        HashSHA256,+        HashSHA384,+        HashSHA512,+        HashIntrinsic+    ),+    SignatureAlgorithm (+        ..,+        SignatureAnonymous,+        SignatureRSA,+        SignatureDSA,+        SignatureECDSA,+        SignatureRSApssRSAeSHA256,+        SignatureRSApssRSAeSHA384,+        SignatureRSApssRSAeSHA512,+        SignatureEd25519,+        SignatureEd448,+        SignatureRSApsspssSHA256,+        SignatureRSApsspssSHA384,+        SignatureRSApsspssSHA512+    ),+    HashAndSignatureAlgorithm,+    supportedSignatureSchemes,+) where++import Network.TLS.Imports++------------------------------------------------------------++newtype HashAlgorithm = HashAlgorithm {fromHashAlgorithm :: Word8}+    deriving (Eq)++{- FOURMOLU_DISABLE -}+pattern HashNone      :: HashAlgorithm+pattern HashNone       = HashAlgorithm 0+pattern HashMD5       :: HashAlgorithm+pattern HashMD5        = HashAlgorithm 1+pattern HashSHA1      :: HashAlgorithm+pattern HashSHA1       = HashAlgorithm 2+pattern HashSHA224    :: HashAlgorithm+pattern HashSHA224     = HashAlgorithm 3+pattern HashSHA256    :: HashAlgorithm+pattern HashSHA256     = HashAlgorithm 4+pattern HashSHA384    :: HashAlgorithm+pattern HashSHA384     = HashAlgorithm 5+pattern HashSHA512    :: HashAlgorithm+pattern HashSHA512     = HashAlgorithm 6+pattern HashIntrinsic :: HashAlgorithm+pattern HashIntrinsic  = HashAlgorithm 8++instance Show HashAlgorithm where+    show HashNone          = "None"+    show HashMD5           = "MD5"+    show HashSHA1          = "SHA1"+    show HashSHA224        = "SHA224"+    show HashSHA256        = "SHA256"+    show HashSHA384        = "SHA384"+    show HashSHA512        = "SHA512"+    show HashIntrinsic     = "TLS13"+    show (HashAlgorithm x) = "Hash " ++ show x+{- FOURMOLU_ENABLE -}++------------------------------------------------------------++newtype SignatureAlgorithm = SignatureAlgorithm {fromSignatureAlgorithm :: Word8}+    deriving (Eq)++{- FOURMOLU_DISABLE -}+pattern SignatureAnonymous        :: SignatureAlgorithm+pattern SignatureAnonymous         = SignatureAlgorithm 0+pattern SignatureRSA              :: SignatureAlgorithm+pattern SignatureRSA               = SignatureAlgorithm 1+pattern SignatureDSA              :: SignatureAlgorithm+pattern SignatureDSA               = SignatureAlgorithm 2+pattern SignatureECDSA            :: SignatureAlgorithm+pattern SignatureECDSA             = SignatureAlgorithm 3+-- TLS 1.3 from here+pattern SignatureRSApssRSAeSHA256 :: SignatureAlgorithm+pattern SignatureRSApssRSAeSHA256  = SignatureAlgorithm 4+pattern SignatureRSApssRSAeSHA384 :: SignatureAlgorithm+pattern SignatureRSApssRSAeSHA384  = SignatureAlgorithm 5+pattern SignatureRSApssRSAeSHA512 :: SignatureAlgorithm+pattern SignatureRSApssRSAeSHA512  = SignatureAlgorithm 6+pattern SignatureEd25519          :: SignatureAlgorithm+pattern SignatureEd25519           = SignatureAlgorithm 7+pattern SignatureEd448            :: SignatureAlgorithm+pattern SignatureEd448             = SignatureAlgorithm 8+pattern SignatureRSApsspssSHA256  :: SignatureAlgorithm+pattern SignatureRSApsspssSHA256   = SignatureAlgorithm 9+pattern SignatureRSApsspssSHA384  :: SignatureAlgorithm+pattern SignatureRSApsspssSHA384   = SignatureAlgorithm 10+pattern SignatureRSApsspssSHA512  :: SignatureAlgorithm+pattern SignatureRSApsspssSHA512   = SignatureAlgorithm 11++instance Show SignatureAlgorithm where+    show SignatureAnonymous        = "Anonymous"+    show SignatureRSA              = "RSA"+    show SignatureDSA              = "DSA"+    show SignatureECDSA            = "ECDSA"+    show SignatureRSApssRSAeSHA256 = "RSApssRSAeSHA256"+    show SignatureRSApssRSAeSHA384 = "RSApssRSAeSHA384"+    show SignatureRSApssRSAeSHA512 = "RSApssRSAeSHA512"+    show SignatureEd25519          = "Ed25519"+    show SignatureEd448            = "Ed448"+    show SignatureRSApsspssSHA256  = "RSApsspssSHA256"+    show SignatureRSApsspssSHA384  = "RSApsspssSHA384"+    show SignatureRSApsspssSHA512  = "RSApsspssSHA512"+    show (SignatureAlgorithm x)    = "Signature " ++ show x+{- FOURMOLU_ENABLE -}++------------------------------------------------------------++type HashAndSignatureAlgorithm = (HashAlgorithm, SignatureAlgorithm)++{- FOURMOLU_DISABLE -}+supportedSignatureSchemes :: [HashAndSignatureAlgorithm]+supportedSignatureSchemes =+    -- EdDSA algorithms+    [ (HashIntrinsic, SignatureEd448)   -- ed448  (0x0808)+    , (HashIntrinsic, SignatureEd25519) -- ed25519(0x0807)+    -- ECDSA algorithms+    , (HashSHA256,    SignatureECDSA)   -- ecdsa_secp256r1_sha256(0x0403)+    , (HashSHA384,    SignatureECDSA)   -- ecdsa_secp384r1_sha384(0x0503)+    , (HashSHA512,    SignatureECDSA)   -- ecdsa_secp256r1_sha256(0x0403)+    -- RSASSA-PSS algorithms with public key OID RSASSA-PSS+    , (HashIntrinsic, SignatureRSApssRSAeSHA512) -- rsa_pss_pss_sha512(0x080b)+    , (HashIntrinsic, SignatureRSApssRSAeSHA384) -- rsa_pss_pss_sha384(0x080a)+    , (HashIntrinsic, SignatureRSApssRSAeSHA256) -- rsa_pss_pss_sha256(0x0809)+    -- RSASSA-PKCS1-v1_5 algorithms+    , (HashSHA512,    SignatureRSA)    -- rsa_pkcs1_sha512(0x0601)+    , (HashSHA384,    SignatureRSA)    -- rsa_pkcs1_sha384(0x0501)+    , (HashSHA256,    SignatureRSA)    -- rsa_pkcs1_sha256(0x0401)+    -- Legacy algorithms+    , (HashSHA1,      SignatureRSA)    -- rsa_pkcs1_sha1  (0x0201)+    , (HashSHA1,      SignatureECDSA)  -- ecdsa_sha1      (0x0203)+    ]+{- FOURMOLU_ENABLE -}

@@ -1,19 +1,25 @@ {-# OPTIONS_HADDOCK hide #-}  module Network.TLS.Internal (-    module Network.TLS.Struct,-    module Network.TLS.Struct13,+    module Network.TLS.Extension,     module Network.TLS.Packet,     module Network.TLS.Packet13,     module Network.TLS.Receiving,     module Network.TLS.Sending,+    module Network.TLS.Struct,+    module Network.TLS.Struct13,     module Network.TLS.Types,     module Network.TLS.Wire,     sendPacket12,     recvPacket12,+    makeCipherShowPretty, ) where +import Data.IORef+ import Network.TLS.Core (recvPacket12, sendPacket12)+import Network.TLS.Extension+import Network.TLS.Extra.Cipher import Network.TLS.Packet import Network.TLS.Packet13 import Network.TLS.Receiving@@ -22,3 +28,8 @@ import Network.TLS.Struct13 import Network.TLS.Types import Network.TLS.Wire++----------------------------------------------------------------++makeCipherShowPretty :: IO ()+makeCipherShowPretty = writeIORef globalCipherDict ciphersuite_all

@@ -66,11 +66,12 @@     decodeCertificateChain,     encodeCertificateChain,  )-import Network.TLS.Cipher (Cipher (..), CipherKeyExchangeType (..))+ import Network.TLS.Crypto import Network.TLS.Imports import Network.TLS.MAC import Network.TLS.Struct+import Network.TLS.Types import Network.TLS.Util.ASN1 import Network.TLS.Wire @@ -140,21 +141,23 @@     content <- getOpaque24     return (ty, content) +{- FOURMOLU_DISABLE -} decodeHandshake     :: CurrentParams -> HandshakeType -> ByteString -> Either TLSError Handshake decodeHandshake cp ty = runGetErr ("handshake[" ++ show ty ++ "]") $ case ty of-    HandshakeType_HelloRequest -> decodeHelloRequest-    HandshakeType_ClientHello -> decodeClientHello-    HandshakeType_ServerHello -> decodeServerHello-    HandshakeType_Certificate -> decodeCertificate-    HandshakeType_ServerKeyXchg -> decodeServerKeyXchg cp-    HandshakeType_CertRequest -> decodeCertRequest cp-    HandshakeType_ServerHelloDone -> decodeServerHelloDone-    HandshakeType_CertVerify -> decodeCertVerify cp-    HandshakeType_ClientKeyXchg -> decodeClientKeyXchg cp-    HandshakeType_Finished -> decodeFinished+    HandshakeType_HelloRequest     -> decodeHelloRequest+    HandshakeType_ClientHello      -> decodeClientHello+    HandshakeType_ServerHello      -> decodeServerHello+    HandshakeType_Certificate      -> decodeCertificate+    HandshakeType_ServerKeyXchg    -> decodeServerKeyXchg cp+    HandshakeType_CertRequest      -> decodeCertRequest cp+    HandshakeType_ServerHelloDone  -> decodeServerHelloDone+    HandshakeType_CertVerify       -> decodeCertVerify cp+    HandshakeType_ClientKeyXchg    -> decodeClientKeyXchg cp+    HandshakeType_Finished         -> decodeFinished     HandshakeType_NewSessionTicket -> decodeNewSessionTicket     x -> fail $ "Unsupported HandshakeType " ++ show x+{- FOURMOLU_ENABLE -}  decodeHelloRequest :: Get Handshake decodeHelloRequest = return HelloRequest@@ -164,16 +167,15 @@     ver <- getBinaryVersion     random <- getClientRandom32     session <- getSession-    ciphers <- getWords16+    ciphers <- map CipherId <$> getWords16     compressions <- getWords8     r <- remaining     exts <-         if r > 0             then fromIntegral <$> getWord16 >>= getExtensions-            else do-                rest <- remaining-                _ <- getBytes rest-                return []+            else return []+    r1 <- remaining+    when (r1 /= 0) $ fail "Client hello"     let ch = CH session ciphers exts     return $ ClientHello ver random compressions ch @@ -182,7 +184,7 @@     ver <- getBinaryVersion     random <- getServerRandom32     session <- getSession-    cipherid <- getWord16+    cipherid <- CipherId <$> getWord16     compressionid <- getWord8     r <- remaining     exts <-@@ -201,12 +203,12 @@             <$> (getWord24 >>= \len -> getList (fromIntegral len) getCertRaw)     case decodeCertificateChain certsRaw of         Left (i, s) -> fail ("error certificate parsing " ++ show i ++ ":" ++ s)-        Right cc -> return $ Certificate cc+        Right cc -> return $ Certificate $ TLSCertificateChain cc   where     getCertRaw = getOpaque24 >>= \cert -> return (3 + B.length cert, cert)  decodeFinished :: Get Handshake-decodeFinished = Finished <$> (remaining >>= getBytes)+decodeFinished = Finished . VerifyData <$> (remaining >>= getBytes)  decodeNewSessionTicket :: Get Handshake decodeNewSessionTicket = NewSessionTicket <$> getWord32 <*> getOpaque16@@ -242,7 +244,7 @@ decodeClientKeyXchg cp =     -- case  ClientKeyXchg <$> (remaining >>= getBytes)     case cParamsKeyXchgType cp of-        Nothing -> error "no client key exchange type"+        Nothing -> fail "no client key exchange type"         Just cke -> ClientKeyXchg <$> parseCKE cke   where     parseCKE CipherKeyExchange_RSA = CKX_RSA <$> (remaining >>= getBytes)@@ -251,7 +253,7 @@     parseCKE CipherKeyExchange_DH_Anon = parseClientDHPublic     parseCKE CipherKeyExchange_ECDHE_RSA = parseClientECDHPublic     parseCKE CipherKeyExchange_ECDHE_ECDSA = parseClientECDHPublic-    parseCKE _ = error "unsupported client key exchange type"+    parseCKE _ = fail "unsupported client key exchange type"     parseClientDHPublic = CKX_DH . dhPublic <$> getInteger16     parseClientECDHPublic = CKX_ECDH <$> getOpaque8 @@ -317,7 +319,7 @@     putBinaryVersion version     putClientRandom32 random     putSession chSession-    putWords16 chCiphers+    putWords16 $ map fromCipherId chCiphers     putWords8 compressionIDs     putExtensions chExtensions     return ()@@ -325,11 +327,11 @@     putBinaryVersion version     putServerRandom32 random     putSession session-    putWord16 cipherid+    putWord16 $ fromCipherId cipherid     putWord8 compressionID     putExtensions exts     return ()-encodeHandshake' (Certificate cc) = encodeCertificate cc+encodeHandshake' (Certificate (TLSCertificateChain cc)) = encodeCertificate cc encodeHandshake' (ClientKeyXchg ckx) = runPut $ do     case ckx of         CKX_RSA encryptedPreMain -> putBytes encryptedPreMain@@ -344,8 +346,7 @@         SKX_ECDHE_RSA params sig -> putServerECDHParams params >> putDigitallySigned sig         SKX_ECDHE_ECDSA params sig -> putServerECDHParams params >> putDigitallySigned sig         SKX_Unparsed bytes -> putBytes bytes-        _ ->-            error ("encodeHandshake': cannot handle: " ++ show skg)+        _ -> error ("encodeHandshake': cannot handle: " ++ show skg) encodeHandshake' HelloRequest = "" encodeHandshake' ServerHelloDone = "" encodeHandshake' (CertRequest certTypes sigAlgs certAuthorities) = runPut $ do@@ -357,7 +358,7 @@             sigAlgs     putDNames certAuthorities encodeHandshake' (CertVerify digitallySigned) = runPut $ putDigitallySigned digitallySigned-encodeHandshake' (Finished opaque) = runPut $ putBytes opaque+encodeHandshake' (Finished (VerifyData opaque)) = runPut $ putBytes opaque encodeHandshake' (NewSessionTicket life ticket) = runPut $ do     putWord32 life     putOpaque16 ticket@@ -399,7 +400,9 @@     len8 <- getWord8     case fromIntegral len8 of         0 -> return $ Session Nothing-        len -> Session . Just <$> getBytes len+        len+            | len > 32 -> fail "the length of session id must be <= 32"+            | otherwise -> Session . Just <$> getBytes len  putSession :: Session -> Put putSession (Session Nothing) = putWord8 0@@ -447,10 +450,9 @@             grp <- Group <$> getWord16 -- ECParameters NamedCurve             mxy <- getOpaque8 -- ECPoint             case decodeGroupPublic grp mxy of-                Left e -> error $ "getServerECDHParams: " ++ show e+                Left e -> fail $ "getServerECDHParams: " ++ show e                 Right grppub -> return $ ServerECDHParams grp grppub-        _ ->-            error "getServerECDHParams: unknown type for ECDH Params"+        _ -> fail "getServerECDHParams: unknown type for ECDH Params"  -- RFC 4492 Section 5.4 Server Key Exchange putServerECDHParams :: ServerECDHParams -> Put@@ -476,7 +478,9 @@ decodeChangeCipherSpec :: ByteString -> Either TLSError () decodeChangeCipherSpec = runGetErr "changecipherspec" $ do     x <- getWord8-    when (x /= 1) (fail "unknown change cipher spec content")+    when (x /= 1) $ fail "unknown change cipher spec content"+    len <- remaining+    when (len /= 0) $ fail "the length of CSS must be 1"  encodeChangeCipherSpec :: ByteString encodeChangeCipherSpec = runPut (putWord8 1)

@@ -42,18 +42,18 @@     putBinaryVersion TLS12     putServerRandom32 random     putSession session-    putWord16 cipherId+    putWord16 $ fromCipherId cipherId     putWord8 0 -- compressionID nullCompression     putExtensions exts encodeHandshake13' (EncryptedExtensions13 exts) = runPut $ putExtensions exts encodeHandshake13' (CertRequest13 reqctx exts) = runPut $ do     putOpaque8 reqctx     putExtensions exts-encodeHandshake13' (Certificate13 reqctx cc ess) = encodeCertificate13 reqctx cc ess-encodeHandshake13' (CertVerify13 hs signature) = runPut $ do+encodeHandshake13' (Certificate13 reqctx (TLSCertificateChain cc) ess) = encodeCertificate13 reqctx cc ess+encodeHandshake13' (CertVerify13 (DigitallySigned hs sig)) = runPut $ do     putSignatureHashAlgorithm hs-    putOpaque16 signature-encodeHandshake13' (Finished13 dat) = runPut $ putBytes dat+    putOpaque16 sig+encodeHandshake13' (Finished13 (VerifyData dat)) = runPut $ putBytes dat encodeHandshake13' (NewSessionTicket13 life ageadd nonce label exts) = runPut $ do     putWord32 life     putWord32 ageadd@@ -105,13 +105,13 @@     _ver <- getBinaryVersion     random <- getServerRandom32     session <- getSession-    cipherid <- getWord16+    cipherid <- CipherId <$> getWord16     _comp <- getWord8     exts <- fromIntegral <$> getWord16 >>= getExtensions     return $ ServerHello13 random session cipherid exts  decodeFinished13 :: Get Handshake13-decodeFinished13 = Finished13 <$> (remaining >>= getBytes)+decodeFinished13 = Finished13 . VerifyData <$> (remaining >>= getBytes)  decodeEncryptedExtensions13 :: Get Handshake13 decodeEncryptedExtensions13 =@@ -133,7 +133,7 @@     (certRaws, ess) <- unzip <$> getList len getCert     case decodeCertificateChain $ CertificateChainRaw certRaws of         Left (i, s) -> fail ("error certificate parsing " ++ show i ++ ":" ++ s)-        Right cc -> return $ Certificate13 reqctx cc ess+        Right cc -> return $ Certificate13 reqctx (TLSCertificateChain cc) ess   where     getCert = do         l <- fromIntegral <$> getWord24@@ -143,7 +143,8 @@         return (3 + l + 2 + len, (cert, exts))  decodeCertVerify13 :: Get Handshake13-decodeCertVerify13 = CertVerify13 <$> getSignatureHashAlgorithm <*> getOpaque16+decodeCertVerify13 =+    CertVerify13 <$> (DigitallySigned <$> getSignatureHashAlgorithm <*> getOpaque16)  decodeNewSessionTicket13 :: Get Handshake13 decodeNewSessionTicket13 = do

@@ -331,7 +331,7 @@     --   The default value includes all groups with security strength of 128     --   bits or more.     ---    --   Default: @[X25519,X448,P256,FFDHE3072,FFDHE4096,P384,FFDHE6144,FFDHE8192,P521]@+    --   Default: @[X25519,X448,P256,FFDHE2048,FFDHE3072,FFDHE4096,P384,FFDHE6144,FFDHE8192,P521]@     }     deriving (Show, Eq) @@ -646,7 +646,9 @@                 CertificateUsageReject $                     CertificateRejectOther "no client certificates expected"         , onUnverifiedClientCert = return False-        , onCipherChoosing = \_ -> head+        , onCipherChoosing = \_ ccs -> case ccs of+            [] -> error "onCipherChoosing"+            c : _ -> c         , onServerNameIndication = \_ -> return mempty         , onNewHandshake = \_ -> return True         , onALPNClientSuggest = Nothing

@@ -74,6 +74,7 @@ import Network.TLS.Core import Network.TLS.Crypto (hashDigestSize) import Network.TLS.Crypto.Types+import Network.TLS.Extension import Network.TLS.Extra.Cipher import Network.TLS.Handshake.Common import Network.TLS.Handshake.Control@@ -246,9 +247,9 @@     def         { supportedVersions = [TLS13]         , supportedCiphers =-            [ cipher_TLS13_AES256GCM_SHA384-            , cipher_TLS13_AES128GCM_SHA256-            , cipher_TLS13_AES128CCM_SHA256+            [ cipher13_AES_256_GCM_SHA384+            , cipher13_AES_128_GCM_SHA256+            , cipher13_AES_128_CCM_SHA256             ]         , supportedGroups = [X25519, X448, P256, P384, P521]         }

@@ -67,7 +67,10 @@ ----------------------------------------------------------------  processPacket13 :: Context -> Record Plaintext -> IO (Either TLSError Packet13)-processPacket13 _ (Record ProtocolType_ChangeCipherSpec _ _) = return $ Right ChangeCipherSpec13+processPacket13 _ (Record ProtocolType_ChangeCipherSpec _ fragment) =+    case decodeChangeCipherSpec $ fragmentGetBytes fragment of+        Left err -> return $ Left err+        Right _ -> return $ Right ChangeCipherSpec13 processPacket13 _ (Record ProtocolType_AppData _ fragment) = return $ Right $ AppData13 $ fragmentGetBytes fragment processPacket13 _ (Record ProtocolType_Alert _ fragment) = return (Alert13 `fmapEither` decodeAlerts (fragmentGetBytes fragment)) processPacket13 ctx (Record ProtocolType_Handshake _ fragment) = usingState ctx $ do

@@ -45,6 +45,15 @@     decryptData13 mver e st = case ct of         ProtocolType_AppData -> do             inner <- decryptData mver record e st+            let len = B.length inner+            when (len > 16385) $+                throwError $+                    Error_Protocol+                        ( "TLS 1.3 inner plaintext exceeding maximum size: "+                            ++ show len+                            ++ " > 16385 (2^14 + 1)"+                        )+                        RecordOverflow             case unInnerPlaintext inner of                 Left message -> throwError $ Error_Protocol message UnexpectedMessage                 Right (ct', d) -> return $ Record ct' ver (fragmentCompressed d)

@@ -37,6 +37,7 @@     setClientEcPointFormatSuggest,     getClientEcPointFormatSuggest,     setClientSNI,+    clearClientSNI,     getClientSNI,     getClientCertificateChain,     setClientCertificateChain,@@ -277,30 +278,33 @@ setClientSNI :: HostName -> TLSSt () setClientSNI hn = modify (\st -> st{stClientSNI = Just hn}) +clearClientSNI :: TLSSt ()+clearClientSNI = modify (\st -> st{stClientSNI = Nothing})+ getClientSNI :: TLSSt (Maybe HostName) getClientSNI = gets stClientSNI -getVerifyData :: Role -> TLSSt ByteString+getVerifyData :: Role -> TLSSt VerifyData getVerifyData client = do     mVerifyData <-         gets (if client == ClientRole then stClientVerifyData else stServerVerifyData)-    return $ fromMaybe "" mVerifyData+    return $ fromMaybe (VerifyData "") mVerifyData -getMyVerifyData :: TLSSt (Maybe ByteString)+getMyVerifyData :: TLSSt (Maybe VerifyData) getMyVerifyData = do     role <- getRole     if role == ClientRole         then gets stClientVerifyData         else gets stServerVerifyData -getPeerVerifyData :: TLSSt (Maybe ByteString)+getPeerVerifyData :: TLSSt (Maybe VerifyData) getPeerVerifyData = do     role <- getRole     if role == ClientRole         then gets stServerVerifyData         else gets stClientVerifyData -getFirstVerifyData :: TLSSt (Maybe ByteString)+getFirstVerifyData :: TLSSt (Maybe VerifyData) getFirstVerifyData = do     ver <- getVersion     case ver of

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PatternSynonyms #-} {-# OPTIONS_HADDOCK hide #-} @@ -7,47 +6,6 @@ module Network.TLS.Struct (     Version (..),     CipherData (..),-    ExtensionID (-        ..,-        EID_ServerName,-        EID_MaxFragmentLength,-        EID_ClientCertificateUrl,-        EID_TrustedCAKeys,-        EID_TruncatedHMAC,-        EID_StatusRequest,-        EID_UserMapping,-        EID_ClientAuthz,-        EID_ServerAuthz,-        EID_CertType,-        EID_SupportedGroups,-        EID_EcPointFormats,-        EID_SRP,-        EID_SignatureAlgorithms,-        EID_SRTP,-        EID_Heartbeat,-        EID_ApplicationLayerProtocolNegotiation,-        EID_StatusRequestv2,-        EID_SignedCertificateTimestamp,-        EID_ClientCertificateType,-        EID_ServerCertificateType,-        EID_Padding,-        EID_EncryptThenMAC,-        EID_ExtendedMainSecret,-        EID_SessionTicket,-        EID_PreSharedKey,-        EID_EarlyData,-        EID_SupportedVersions,-        EID_Cookie,-        EID_PskKeyExchangeModes,-        EID_CertificateAuthorities,-        EID_OidFilters,-        EID_PostHandshakeAuth,-        EID_SignatureAlgorithmsCert,-        EID_KeyShare,-        EID_QuicTransportParameters,-        EID_SecureRenegotiation-    ),-    ExtensionRaw (..),     CertificateType (         CertificateType,         CertificateType_RSA_Sign,@@ -58,34 +16,6 @@     ),     fromCertificateType,     lastSupportedCertificateType,-    HashAlgorithm (-        ..,-        HashNone,-        HashMD5,-        HashSHA1,-        HashSHA224,-        HashSHA256,-        HashSHA384,-        HashSHA512,-        HashIntrinsic-    ),-    SignatureAlgorithm (-        ..,-        SignatureAnonymous,-        SignatureRSA,-        SignatureDSA,-        SignatureECDSA,-        SignatureRSApssRSAeSHA256,-        SignatureRSApssRSAeSHA384,-        SignatureRSApssRSAeSHA512,-        SignatureEd25519,-        SignatureEd448,-        SignatureRSApsspssSHA256,-        SignatureRSApsspssSHA384,-        SignatureRSApsspssSHA512-    ),-    HashAndSignatureAlgorithm,-    supportedSignatureSchemes,     DigitallySigned (..),     Signature,     ProtocolType (@@ -98,9 +28,6 @@     TLSError (..),     TLSException (..),     DistinguishedName,-    BigNum (..),-    bigNumToInteger,-    bigNumFromInteger,     ServerDHParams (..),     serverDHParamsToParams,     serverDHParamsToPublic,@@ -114,7 +41,7 @@     ServerRandom (..),     ClientRandom (..),     FinishedData,-    VerifyData,+    VerifyData (..),     SessionID,     Session (..),     SessionData (..),@@ -176,21 +103,24 @@         HandshakeType_Finished,         HandshakeType_KeyUpdate     ),+    TLSCertificateChain (..),     Handshake (..),     CH (..),     packetType,     typeOfHandshake,+    module Network.TLS.HashAndSignature,+    ExtensionRaw (..),+    ExtensionID (..), ) where -import Control.Exception (Exception (..))-import qualified Data.ByteString.Base16 as B16-import qualified Data.ByteString.Char8 as C8-import Data.Typeable import Data.X509 (CertificateChain, DistinguishedName)+ import Network.TLS.Crypto+import Network.TLS.Error+import {-# SOURCE #-} Network.TLS.Extension+import Network.TLS.HashAndSignature import Network.TLS.Imports import Network.TLS.Types-import Network.TLS.Util.Serialization  ---------------------------------------------------------------- @@ -250,122 +180,14 @@  ------------------------------------------------------------ -newtype HashAlgorithm = HashAlgorithm {fromHashAlgorithm :: Word8}-    deriving (Eq)--{- FOURMOLU_DISABLE -}-pattern HashNone      :: HashAlgorithm-pattern HashNone       = HashAlgorithm 0-pattern HashMD5       :: HashAlgorithm-pattern HashMD5        = HashAlgorithm 1-pattern HashSHA1      :: HashAlgorithm-pattern HashSHA1       = HashAlgorithm 2-pattern HashSHA224    :: HashAlgorithm-pattern HashSHA224     = HashAlgorithm 3-pattern HashSHA256    :: HashAlgorithm-pattern HashSHA256     = HashAlgorithm 4-pattern HashSHA384    :: HashAlgorithm-pattern HashSHA384     = HashAlgorithm 5-pattern HashSHA512    :: HashAlgorithm-pattern HashSHA512     = HashAlgorithm 6-pattern HashIntrinsic :: HashAlgorithm-pattern HashIntrinsic  = HashAlgorithm 8--instance Show HashAlgorithm where-    show HashNone          = "HashNone"-    show HashMD5           = "HashMD5"-    show HashSHA1          = "HashSHA1"-    show HashSHA224        = "HashSHA224"-    show HashSHA256        = "HashSHA256"-    show HashSHA384        = "HashSHA384"-    show HashSHA512        = "HashSHA512"-    show HashIntrinsic     = "HashIntrinsic"-    show (HashAlgorithm x) = "HashAlgorithm " ++ show x-{- FOURMOLU_ENABLE -}----------------------------------------------------------------newtype SignatureAlgorithm = SignatureAlgorithm {fromSignatureAlgorithm :: Word8}-    deriving (Eq)--{- FOURMOLU_DISABLE -}-pattern SignatureAnonymous        :: SignatureAlgorithm-pattern SignatureAnonymous         = SignatureAlgorithm 0-pattern SignatureRSA              :: SignatureAlgorithm-pattern SignatureRSA               = SignatureAlgorithm 1-pattern SignatureDSA              :: SignatureAlgorithm-pattern SignatureDSA               = SignatureAlgorithm 2-pattern SignatureECDSA            :: SignatureAlgorithm-pattern SignatureECDSA             = SignatureAlgorithm 3--- TLS 1.3 from here-pattern SignatureRSApssRSAeSHA256 :: SignatureAlgorithm-pattern SignatureRSApssRSAeSHA256  = SignatureAlgorithm 4-pattern SignatureRSApssRSAeSHA384 :: SignatureAlgorithm-pattern SignatureRSApssRSAeSHA384  = SignatureAlgorithm 5-pattern SignatureRSApssRSAeSHA512 :: SignatureAlgorithm-pattern SignatureRSApssRSAeSHA512  = SignatureAlgorithm 6-pattern SignatureEd25519          :: SignatureAlgorithm-pattern SignatureEd25519           = SignatureAlgorithm 7-pattern SignatureEd448            :: SignatureAlgorithm-pattern SignatureEd448             = SignatureAlgorithm 8-pattern SignatureRSApsspssSHA256  :: SignatureAlgorithm-pattern SignatureRSApsspssSHA256   = SignatureAlgorithm 9-pattern SignatureRSApsspssSHA384  :: SignatureAlgorithm-pattern SignatureRSApsspssSHA384   = SignatureAlgorithm 10-pattern SignatureRSApsspssSHA512  :: SignatureAlgorithm-pattern SignatureRSApsspssSHA512   = SignatureAlgorithm 11--instance Show SignatureAlgorithm where-    show SignatureAnonymous        = "SignatureAnonymous"-    show SignatureRSA              = "SignatureRSA"-    show SignatureDSA              = "SignatureDSA"-    show SignatureECDSA            = "SignatureECDSA"-    show SignatureRSApssRSAeSHA256 = "SignatureRSApssRSAeSHA256"-    show SignatureRSApssRSAeSHA384 = "SignatureRSApssRSAeSHA384"-    show SignatureRSApssRSAeSHA512 = "SignatureRSApssRSAeSHA512"-    show SignatureEd25519          = "SignatureEd25519"-    show SignatureEd448            = "SignatureEd448"-    show SignatureRSApsspssSHA256  = "SignatureRSApsspssSHA256"-    show SignatureRSApsspssSHA384  = "SignatureRSApsspssSHA384"-    show SignatureRSApsspssSHA512  = "SignatureRSApsspssSHA512"-    show (SignatureAlgorithm x)    = "SignatureAlgorithm " ++ show x-{- FOURMOLU_ENABLE -}----------------------------------------------------------------type HashAndSignatureAlgorithm = (HashAlgorithm, SignatureAlgorithm)--{- FOURMOLU_DISABLE -}-supportedSignatureSchemes :: [HashAndSignatureAlgorithm]-supportedSignatureSchemes =-    -- EdDSA algorithms-    [ (HashIntrinsic, SignatureEd448)   -- ed448  (0x0808)-    , (HashIntrinsic, SignatureEd25519) -- ed25519(0x0807)-    -- ECDSA algorithms-    , (HashSHA256,    SignatureECDSA)   -- ecdsa_secp256r1_sha256(0x0403)-    , (HashSHA384,    SignatureECDSA)   -- ecdsa_secp384r1_sha384(0x0503)-    , (HashSHA512,    SignatureECDSA)   -- ecdsa_secp256r1_sha256(0x0403)-    -- RSASSA-PSS algorithms with public key OID RSASSA-PSS-    , (HashIntrinsic, SignatureRSApssRSAeSHA512) -- rsa_pss_pss_sha512(0x080b)-    , (HashIntrinsic, SignatureRSApssRSAeSHA384) -- rsa_pss_pss_sha384(0x080a)-    , (HashIntrinsic, SignatureRSApssRSAeSHA256) -- rsa_pss_pss_sha256(0x0809)-    -- RSASSA-PKCS1-v1_5 algorithms-    , (HashSHA512,    SignatureRSA)    -- rsa_pkcs1_sha512(0x0601)-    , (HashSHA384,    SignatureRSA)    -- rsa_pkcs1_sha384(0x0501)-    , (HashSHA256,    SignatureRSA)    -- rsa_pkcs1_sha256(0x0401)-    -- Legacy algorithms-    , (HashSHA1,      SignatureRSA)    -- rsa_pkcs1_sha1  (0x0201)-    , (HashSHA1,      SignatureECDSA)  -- ecdsa_sha1      (0x0203)-    ]-{- FOURMOLU_ENABLE -}--------------------------------------------------------------- type Signature = ByteString  data DigitallySigned = DigitallySigned HashAndSignatureAlgorithm Signature-    deriving (Show, Eq)+    deriving (Eq) +instance Show DigitallySigned where+    show (DigitallySigned hs sig) = "DigitallySigned " ++ show hs ++ " " ++ showBytesHex sig+ ----------------------------------------------------------------  newtype ProtocolType = ProtocolType {fromProtocolType :: Word8} deriving (Eq)@@ -393,62 +215,6 @@  ---------------------------------------------------------------- --- | TLSError that might be returned through the TLS stack.------ Prior to version 1.8.0, this type had an @Exception@ instance.--- In version 1.8.0, this instance was removed, and functions in--- this library now only throw 'TLSException'.-data TLSError-    = -- | mainly for instance of Error-      Error_Misc String-    | -- | A fatal error condition was encountered at a low level.  The-      -- elements of the tuple give (freeform text description, structured-      -- error description).-      Error_Protocol String AlertDescription-    | -- | A non-fatal error condition was encountered at a low level at a low-      -- level.  The elements of the tuple give (freeform text description,-      -- structured error description).-      Error_Protocol_Warning String AlertDescription-    | Error_Certificate String-    | -- | handshake policy failed.-      Error_HandshakePolicy String-    | Error_EOF-    | Error_Packet String-    | Error_Packet_unexpected String String-    | Error_Packet_Parsing String-    deriving (Eq, Show, Typeable)---------------------------------------------------------------------- | TLS Exceptions. Some of the data constructors indicate incorrect use of---   the library, and the documentation for those data constructors calls---   this out. The others wrap 'TLSError' with some kind of context to explain---   when the exception occurred.-data TLSException-    = -- | Early termination exception with the reason and the error associated-      Terminated Bool String TLSError-    | -- | Handshake failed for the reason attached.-      HandshakeFailed TLSError-    | -- | Failure occurred while sending or receiving data after the-      --   TLS handshake succeeded.-      PostHandshake TLSError-    | -- | Lifts a 'TLSError' into 'TLSException' without provided any context-      --   around when the error happened.-      Uncontextualized TLSError-    | -- | Usage error when the connection has not been established-      --   and the user is trying to send or receive data.-      --   Indicates that this library has been used incorrectly.-      ConnectionNotEstablished-    | -- | Expected that a TLS handshake had already taken place, but no TLS-      --   handshake had occurred.-      --   Indicates that this library has been used incorrectly.-      MissingHandshake-    deriving (Show, Eq, Typeable)--instance Exception TLSException------------------------------------------------------------------- data Packet     = Handshake [Handshake]     | Alert [(AlertLevel, AlertDescription)]@@ -460,280 +226,32 @@     show (Handshake hs) = "Handshake " ++ show hs     show (Alert as) = "Alert " ++ show as     show ChangeCipherSpec = "ChangeCipherSpec"-    show (AppData bs) = "AppData " ++ C8.unpack (B16.encode bs)+    show (AppData bs) = "AppData " ++ showBytesHex bs  data Header = Header ProtocolType Version Word16 deriving (Show, Eq)  newtype ServerRandom = ServerRandom {unServerRandom :: ByteString}-    deriving (Show, Eq)-newtype ClientRandom = ClientRandom {unClientRandom :: ByteString}-    deriving (Show, Eq)-newtype Session = Session (Maybe SessionID) deriving (Show, Eq)--{-# DEPRECATED FinishedData "use VerifyData" #-}-type FinishedData = ByteString-type VerifyData = ByteString---------------------------------------------------------------------- | Identifier of a TLS extension.---   <http://www.iana.org/assignments/tls-extensiontype-values/tls-extensiontype-values.txt>-newtype ExtensionID = ExtensionID {fromExtensionID :: Word16} deriving (Eq)--{- FOURMOLU_DISABLE -}-pattern EID_ServerName                          :: ExtensionID -- RFC6066-pattern EID_ServerName                           = ExtensionID 0x0-pattern EID_MaxFragmentLength                   :: ExtensionID -- RFC6066-pattern EID_MaxFragmentLength                    = ExtensionID 0x1-pattern EID_ClientCertificateUrl                :: ExtensionID -- RFC6066-pattern EID_ClientCertificateUrl                 = ExtensionID 0x2-pattern EID_TrustedCAKeys                       :: ExtensionID -- RFC6066-pattern EID_TrustedCAKeys                        = ExtensionID 0x3-pattern EID_TruncatedHMAC                       :: ExtensionID -- RFC6066-pattern EID_TruncatedHMAC                        = ExtensionID 0x4-pattern EID_StatusRequest                       :: ExtensionID -- RFC6066-pattern EID_StatusRequest                        = ExtensionID 0x5-pattern EID_UserMapping                         :: ExtensionID -- RFC4681-pattern EID_UserMapping                          = ExtensionID 0x6-pattern EID_ClientAuthz                         :: ExtensionID -- RFC5878-pattern EID_ClientAuthz                          = ExtensionID 0x7-pattern EID_ServerAuthz                         :: ExtensionID -- RFC5878-pattern EID_ServerAuthz                          = ExtensionID 0x8-pattern EID_CertType                            :: ExtensionID -- RFC6091-pattern EID_CertType                             = ExtensionID 0x9-pattern EID_SupportedGroups                     :: ExtensionID -- RFC8422,8446-pattern EID_SupportedGroups                      = ExtensionID 0xa-pattern EID_EcPointFormats                      :: ExtensionID -- RFC4492-pattern EID_EcPointFormats                       = ExtensionID 0xb-pattern EID_SRP                                 :: ExtensionID -- RFC5054-pattern EID_SRP                                  = ExtensionID 0xc-pattern EID_SignatureAlgorithms                 :: ExtensionID -- RFC5246,8446-pattern EID_SignatureAlgorithms                  = ExtensionID 0xd-pattern EID_SRTP                                :: ExtensionID -- RFC5764-pattern EID_SRTP                                 = ExtensionID 0xe-pattern EID_Heartbeat                           :: ExtensionID -- RFC6520-pattern EID_Heartbeat                            = ExtensionID 0xf-pattern EID_ApplicationLayerProtocolNegotiation :: ExtensionID -- RFC7301-pattern EID_ApplicationLayerProtocolNegotiation  = ExtensionID 0x10-pattern EID_StatusRequestv2                     :: ExtensionID -- RFC6961-pattern EID_StatusRequestv2                      = ExtensionID 0x11-pattern EID_SignedCertificateTimestamp          :: ExtensionID -- RFC6962-pattern EID_SignedCertificateTimestamp           = ExtensionID 0x12-pattern EID_ClientCertificateType               :: ExtensionID -- RFC7250-pattern EID_ClientCertificateType                = ExtensionID 0x13-pattern EID_ServerCertificateType               :: ExtensionID -- RFC7250-pattern EID_ServerCertificateType                = ExtensionID 0x14-pattern EID_Padding                             :: ExtensionID -- RFC5246-pattern EID_Padding                              = ExtensionID 0x15-pattern EID_EncryptThenMAC                      :: ExtensionID -- RFC7366-pattern EID_EncryptThenMAC                       = ExtensionID 0x16-pattern EID_ExtendedMainSecret                  :: ExtensionID -- REF7627-pattern EID_ExtendedMainSecret                   = ExtensionID 0x17-pattern EID_SessionTicket                       :: ExtensionID -- RFC4507-pattern EID_SessionTicket                        = ExtensionID 0x23-pattern EID_PreSharedKey                        :: ExtensionID -- RFC8446-pattern EID_PreSharedKey                         = ExtensionID 0x29-pattern EID_EarlyData                           :: ExtensionID -- RFC8446-pattern EID_EarlyData                            = ExtensionID 0x2a-pattern EID_SupportedVersions                   :: ExtensionID -- RFC8446-pattern EID_SupportedVersions                    = ExtensionID 0x2b-pattern EID_Cookie                              :: ExtensionID -- RFC8446-pattern EID_Cookie                               = ExtensionID 0x2c-pattern EID_PskKeyExchangeModes                 :: ExtensionID -- RFC8446-pattern EID_PskKeyExchangeModes                  = ExtensionID 0x2d-pattern EID_CertificateAuthorities              :: ExtensionID -- RFC8446-pattern EID_CertificateAuthorities               = ExtensionID 0x2f-pattern EID_OidFilters                          :: ExtensionID -- RFC8446-pattern EID_OidFilters                           = ExtensionID 0x30-pattern EID_PostHandshakeAuth                   :: ExtensionID -- RFC8446-pattern EID_PostHandshakeAuth                    = ExtensionID 0x31-pattern EID_SignatureAlgorithmsCert             :: ExtensionID -- RFC8446-pattern EID_SignatureAlgorithmsCert              = ExtensionID 0x32-pattern EID_KeyShare                            :: ExtensionID -- RFC8446-pattern EID_KeyShare                             = ExtensionID 0x33-pattern EID_QuicTransportParameters             :: ExtensionID -- RFC9001-pattern EID_QuicTransportParameters              = ExtensionID 0x39-pattern EID_SecureRenegotiation                 :: ExtensionID -- RFC5746-pattern EID_SecureRenegotiation                  = ExtensionID 0xff01--instance Show ExtensionID where-    show EID_ServerName              = "ServerName"-    show EID_MaxFragmentLength       = "MaxFragmentLength"-    show EID_ClientCertificateUrl    = "ClientCertificateUrl"-    show EID_TrustedCAKeys           = "TrustedCAKeys"-    show EID_TruncatedHMAC           = "TruncatedHMAC"-    show EID_StatusRequest           = "StatusRequest"-    show EID_UserMapping             = "UserMapping"-    show EID_ClientAuthz             = "ClientAuthz"-    show EID_ServerAuthz             = "ServerAuthz"-    show EID_CertType                = "CertType"-    show EID_SupportedGroups         = "SupportedGroups"-    show EID_EcPointFormats          = "EcPointFormats"-    show EID_SRP                     = "SRP"-    show EID_SignatureAlgorithms     = "SignatureAlgorithms"-    show EID_SRTP                    = "SRTP"-    show EID_Heartbeat               = "Heartbeat"-    show EID_ApplicationLayerProtocolNegotiation = "ApplicationLayerProtocolNegotiation"-    show EID_StatusRequestv2         = "StatusRequestv2"-    show EID_SignedCertificateTimestamp = "SignedCertificateTimestamp"-    show EID_ClientCertificateType   = "ClientCertificateType"-    show EID_ServerCertificateType   = "ServerCertificateType"-    show EID_Padding                 = "Padding"-    show EID_EncryptThenMAC          = "EncryptThenMAC"-    show EID_ExtendedMainSecret      = "ExtendedMainSecret"-    show EID_SessionTicket           = "SessionTicket"-    show EID_PreSharedKey            = "PreSharedKey"-    show EID_EarlyData               = "EarlyData"-    show EID_SupportedVersions       = "SupportedVersions"-    show EID_Cookie                  = "Cookie"-    show EID_PskKeyExchangeModes     = "PskKeyExchangeModes"-    show EID_CertificateAuthorities  = "CertificateAuthorities"-    show EID_OidFilters              = "OidFilters"-    show EID_PostHandshakeAuth       = "PostHandshakeAuth"-    show EID_SignatureAlgorithmsCert = "SignatureAlgorithmsCert"-    show EID_KeyShare                = "KeyShare"-    show EID_QuicTransportParameters = "QuicTransportParameters"-    show EID_SecureRenegotiation     = "SecureRenegotiation"-    show (ExtensionID x)         = "ExtensionID " ++ show x-{- FOURMOLU_ENABLE -}---------------------------------------------------------------------- | The raw content of a TLS extension.-data ExtensionRaw = ExtensionRaw ExtensionID ByteString     deriving (Eq)--instance Show ExtensionRaw where-    show (ExtensionRaw eid bs) = "ExtensionRaw " ++ show eid ++ " " ++ showBytesHex bs--------------------------------------------------------------------newtype AlertLevel = AlertLevel {fromAlertLevel :: Word8} deriving (Eq)--{- FOURMOLU_DISABLE -}-pattern AlertLevel_Warning :: AlertLevel-pattern AlertLevel_Warning  = AlertLevel 1-pattern AlertLevel_Fatal   :: AlertLevel-pattern AlertLevel_Fatal    = AlertLevel 2+instance Show ServerRandom where+    show (ServerRandom bs) = "ServerRandom " ++ showBytesHex bs -instance Show AlertLevel where-    show AlertLevel_Warning = "AlertLevel_Warning"-    show AlertLevel_Fatal   = "AlertLevel_Fatal"-    show (AlertLevel x)     = "AlertLevel " ++ show x-{- FOURMOLU_ENABLE -}+newtype ClientRandom = ClientRandom {unClientRandom :: ByteString}+    deriving (Eq) -----------------------------------------------------------------+instance Show ClientRandom where+    show (ClientRandom bs) = "ClientRandom " ++ showBytesHex bs -newtype AlertDescription = AlertDescription {fromAlertDescription :: Word8}-    deriving (Eq)+newtype Session = Session (Maybe SessionID) deriving (Eq)+instance Show Session where+    show (Session Nothing) = "Session \"\""+    show (Session (Just bs)) = "Session " ++ showBytesHex bs -{- FOURMOLU_DISABLE -}-pattern CloseNotify                  :: AlertDescription-pattern CloseNotify                   = AlertDescription 0-pattern UnexpectedMessage            :: AlertDescription-pattern UnexpectedMessage             = AlertDescription 10-pattern BadRecordMac                 :: AlertDescription-pattern BadRecordMac                  = AlertDescription 20-pattern DecryptionFailed             :: AlertDescription-pattern DecryptionFailed              = AlertDescription 21-pattern RecordOverflow               :: AlertDescription-pattern RecordOverflow                = AlertDescription 22-pattern DecompressionFailure         :: AlertDescription-pattern DecompressionFailure          = AlertDescription 30-pattern HandshakeFailure             :: AlertDescription-pattern HandshakeFailure              = AlertDescription 40-pattern BadCertificate               :: AlertDescription-pattern BadCertificate                = AlertDescription 42-pattern UnsupportedCertificate       :: AlertDescription-pattern UnsupportedCertificate        = AlertDescription 43-pattern CertificateRevoked           :: AlertDescription-pattern CertificateRevoked            = AlertDescription 44-pattern CertificateExpired           :: AlertDescription-pattern CertificateExpired            = AlertDescription 45-pattern CertificateUnknown           :: AlertDescription-pattern CertificateUnknown            = AlertDescription 46-pattern IllegalParameter             :: AlertDescription-pattern IllegalParameter              = AlertDescription 47-pattern UnknownCa                    :: AlertDescription-pattern UnknownCa                     = AlertDescription 48-pattern AccessDenied                 :: AlertDescription-pattern AccessDenied                  = AlertDescription 49-pattern DecodeError                  :: AlertDescription-pattern DecodeError                   = AlertDescription 50-pattern DecryptError                 :: AlertDescription-pattern DecryptError                  = AlertDescription 51-pattern ExportRestriction            :: AlertDescription-pattern ExportRestriction             = AlertDescription 60-pattern ProtocolVersion              :: AlertDescription-pattern ProtocolVersion               = AlertDescription 70-pattern InsufficientSecurity         :: AlertDescription-pattern InsufficientSecurity          = AlertDescription 71-pattern InternalError                :: AlertDescription-pattern InternalError                 = AlertDescription 80-pattern InappropriateFallback        :: AlertDescription-pattern InappropriateFallback         = AlertDescription 86  -- RFC7507-pattern UserCanceled                 :: AlertDescription-pattern UserCanceled                  = AlertDescription 90-pattern NoRenegotiation              :: AlertDescription-pattern NoRenegotiation               = AlertDescription 100-pattern MissingExtension             :: AlertDescription-pattern MissingExtension              = AlertDescription 109-pattern UnsupportedExtension         :: AlertDescription-pattern UnsupportedExtension          = AlertDescription 110-pattern CertificateUnobtainable      :: AlertDescription-pattern CertificateUnobtainable       = AlertDescription 111-pattern UnrecognizedName             :: AlertDescription-pattern UnrecognizedName              = AlertDescription 112-pattern BadCertificateStatusResponse :: AlertDescription-pattern BadCertificateStatusResponse  = AlertDescription 113-pattern BadCertificateHashValue      :: AlertDescription-pattern BadCertificateHashValue       = AlertDescription 114-pattern UnknownPskIdentity           :: AlertDescription-pattern UnknownPskIdentity            = AlertDescription 115-pattern CertificateRequired          :: AlertDescription-pattern CertificateRequired           = AlertDescription 116-pattern GeneralError                 :: AlertDescription-pattern GeneralError                  = AlertDescription 117-pattern NoApplicationProtocol        :: AlertDescription-pattern NoApplicationProtocol         = AlertDescription 120 -- RFC7301+{-# DEPRECATED FinishedData "use VerifyData" #-}+type FinishedData = ByteString -instance Show AlertDescription where-    show CloseNotify                  = "CloseNotify"-    show UnexpectedMessage            = "UnexpectedMessage"-    show BadRecordMac                 = "BadRecordMac"-    show DecryptionFailed             = "DecryptionFailed"-    show RecordOverflow               = "RecordOverflow"-    show DecompressionFailure         = "DecompressionFailure"-    show HandshakeFailure             = "HandshakeFailure"-    show BadCertificate               = "BadCertificate"-    show UnsupportedCertificate       = "UnsupportedCertificate"-    show CertificateRevoked           = "CertificateRevoked"-    show CertificateExpired           = "CertificateExpired"-    show CertificateUnknown           = "CertificateUnknown"-    show IllegalParameter             = "IllegalParameter"-    show UnknownCa                    = "UnknownCa"-    show AccessDenied                 = "AccessDenied"-    show DecodeError                  = "DecodeError"-    show DecryptError                 = "DecryptError"-    show ExportRestriction            = "ExportRestriction"-    show ProtocolVersion              = "ProtocolVersion"-    show InsufficientSecurity         = "InsufficientSecurity"-    show InternalError                = "InternalError"-    show InappropriateFallback        = "InappropriateFallback"-    show UserCanceled                 = "UserCanceled"-    show NoRenegotiation              = "NoRenegotiation"-    show MissingExtension             = "MissingExtension"-    show UnsupportedExtension         = "UnsupportedExtension"-    show CertificateUnobtainable      = "CertificateUnobtainable"-    show UnrecognizedName             = "UnrecognizedName"-    show BadCertificateStatusResponse = "BadCertificateStatusResponse"-    show BadCertificateHashValue      = "BadCertificateHashValue"-    show UnknownPskIdentity           = "UnknownPskIdentity"-    show CertificateRequired          = "CertificateRequired"-    show GeneralError                 = "GeneralError"-    show NoApplicationProtocol        = "NoApplicationProtocol"-    show (AlertDescription x)         = "AlertDescription " ++ show x-{- FOURMOLU_ENABLE -}+newtype VerifyData = VerifyData ByteString deriving (Eq)+instance Show VerifyData where+    show (VerifyData bs) = showBytesHex bs  ---------------------------------------------------------------- @@ -787,17 +305,6 @@  ---------------------------------------------------------------- -newtype BigNum = BigNum ByteString-    deriving (Show, Eq)--bigNumToInteger :: BigNum -> Integer-bigNumToInteger (BigNum b) = os2ip b--bigNumFromInteger :: Integer -> BigNum-bigNumFromInteger i = BigNum $ i2osp i------------------------------------------------------------------- data ServerDHParams = ServerDHParams     { serverDHParams_p :: BigNum     , serverDHParams_g :: BigNum@@ -852,25 +359,48 @@     | SKX_DH_RSA (Maybe ServerRSAParams)     | SKX_Unparsed ByteString -- if we parse the server key xchg before knowing the actual cipher, we end up with this structure.     | SKX_Unknown ByteString-    deriving (Show, Eq)+    deriving (Eq) +{- FOURMOLU_DISABLE -}+instance Show ServerKeyXchgAlgorithmData where+    show (SKX_DH_Anon _)       = "SKX_DH_Anon"+    show (SKX_DHE_DSA _ _)     = "SKX_DHE_DSA"+    show (SKX_DHE_RSA _ _)     = "SKX_DHE_RSA"+    show (SKX_ECDHE_RSA _ _)   = "SKX_ECDHE_RSA"+    show (SKX_ECDHE_ECDSA _ _) = "SKX_ECDHE_ECDSA"+    show (SKX_RSA _)           = "SKX_RSA"+    show (SKX_DH_DSA _)        = "SKX_DH_DSA"+    show (SKX_DH_RSA _)        = "SKX_DH_RSA"+    show (SKX_Unparsed _)      = "SKX_Unparsed"+    show (SKX_Unknown _)       = "SKX_Unknown"+{- FOURMOLU_ENABLE -}+ ----------------------------------------------------------------  data ClientKeyXchgAlgorithmData     = CKX_RSA ByteString     | CKX_DH DHPublic     | CKX_ECDH ByteString-    deriving (Show, Eq)+    deriving (Eq) +instance Show ClientKeyXchgAlgorithmData where+    show (CKX_RSA bs) = "CKX_RSA " ++ showBytesHex bs+    show (CKX_DH pub) = "CKX_DH " ++ show pub+    show (CKX_ECDH bs) = "CKX_ECDH " ++ showBytesHex bs+ ----------------------------------------------------------------  data CH = CH     { chSession :: Session-    , chCiphers :: [CipherID]+    , chCiphers :: [CipherId]     , chExtensions :: [ExtensionRaw]     }     deriving (Show, Eq) +newtype TLSCertificateChain = TLSCertificateChain CertificateChain deriving (Eq)+instance Show TLSCertificateChain where+    show _ = "CertificateChain"+ data Handshake     = ClientHello         Version@@ -881,10 +411,10 @@         Version         ServerRandom         Session-        CipherID+        CipherId         CompressionID         [ExtensionRaw]-    | Certificate CertificateChain+    | Certificate TLSCertificateChain     | HelloRequest     | ServerHelloDone     | ClientKeyXchg ClientKeyXchgAlgorithmData

@@ -4,9 +4,9 @@     typeOfHandshake13,     contentType,     KeyUpdate (..),+    CertReqContext, ) where -import Data.X509 (CertificateChain) import Network.TLS.Imports import Network.TLS.Struct import Network.TLS.Types@@ -27,16 +27,19 @@  -- fixme: convert Word32 to proper data type data Handshake13-    = ServerHello13 ServerRandom Session CipherID [ExtensionRaw]+    = ServerHello13 ServerRandom Session CipherId [ExtensionRaw]     | NewSessionTicket13 Second Word32 TicketNonce SessionIDorTicket [ExtensionRaw]     | EndOfEarlyData13     | EncryptedExtensions13 [ExtensionRaw]     | CertRequest13 CertReqContext [ExtensionRaw]-    | Certificate13 CertReqContext CertificateChain [[ExtensionRaw]]-    | CertVerify13 HashAndSignatureAlgorithm Signature+    | Certificate13 CertReqContext TLSCertificateChain [[ExtensionRaw]]+    | CertVerify13 DigitallySigned     | Finished13 VerifyData     | KeyUpdate13 KeyUpdate     deriving (Show, Eq)++-- | Certificate request context for TLS 1.3.+type CertReqContext = ByteString  {- FOURMOLU_DISABLE -} typeOfHandshake13 :: Handshake13 -> HandshakeType

@@ -3,188 +3,53 @@ {-# LANGUAGE PatternSynonyms #-}  module Network.TLS.Types (-    Version (Version, SSL2, SSL3, TLS10, TLS11, TLS12, TLS13),-    SessionID,-    SessionIDorTicket,-    Ticket,-    isTicket,-    toSessionID,-    SessionData (..),-    is0RTTPossible,-    SessionFlag (..),-    CertReqContext,-    TLS13TicketInfo (..),-    CipherID,-    CompressionID,+    module Network.TLS.Types.Cipher,+    module Network.TLS.Types.Secret,+    module Network.TLS.Types.Session,+    module Network.TLS.Types.Version,+    HostName,     Role (..),     invertRole,     Direction (..),-    HostName,-    Second,-    Millisecond,-    EarlySecret,-    HandshakeSecret,-    ApplicationSecret,-    ResumptionSecret,-    BaseSecret (..),-    AnyTrafficSecret (..),-    ClientTrafficSecret (..),-    ServerTrafficSecret (..),-    TrafficSecrets,-    SecretTriple (..),-    SecretPair (..),-    MainSecret (..),+    BigNum (..),+    bigNumToInteger,+    bigNumFromInteger, ) where -import Codec.Serialise-import qualified Data.ByteString as B-import GHC.Generics import Network.Socket (HostName)-import Network.TLS.Crypto (Group, Hash (..), hash)-import Network.TLS.Imports -type Second = Word32-type Millisecond = Word64---- | Versions known to TLS-newtype Version = Version Word16 deriving (Eq, Ord, Generic)-{- FOURMOLU_DISABLE -}-pattern SSL2  :: Version-pattern SSL2   = Version 0x0200-pattern SSL3  :: Version-pattern SSL3   = Version 0x0300-pattern TLS10 :: Version-pattern TLS10  = Version 0x0301-pattern TLS11 :: Version-pattern TLS11  = Version 0x0302-pattern TLS12 :: Version-pattern TLS12  = Version 0x0303-pattern TLS13 :: Version-pattern TLS13  = Version 0x0304--instance Show Version where-    show SSL2  = "SSL2"-    show SSL3  = "SSL3"-    show TLS10 = "TLS1.0"-    show TLS11 = "TLS1.1"-    show TLS12 = "TLS1.2"-    show TLS13 = "TLS1.3"-    show (Version x) = "Version " ++ show x-{- FOURMOLU_ENABLE -}---- | A session ID-type SessionID = ByteString---- | Identity-type SessionIDorTicket = ByteString---- | Encrypted session ticket (encrypt(encode 'SessionData')).-type Ticket = ByteString--isTicket :: SessionIDorTicket -> Bool-isTicket x-    | B.length x > 32 = True-    | otherwise = False--toSessionID :: Ticket -> SessionID-toSessionID = hash SHA256---- | Session data to resume-data SessionData = SessionData-    { sessionVersion :: Version-    , sessionCipher :: CipherID-    , sessionCompression :: CompressionID-    , sessionClientSNI :: Maybe HostName-    , sessionSecret :: ByteString-    , sessionGroup :: Maybe Group-    , sessionTicketInfo :: Maybe TLS13TicketInfo-    , sessionALPN :: Maybe ByteString-    , sessionMaxEarlyDataSize :: Int-    , sessionFlags :: [SessionFlag]-    } -- sessionFromTicket :: Bool-    deriving (Show, Eq, Generic)--is0RTTPossible :: SessionData -> Bool-is0RTTPossible sd = sessionMaxEarlyDataSize sd > 0---- | Some session flags-data SessionFlag-    = -- | Session created with Extended Main Secret-      SessionEMS-    deriving (Show, Eq, Enum, Generic)---- | Certificate request context for TLS 1.3.-type CertReqContext = ByteString--data TLS13TicketInfo = TLS13TicketInfo-    { lifetime :: Second -- NewSessionTicket.ticket_lifetime in seconds-    , ageAdd :: Second -- NewSessionTicket.ticket_age_add-    , txrxTime :: Millisecond -- serverSendTime or clientReceiveTime-    , estimatedRTT :: Maybe Millisecond-    }-    deriving (Show, Eq, Generic)---- | Cipher identification-type CipherID = Word16+import Network.TLS.Imports+import Network.TLS.Types.Cipher+import Network.TLS.Types.Secret+import Network.TLS.Types.Session+import Network.TLS.Types.Version+import Network.TLS.Util.Serialization --- | Compression identification-type CompressionID = Word8+----------------------------------------------------------------  -- | Role data Role = ClientRole | ServerRole     deriving (Show, Eq) --- | Direction-data Direction = Tx | Rx-    deriving (Show, Eq)- invertRole :: Role -> Role invertRole ClientRole = ServerRole invertRole ServerRole = ClientRole --- | Phantom type indicating early traffic secret.-data EarlySecret---- | Phantom type indicating handshake traffic secrets.-data HandshakeSecret---- | Phantom type indicating application traffic secrets.-data ApplicationSecret--data ResumptionSecret--newtype BaseSecret a = BaseSecret ByteString deriving (Show)-newtype AnyTrafficSecret a = AnyTrafficSecret ByteString deriving (Show)---- | A client traffic secret, typed with a parameter indicating a step in the--- TLS key schedule.-newtype ClientTrafficSecret a = ClientTrafficSecret ByteString deriving (Show)+---------------------------------------------------------------- --- | A server traffic secret, typed with a parameter indicating a step in the--- TLS key schedule.-newtype ServerTrafficSecret a = ServerTrafficSecret ByteString deriving (Show)+-- | Direction+data Direction = Tx | Rx+    deriving (Show, Eq) -data SecretTriple a = SecretTriple-    { triBase :: BaseSecret a-    , triClient :: ClientTrafficSecret a-    , triServer :: ServerTrafficSecret a-    }-    deriving (Show)+---------------------------------------------------------------- -data SecretPair a = SecretPair-    { pairBase :: BaseSecret a-    , pairClient :: ClientTrafficSecret a-    }+newtype BigNum = BigNum ByteString+    deriving (Show, Eq) --- | Hold both client and server traffic secrets at the same step.-type TrafficSecrets a = (ClientTrafficSecret a, ServerTrafficSecret a)+bigNumToInteger :: BigNum -> Integer+bigNumToInteger (BigNum b) = os2ip b --- Main secret for TLS 1.2 or earlier.-newtype MainSecret = MainSecret ByteString deriving (Show)+bigNumFromInteger :: Integer -> BigNum+bigNumFromInteger i = BigNum $ i2osp i  ------------------------------------------------------------------instance Serialise Version-instance Serialise TLS13TicketInfo-instance Serialise SessionFlag-instance Serialise SessionData

@@ -0,0 +1,120 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PatternSynonyms #-}++module Network.TLS.Types.Cipher where++import Crypto.Cipher.Types (AuthTag)+import Data.IORef+import GHC.Generics+import System.IO.Unsafe (unsafePerformIO)+import Text.Printf++import Network.TLS.Crypto (Hash (..))+import Network.TLS.Imports+import Network.TLS.Types.Version++----------------------------------------------------------------++-- | Cipher identification+type CipherID = Word16++newtype CipherId = CipherId {fromCipherId :: Word16}+    deriving (Eq, Ord, Enum, Num, Integral, Real, Read, Generic)++instance Show CipherId where+    show (CipherId 0x00FF) = "TLS_EMPTY_RENEGOTIATION_INFO_SCSV"+    show (CipherId n) = case find eqID dict of+        Just c -> cipherName c+        Nothing -> printf "0x%04X" n+      where+        eqID c = cipherID c == n+        dict = unsafePerformIO $ readIORef globalCipherDict++-- "ciphersuite" is designed extensible.+-- So, it's not available from internal modules.+-- This is a compromise to gule "ciphersuite" to Show CipherID.++{-# NOINLINE globalCipherDict #-}+globalCipherDict :: IORef [Cipher]+globalCipherDict = unsafePerformIO $ newIORef []++----------------------------------------------------------------++-- | Cipher algorithm+data Cipher = Cipher+    { cipherID :: CipherID+    , cipherName :: String+    , cipherHash :: Hash+    , cipherBulk :: Bulk+    , cipherKeyExchange :: CipherKeyExchangeType+    , cipherMinVer :: Maybe Version+    , cipherPRFHash :: Maybe Hash+    }++instance Show Cipher where+    show c = cipherName c++instance Eq Cipher where+    (==) c1 c2 = cipherID c1 == cipherID c2++----------------------------------------------------------------++data CipherKeyExchangeType+    = CipherKeyExchange_RSA+    | CipherKeyExchange_DH_Anon+    | CipherKeyExchange_DHE_RSA+    | CipherKeyExchange_ECDHE_RSA+    | CipherKeyExchange_DHE_DSA+    | CipherKeyExchange_DH_DSA+    | CipherKeyExchange_DH_RSA+    | CipherKeyExchange_ECDH_ECDSA+    | CipherKeyExchange_ECDH_RSA+    | CipherKeyExchange_ECDHE_ECDSA+    | CipherKeyExchange_TLS13 -- not expressed in cipher suite+    deriving (Show, Eq)++----------------------------------------------------------------++data Bulk = Bulk+    { bulkName :: String+    , bulkKeySize :: Int+    , bulkIVSize :: Int+    , bulkExplicitIV :: Int -- Explicit size for IV for AEAD Cipher, 0 otherwise+    , bulkAuthTagLen :: Int -- Authentication tag length in bytes for AEAD Cipher, 0 otherwise+    , bulkBlockSize :: Int+    , bulkF :: BulkFunctions+    }++instance Show Bulk where+    show bulk = bulkName bulk+instance Eq Bulk where+    b1 == b2 =+        and+            [ bulkName b1 == bulkName b2+            , bulkKeySize b1 == bulkKeySize b2+            , bulkIVSize b1 == bulkIVSize b2+            , bulkBlockSize b1 == bulkBlockSize b2+            ]++----------------------------------------------------------------++data BulkFunctions+    = BulkBlockF (BulkDirection -> BulkKey -> BulkBlock)+    | BulkStreamF (BulkDirection -> BulkKey -> BulkStream)+    | BulkAeadF (BulkDirection -> BulkKey -> BulkAEAD)++data BulkDirection = BulkEncrypt | BulkDecrypt+    deriving (Show, Eq)++type BulkBlock = BulkIV -> ByteString -> (ByteString, BulkIV)++type BulkKey = ByteString+type BulkIV = ByteString+type BulkNonce = ByteString+type BulkAdditionalData = ByteString++newtype BulkStream = BulkStream (ByteString -> (ByteString, BulkStream))++type BulkAEAD =+    BulkNonce -> ByteString -> BulkAdditionalData -> (ByteString, AuthTag)

@@ -0,0 +1,43 @@+module Network.TLS.Types.Secret where++import Network.TLS.Imports++-- | Phantom type indicating early traffic secret.+data EarlySecret++-- | Phantom type indicating handshake traffic secrets.+data HandshakeSecret++-- | Phantom type indicating application traffic secrets.+data ApplicationSecret++data ResumptionSecret++newtype BaseSecret a = BaseSecret ByteString deriving (Show)+newtype AnyTrafficSecret a = AnyTrafficSecret ByteString deriving (Show)++-- | A client traffic secret, typed with a parameter indicating a step in the+-- TLS key schedule.+newtype ClientTrafficSecret a = ClientTrafficSecret ByteString deriving (Show)++-- | A server traffic secret, typed with a parameter indicating a step in the+-- TLS key schedule.+newtype ServerTrafficSecret a = ServerTrafficSecret ByteString deriving (Show)++data SecretTriple a = SecretTriple+    { triBase :: BaseSecret a+    , triClient :: ClientTrafficSecret a+    , triServer :: ServerTrafficSecret a+    }+    deriving (Show)++data SecretPair a = SecretPair+    { pairBase :: BaseSecret a+    , pairClient :: ClientTrafficSecret a+    }++-- | Hold both client and server traffic secrets at the same step.+type TrafficSecrets a = (ClientTrafficSecret a, ServerTrafficSecret a)++-- Main secret for TLS 1.2 or earlier.+newtype MainSecret = MainSecret ByteString deriving (Show)

@@ -0,0 +1,72 @@+{-# LANGUAGE DeriveGeneric #-}++module Network.TLS.Types.Session where++import Codec.Serialise+import qualified Data.ByteString as B+import GHC.Generics+import Network.Socket (HostName)++import Network.TLS.Crypto (Group, Hash (..), hash)+import Network.TLS.Imports+import Network.TLS.Types.Cipher+import Network.TLS.Types.Version++-- | A session ID+type SessionID = ByteString++-- | Identity+type SessionIDorTicket = ByteString++-- | Encrypted session ticket (encrypt(encode 'SessionData')).+type Ticket = ByteString++isTicket :: SessionIDorTicket -> Bool+isTicket x+    | B.length x > 32 = True+    | otherwise = False++toSessionID :: Ticket -> SessionID+toSessionID = hash SHA256++-- | Compression identification+type CompressionID = Word8++-- | Session data to resume+data SessionData = SessionData+    { sessionVersion :: Version+    , sessionCipher :: CipherID+    , sessionCompression :: CompressionID+    , sessionClientSNI :: Maybe HostName+    , sessionSecret :: ByteString+    , sessionGroup :: Maybe Group+    , sessionTicketInfo :: Maybe TLS13TicketInfo+    , sessionALPN :: Maybe ByteString+    , sessionMaxEarlyDataSize :: Int+    , sessionFlags :: [SessionFlag]+    } -- sessionFromTicket :: Bool+    deriving (Show, Eq, Generic)++is0RTTPossible :: SessionData -> Bool+is0RTTPossible sd = sessionMaxEarlyDataSize sd > 0++-- | Some session flags+data SessionFlag+    = -- | Session created with Extended Main Secret+      SessionEMS+    deriving (Show, Eq, Enum, Generic)++type Second = Word32+type Millisecond = Word64++data TLS13TicketInfo = TLS13TicketInfo+    { lifetime :: Second -- NewSessionTicket.ticket_lifetime in seconds+    , ageAdd :: Second -- NewSessionTicket.ticket_age_add+    , txrxTime :: Millisecond -- serverSendTime or clientReceiveTime+    , estimatedRTT :: Maybe Millisecond+    }+    deriving (Show, Eq, Generic)++instance Serialise TLS13TicketInfo+instance Serialise SessionFlag+instance Serialise SessionData

@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PatternSynonyms #-}++module Network.TLS.Types.Version (+    Version (Version, SSL2, SSL3, TLS10, TLS11, TLS12, TLS13),+) where++import Codec.Serialise+import GHC.Generics++import Network.TLS.Imports++-- | Versions known to TLS+newtype Version = Version Word16 deriving (Eq, Ord, Generic)++{- FOURMOLU_DISABLE -}+pattern SSL2  :: Version+pattern SSL2   = Version 0x0200+pattern SSL3  :: Version+pattern SSL3   = Version 0x0300+pattern TLS10 :: Version+pattern TLS10  = Version 0x0301+pattern TLS11 :: Version+pattern TLS11  = Version 0x0302+pattern TLS12 :: Version+pattern TLS12  = Version 0x0303+pattern TLS13 :: Version+pattern TLS13  = Version 0x0304++instance Show Version where+    show SSL2  = "SSL2"+    show SSL3  = "SSL3"+    show TLS10 = "TLS1.0"+    show TLS11 = "TLS1.1"+    show TLS12 = "TLS1.2"+    show TLS13 = "TLS1.3"+    show (Version x) = "Version " ++ show x+{- FOURMOLU_ENABLE -}++instance Serialise Version

@@ -50,8 +50,10 @@ import Data.Serialize.Get hiding (runGet) import qualified Data.Serialize.Get as G import Data.Serialize.Put++import Network.TLS.Error import Network.TLS.Imports-import Network.TLS.Struct+import Network.TLS.Types import Network.TLS.Util.Serialization  type GetContinuation a = ByteString -> GetResult a@@ -91,7 +93,10 @@ getWord16 = getWord16be  getWords16 :: Get [Word16]-getWords16 = getWord16 >>= \lenb -> replicateM (fromIntegral lenb `div` 2) getWord16+getWords16 = do+    lenb <- getWord16+    when (odd lenb) $ fail "length for ciphers must be even"+    replicateM (fromIntegral lenb `shiftR` 1) getWord16  getWord24 :: Get Int getWord24 = do

@@ -5,7 +5,6 @@  import Control.Monad import qualified Data.ByteString as B-import Data.Default (def) import Data.List import Data.Word import Data.X509 (@@ -56,7 +55,7 @@     arbitrary = shuffle supportedSignatureSchemes  instance Arbitrary DigitallySigned where-    arbitrary = DigitallySigned <$> (head <$> arbitrary) <*> genByteString 32+    arbitrary = DigitallySigned <$> (unsafeHead <$> arbitrary) <*> genByteString 32  instance Arbitrary ExtensionRaw where     arbitrary =@@ -71,6 +70,9 @@             , CertificateType_ECDSA_Sign             ] +instance Arbitrary CipherId where+    arbitrary = CipherId <$> arbitrary+ instance Arbitrary Handshake where     arbitrary =         oneof@@ -78,7 +80,7 @@                 ClientHello ver                     <$> arbitrary                     <*> arbitraryCompressionIDs-                    <*> (CH <$> arbitrary <*> arbitraryCiphersIDs <*> arbitraryHelloExtensions ver)+                    <*> (CH <$> arbitrary <*> arbitraryCiphersIds <*> arbitraryHelloExtensions ver)             , arbitrary >>= \ver ->                 ServerHello ver                     <$> arbitrary@@ -86,13 +88,14 @@                     <*> arbitrary                     <*> arbitrary                     <*> arbitraryHelloExtensions ver-            , Certificate . CertificateChain <$> resize 2 (listOf arbitraryX509)+            , Certificate . TLSCertificateChain . CertificateChain+                <$> resize 2 (listOf arbitraryX509)             , pure HelloRequest             , pure ServerHelloDone             , ClientKeyXchg . CKX_RSA <$> genByteString 48             , CertRequest <$> arbitrary <*> arbitrary <*> listOf arbitraryDN             , CertVerify <$> arbitrary-            , Finished <$> genByteString 12+            , Finished . VerifyData <$> genByteString 12             ]  instance Arbitrary Handshake13 where@@ -118,17 +121,21 @@             , resize 2 (listOf arbitraryX509) >>= \certs ->                 Certificate13                     <$> arbitraryCertReqContext-                    <*> return (CertificateChain certs)+                    <*> return (TLSCertificateChain (CertificateChain certs))                     <*> replicateM (length certs) arbitrary-            , CertVerify13 <$> (head <$> arbitrary) <*> genByteString 32-            , Finished13 <$> genByteString 12+            , CertVerify13+                <$> ( DigitallySigned+                        <$> (unsafeHead <$> arbitrary)+                        <*> genByteString 32+                    )+            , Finished13 . VerifyData <$> genByteString 12             , KeyUpdate13 <$> elements [UpdateNotRequested, UpdateRequested]             ]  ---------------------------------------------------------------- -arbitraryCiphersIDs :: Gen [Word16]-arbitraryCiphersIDs = choose (0, 200) >>= vector+arbitraryCiphersIds :: Gen [CipherId]+arbitraryCiphersIds = map CipherId <$> (choose (0, 200) >>= vector)  arbitraryCompressionIDs :: Gen [Word8] arbitraryCompressionIDs = choose (0, 200) >>= vector@@ -363,21 +370,21 @@     clientHashSignatures <- arbitrary     serverHashSignatures <- arbitrary     let serverState =-            def+            defaultParamsServer                 { serverSupported =-                    def+                    defaultSupported                         { supportedCiphers = serverCiphers                         , supportedVersions = serverVersions                         , supportedSecureRenegotiation = secNeg                         , supportedGroups = serverGroups                         , supportedHashSignatures = serverHashSignatures                         }-                , serverShared = def{sharedCredentials = Credentials creds}+                , serverShared = defaultShared{sharedCredentials = Credentials creds}                 }     let clientState =             (defaultParamsClient "" B.empty)                 { clientSupported =-                    def+                    defaultSupported                         { supportedCiphers = clientCiphers                         , supportedVersions = clientVersions                         , supportedSecureRenegotiation = secNeg@@ -385,7 +392,7 @@                         , supportedHashSignatures = clientHashSignatures                         }                 , clientShared =-                    def+                    defaultShared                         { sharedValidationCache =                             ValidationCache                                 { cacheAdd = \_ _ _ -> return ()@@ -433,3 +440,8 @@  genByteString :: Int -> Gen B.ByteString genByteString i = B.pack <$> vector i++-- Just for preventing warnings of GHC 9.10+unsafeHead :: [a] -> a+unsafeHead [] = error "unsafeHead"+unsafeHead (x : _) = x

@@ -5,7 +5,6 @@ import Control.Monad import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L-import Data.Default (def) import Data.IORef import Data.List import Data.Maybe@@ -99,7 +98,7 @@   where     cgrps = supportedGroups $ clientSupported $ fst params     sgrps = supportedGroups $ serverSupported $ snd params-    hs = if head cgrps `elem` sgrps then FullHandshake else HelloRetryRequest+    hs = if unsafeHead cgrps `elem` sgrps then FullHandshake else HelloRetryRequest  -------------------------------------------------------------- @@ -128,9 +127,9 @@     tls13 <- generate arbitrary     let version = if tls13 then TLS13 else TLS12         ciphers =-            [ cipher_ECDHE_RSA_AES256GCM_SHA384-            , cipher_ECDHE_ECDSA_AES256GCM_SHA384-            , cipher_TLS13_AES128GCM_SHA256+            [ cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384+            , cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384+            , cipher13_AES_128_GCM_SHA256             ]     (clientParam, serverParam) <-         generate $@@ -232,7 +231,7 @@ handshake_ec (SG sigGroups) = do     let versions = [TLS12]         ciphers =-            [ cipher_ECDHE_ECDSA_AES256GCM_SHA384+            [ cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384             ]         hashSignatures =             [ (HashSHA256, SignatureECDSA)@@ -285,15 +284,15 @@     arbitrary = OC <$> sublistOf otherCiphers <*> sublistOf otherCiphers       where         otherCiphers =-            [ cipher_ECDHE_RSA_AES256GCM_SHA384-            , cipher_ECDHE_RSA_AES128GCM_SHA256+            [ cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384+            , cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256             ]  handshake_cert_fallback_cipher :: OC -> IO () handshake_cert_fallback_cipher (OC clientCiphers serverCiphers) = do     let clientVersions = [TLS12]         serverVersions = [TLS12]-        commonCiphers = [cipher_ECDHE_RSA_AES128GCM_SHA256]+        commonCiphers = [cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256]         hashSignatures = [(HashSHA256, SignatureRSA), (HashSHA1, SignatureDSA)]     chainRef <- newIORef Nothing     (clientParam, serverParam) <-@@ -341,9 +340,9 @@     tls13 <- generate arbitrary     let versions = if tls13 then [TLS13] else [TLS12]         ciphers =-            [ cipher_ECDHE_RSA_AES128GCM_SHA256-            , cipher_ECDHE_ECDSA_AES128GCM_SHA256-            , cipher_TLS13_AES128GCM_SHA256+            [ cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256+            , cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256+            , cipher13_AES_128_GCM_SHA256             ]         commonHS =             [ (HashSHA256, SignatureRSA)@@ -673,13 +672,13 @@ handshake13_full :: CSP13 -> IO () handshake13_full (CSP13 (cli, srv)) = do     let cliSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [X25519]                 }         svrSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [X25519]                 }         params =@@ -691,13 +690,13 @@ handshake13_hrr :: CSP13 -> IO () handshake13_hrr (CSP13 (cli, srv)) = do     let cliSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [P256, X25519]                 }         svrSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [X25519]                 }         params =@@ -709,13 +708,13 @@ handshake13_psk :: CSP13 -> IO () handshake13_psk (CSP13 (cli, srv)) = do     let cliSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [P256, X25519]                 }         svrSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [X25519]                 }         params0 =@@ -740,13 +739,13 @@ handshake13_psk_ticket :: CSP13 -> IO () handshake13_psk_ticket (CSP13 (cli, srv)) = do     let cliSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [P256, X25519]                 }         svrSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [X25519]                 }         params0 =@@ -772,16 +771,16 @@ handshake13_psk_fallback :: CSP13 -> IO () handshake13_psk_fallback (CSP13 (cli, srv)) = do     let cliSupported =-            def+            defaultSupported                 { supportedCiphers =-                    [ cipher_TLS13_AES128GCM_SHA256-                    , cipher_TLS13_AES128CCM_SHA256+                    [ cipher13_AES_128_GCM_SHA256+                    , cipher13_AES_128_CCM_SHA256                     ]                 , supportedGroups = [P256, X25519]                 }         svrSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [X25519]                 }         params0 =@@ -804,8 +803,8 @@     let (cli2, srv2) = setPairParamsSessionResuming (fromJust sessionParams) params         srv2' = srv2{serverSupported = svrSupported'}         svrSupported' =-            def-                { supportedCiphers = [cipher_TLS13_AES128CCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_CCM_SHA256]                 , supportedGroups = [P256]                 } @@ -814,22 +813,22 @@ handshake13_0rtt :: CSP13 -> IO () handshake13_0rtt (CSP13 (cli, srv)) = do     let cliSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [P256, X25519]                 }         svrSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [X25519]                 }         cliHooks =-            def+            defaultClientHooks                 { onSuggestALPN = return $ Just ["h2"]                 }         svrHooks =-            def-                { onALPNClientSuggest = Just (return . head)+            defaultServerHooks+                { onALPNClientSuggest = Just (return . unsafeHead)                 }         params0 =             ( cli@@ -867,13 +866,13 @@ handshake13_0rtt_fallback (CSP13 (cli, srv)) = do     group0 <- generate $ elements [P256, X25519]     let cliSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [P256, X25519]                 }         svrSupported =-            def-                { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+            defaultSupported+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                 , supportedGroups = [group0]                 }         params =@@ -901,8 +900,8 @@             group1 <- generate $ elements [P256, X25519]             let (pc, ps) = setPairParamsSessionResuming sessionParams params0                 svrSupported1 =-                    def-                        { supportedCiphers = [cipher_TLS13_AES128GCM_SHA256]+                    defaultSupported+                        { supportedCiphers = [cipher13_AES_128_GCM_SHA256]                         , supportedGroups = [group1]                         }                 params1 =

@@ -21,7 +21,6 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L-import Data.Default (def) import Data.IORef import Network.TLS import System.Timeout@@ -273,8 +272,8 @@     logging pre =         if debug             then-                def+                defaultLogging                     { loggingPacketSent = putStrLn . ((pre ++ ">> ") ++)                     , loggingPacketRecv = putStrLn . ((pre ++ "<< ") ++)                     }-            else def+            else defaultLogging

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               tls-version:            2.1.5+version:            2.1.6 license:            BSD3 license-file:       LICENSE copyright:          Vincent Hanquez <vincent@snarc.org>@@ -50,6 +50,7 @@         Network.TLS.Crypto.IES         Network.TLS.Crypto.Types         Network.TLS.ErrT+        Network.TLS.Error         Network.TLS.Extension         Network.TLS.Handshake         Network.TLS.Handshake.Certificate@@ -77,6 +78,7 @@         Network.TLS.Handshake.Signature         Network.TLS.Handshake.State         Network.TLS.Handshake.State13+        Network.TLS.HashAndSignature         Network.TLS.Hooks         Network.TLS.IO         Network.TLS.Imports@@ -102,8 +104,12 @@         Network.TLS.Receiving         Network.TLS.Util         Network.TLS.Util.ASN1-        Network.TLS.Util.Serialization         Network.TLS.Types+        Network.TLS.Types.Cipher+        Network.TLS.Types.Secret+        Network.TLS.Types.Session+        Network.TLS.Types.Version+        Network.TLS.Util.Serialization         Network.TLS.Wire         Network.TLS.X509 @@ -159,7 +165,6 @@         crypton,         crypton-x509,         crypton-x509-validation,-        data-default,         hourglass,         hspec,         serialise,@@ -184,7 +189,6 @@         crypton,         crypton-x509-store,         crypton-x509-system,-        data-default,         network,         network-run,         tls@@ -212,7 +216,6 @@         crypton,         crypton-x509-store,         crypton-x509-system,-        data-default,         network,         network-run,         tls

@@ -10,6 +10,8 @@  import qualified Data.ByteString.Base16 as BS16 import qualified Data.ByteString.Lazy.Char8 as CL8+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE import Network.Socket import Network.TLS @@ -18,18 +20,18 @@ data Aux = Aux     { auxAuthority :: HostName     , auxPort :: ServiceName-    , auxDebug :: String -> IO ()+    , auxDebugPrint :: String -> IO ()     , auxShow :: ByteString -> IO ()     , auxReadResumptionData :: IO [(SessionID, SessionData)]     } -type Cli = Aux -> [ByteString] -> Context -> IO ()+type Cli = Aux -> NonEmpty ByteString -> Context -> IO ()  clientHTTP11 :: Cli clientHTTP11 aux@Aux{..} paths ctx = do     sendData ctx $         "GET "-            <> CL8.fromStrict (head paths)+            <> CL8.fromStrict (NE.head paths)             <> " HTTP/1.1\r\n"             <> "Host: "             <> CL8.pack auxAuthority

@@ -3,11 +3,9 @@ {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}  module Common (-    printCiphers,     printDHParams,     printGroups,     readNumber,-    readCiphers,     readDHParams,     readGroups,     getCertificateStore,@@ -17,13 +15,10 @@     printHandshakeInfo, ) where -import Crypto.System.CPU import Data.Char (isDigit) import Data.X509.CertificateStore import Network.TLS hiding (HostName)-import Network.TLS.Extra.Cipher import Network.TLS.Extra.FFDHE-import Numeric (showHex) import System.Exit import System.X509 @@ -38,13 +33,6 @@     , ("ffdhe8192", ffdhe8192)     ] -namedCiphersuites :: [(String, [CipherID])]-namedCiphersuites =-    [ ("all", map cipherID ciphersuite_all)-    , ("default", map cipherID ciphersuite_default)-    , ("strong", map cipherID ciphersuite_strong)-    ]- namedGroups :: [(String, Group)] namedGroups =     [ ("ffdhe2048", FFDHE2048)@@ -64,12 +52,6 @@     | all isDigit s = Just $ read s     | otherwise = Nothing -readCiphers :: String -> Maybe [CipherID]-readCiphers s =-    case lookup s namedCiphersuites of-        Nothing -> (: []) `fmap` readNumber s-        just -> just- readDHParams :: String -> IO (Maybe DHParams) readDHParams s =     case lookup s namedDHParams of@@ -81,34 +63,6 @@     Nothing -> []     Just gs -> gs -printCiphers :: IO ()-printCiphers = do-    putStrLn "Supported ciphers"-    putStrLn "====================================="-    forM_ ciphersuite_all_det $ \c ->-        putStrLn-            ( pad 50 (cipherName c)-                ++ " = "-                ++ pad 5 (show $ cipherID c)-                ++ "  0x"-                ++ showHex (cipherID c) ""-            )-    putStrLn ""-    putStrLn "Ciphersuites"-    putStrLn "====================================="-    forM_ namedCiphersuites $ \(name, _) -> putStrLn name-    putStrLn ""-    putStrLn-        ("Using crypton-" ++ VERSION_crypton ++ " with CPU support for: " ++ cpuSupport)-  where-    pad n s-        | length s < n = s ++ replicate (n - length s) ' '-        | otherwise = s--    cpuSupport-        | null processorOptions = "(nothing)"-        | otherwise = intercalate ", " (map show processorOptions)- printDHParams :: IO () printDHParams = do     putStrLn "DH Parameters"@@ -125,9 +79,9 @@ split :: Char -> String -> [String] split _ "" = [] split c s = case break (c ==) s of-    ("", r) -> split c (tail r)+    ("", _ : rs) -> split c rs     (s', "") -> [s']-    (s', r) -> s' : split c (tail r)+    (s', _ : rs) -> s' : split c rs  getCertificateStore :: [FilePath] -> IO CertificateStore getCertificateStore [] = getSystemCertificateStore

@@ -3,6 +3,7 @@ module Server where  import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy.Char8 as BL8 import Data.IORef import Network.TLS@@ -14,13 +15,18 @@ server ctx showRequest = do     recvRequest ctx showRequest     sendData ctx $-        "HTTP/1.1 200 OK\r\n"-            <> "Context-Type: text/html\r\n"-            <> "Content-Length: "-            <> BL8.pack (show (BL8.length body))-            <> "\r\n"-            <> "\r\n"-            <> body+        -- "<>" creates *chunks* of lazy ByteString, resulting+        -- many TLS fragments.+        -- To prevent this, strict ByteString is created first and+        -- converted into lazy one.+        BL8.fromStrict $+            "HTTP/1.1 200 OK\r\n"+                <> "Context-Type: text/html\r\n"+                <> "Content-Length: "+                <> C8.pack (show (BS.length body))+                <> "\r\n"+                <> "\r\n"+                <> body   where     body = "<html><<body>Hello world!</body></html>" @@ -31,6 +37,9 @@   where     loop getLine = do         bs <- getLine+        when ("GET /keyupdate" `BS.isPrefixOf` bs) $ do+            r <- updateKey ctx TwoWay+            putStrLn $ "Updating key..." ++ if r then "OK" else "NG"         when (bs /= "") $ do             when showRequest $ do                 BS.putStr bs@@ -45,11 +54,11 @@     getline :: IORef ByteString -> IO ByteString     getline ref = do         bs0 <- readIORef ref-        case BS.breakSubstring "\r\n" bs0 of+        case BS.breakSubstring "\n" bs0 of             (_, "") -> do                 bs1 <- recvData ctx                 writeIORef ref (bs0 <> bs1)                 getline ref             (bs1, bs2) -> do-                writeIORef ref $ BS.drop 2 bs2-                return bs1+                writeIORef ref $ BS.drop 1 bs2+                return $ BS.dropWhileEnd (== 0x0d) bs1

@@ -1,19 +1,21 @@ {-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  module Main where  import Control.Concurrent-import qualified Control.Exception as E import qualified Data.ByteString.Base16 as BS16 import qualified Data.ByteString.Char8 as C8-import Data.Default (def) import Data.IORef+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE import Data.X509.CertificateStore import Network.Run.TCP import Network.Socket import Network.TLS hiding (is0RTTPossible)+import Network.TLS.Internal (makeCipherShowPretty) import System.Console.GetOpt import System.Environment import System.Exit@@ -44,13 +46,13 @@         { optDebugLog = False         , optShow = False         , optKeyLogFile = Nothing-        , optGroups = supportedGroups def+        , optGroups = supportedGroups defaultSupported         , optValidate = False         , optVerNego = False         , optResumption = False         , opt0RTT = False         , optRetry = False-        , optVersions = supportedVersions def+        , optVersions = supportedVersions defaultSupported         , optALPN = "http/1.1"         } @@ -137,7 +139,7 @@         [] -> showUsageAndExit usage         _ : [] -> showUsageAndExit usage         h : p : [] -> return (h, p, ["/"])-        h : p : ps -> return (h, p, C8.pack <$> ps)+        h : p : ps -> return (h, p, C8.pack <$> NE.fromList ps)     when (null optGroups) $ do         putStrLn "Error: unsupported groups"         exitFailure@@ -152,7 +154,7 @@             Aux                 { auxAuthority = host                 , auxPort = port-                , auxDebug = debug+                , auxDebugPrint = debug                 , auxShow = showContent                 , auxReadResumptionData = readIORef ref                 }@@ -162,12 +164,14 @@         client             | optALPN == "dot" = clientDNS             | otherwise = clientHTTP11+    makeCipherShowPretty     runClient opts client cparams aux paths -runClient :: Options -> Cli -> ClientParams -> Aux -> [ByteString] -> IO ()+runClient+    :: Options -> Cli -> ClientParams -> Aux -> NonEmpty ByteString -> IO () runClient opts@Options{..} client cparams aux@Aux{..} paths = do-    auxDebug "------------------------"-    (info1, msd) <- runTLS cparams aux $ \ctx -> do+    auxDebugPrint "------------------------"+    (info1, msd) <- runTLS opts cparams aux $ \ctx -> do         i1 <- getInfo ctx         when optDebugLog $ printHandshakeInfo i1         client aux paths ctx@@ -233,13 +237,13 @@     -> Cli     -> ClientParams     -> Aux-    -> [ByteString]+    -> NonEmpty ByteString     -> IO Information-runClient2 Options{..} client cparams aux@Aux{..} paths = do+runClient2 opts@Options{..} client cparams aux@Aux{..} paths = do     threadDelay 100000-    auxDebug "<<<< next connection >>>>"-    auxDebug "------------------------"-    runTLS cparams aux $ \ctx -> do+    auxDebugPrint "<<<< next connection >>>>"+    auxDebugPrint "------------------------"+    runTLS opts cparams aux $ \ctx -> do         if opt0RTT             then do                 void $ client aux paths ctx@@ -253,15 +257,25 @@                 return i  runTLS-    :: ClientParams+    :: Options+    -> ClientParams     -> Aux     -> (Context -> IO a)     -> IO a-runTLS cparams Aux{..} action =+runTLS Options{..} cparams Aux{..} action =     runTCPClient auxAuthority auxPort $ \sock -> do-        E.bracket (contextNew sock cparams) bye $ \ctx -> do-            handshake ctx-            action ctx+        ctx <- contextNew sock cparams+        when optDebugLog $+            contextHookSetLogging+                ctx+                defaultLogging+                    { loggingPacketSent = putStrLn . (">> " ++)+                    , loggingPacketRecv = putStrLn . ("<< " ++)+                    }+        handshake ctx+        r <- action ctx+        bye ctx+        return r  modifyClientParams     :: ClientParams -> [(SessionID, SessionData)] -> Bool -> ClientParams@@ -291,7 +305,7 @@         | optRetry = FFDHE8192 : optGroups         | otherwise = optGroups     shared =-        def+        defaultShared             { sharedSessionManager = sm             , sharedCAStore = case mstore of                 Just store -> store@@ -299,22 +313,22 @@             , sharedValidationCache = validateCache             }     supported =-        def+        defaultSupported             { supportedVersions = optVersions             , supportedGroups = groups             }     hooks =-        def+        defaultClientHooks             { onSuggestALPN = return $ Just [C8.pack optALPN]             }     validateCache-        | isJust mstore = def+        | isJust mstore = sharedValidationCache defaultShared         | otherwise =             ValidationCache                 (\_ _ _ -> return ValidationCachePass)                 (\_ _ _ -> return ())     debug =-        def+        defaultDebugParams             { debugKeyLogger = getLogger optKeyLogFile             } 

@@ -5,14 +5,13 @@  module Main where -import qualified Control.Exception as E import qualified Data.ByteString.Base16 as BS16 import qualified Data.ByteString.Char8 as C8-import Data.Default (def) import Data.IORef import qualified Data.Map.Strict as M import Network.Run.TCP import Network.TLS+import Network.TLS.Internal import System.Console.GetOpt import System.Environment (getArgs) import System.Exit@@ -38,8 +37,7 @@         { optDebugLog = False         , optShow = False         , optKeyLogFile = Nothing-        , -- excluding FFDHE8192 for retry-          optGroups = [X25519, X448, P256, P521]+        , optGroups = supportedGroups defaultSupported         , optCertFile = "servercert.pem"         , optKeyFile = "serverkey.pem"         }@@ -108,14 +106,23 @@     Right cred@(!_cc, !_priv) <- credentialLoadX509 optCertFile optKeyFile     let keyLog = getLogger optKeyLogFile         creds = Credentials [cred]+    makeCipherShowPretty     runTCPServer (Just host) port $ \sock -> do         let sparams = getServerParams creds optGroups smgr keyLog-        E.bracket (contextNew sock sparams) bye $ \ctx -> do-            handshake ctx-            when (optDebugLog || optShow) $ putStrLn "------------------------"-            when optDebugLog $-                getInfo ctx >>= printHandshakeInfo-            server ctx optShow+        ctx <- contextNew sock sparams+        when optDebugLog $+            contextHookSetLogging+                ctx+                defaultLogging+                    { loggingPacketSent = putStrLn . ("<< " ++)+                    , loggingPacketRecv = putStrLn . (">> " ++)+                    }+        when (optDebugLog || optShow) $ putStrLn "------------------------"+        handshake ctx+        when optDebugLog $+            getInfo ctx >>= printHandshakeInfo+        server ctx optShow+        bye ctx  getServerParams     :: Credentials@@ -124,7 +131,7 @@     -> (String -> IO ())     -> ServerParams getServerParams creds groups sm keyLog =-    def+    defaultParamsServer         { serverSupported = supported         , serverShared = shared         , serverHooks = hooks@@ -133,16 +140,16 @@         }   where     shared =-        def+        defaultShared             { sharedCredentials = creds             , sharedSessionManager = sm             }     supported =-        def+        defaultSupported             { supportedGroups = groups             }-    hooks = def{onALPNClientSuggest = Just chooseALPN}-    debug = def{debugKeyLogger = keyLog}+    hooks = defaultServerHooks{onALPNClientSuggest = Just chooseALPN}+    debug = defaultDebugParams{debugKeyLogger = keyLog}  chooseALPN :: [ByteString] -> IO ByteString chooseALPN protos