{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_HADDOCK hide #-}

-- | The Struct module contains all definitions and values of the TLS
-- protocol.
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,
        CertificateType_DSA_Sign,
        CertificateType_ECDSA_Sign,
        CertificateType_Ed25519_Sign,
        CertificateType_Ed448_Sign
    ),
    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 (
        ..,
        ProtocolType_ChangeCipherSpec,
        ProtocolType_Alert,
        ProtocolType_Handshake,
        ProtocolType_AppData
    ),
    TLSError (..),
    TLSException (..),
    DistinguishedName,
    BigNum (..),
    bigNumToInteger,
    bigNumFromInteger,
    ServerDHParams (..),
    serverDHParamsToParams,
    serverDHParamsToPublic,
    serverDHParamsFrom,
    ServerECDHParams (..),
    ServerRSAParams (..),
    ServerKeyXchgAlgorithmData (..),
    ClientKeyXchgAlgorithmData (..),
    Packet (..),
    Header (..),
    ServerRandom (..),
    ClientRandom (..),
    FinishedData,
    VerifyData,
    SessionID,
    Session (..),
    SessionData (..),
    AlertLevel (
        ..,
        AlertLevel_Warning,
        AlertLevel_Fatal
    ),
    AlertDescription (
        ..,
        CloseNotify,
        UnexpectedMessage,
        BadRecordMac,
        DecryptionFailed,
        RecordOverflow,
        DecompressionFailure,
        HandshakeFailure,
        BadCertificate,
        UnsupportedCertificate,
        CertificateRevoked,
        CertificateExpired,
        CertificateUnknown,
        IllegalParameter,
        UnknownCa,
        AccessDenied,
        DecodeError,
        DecryptError,
        ExportRestriction,
        ProtocolVersion,
        InsufficientSecurity,
        InternalError,
        InappropriateFallback,
        UserCanceled,
        NoRenegotiation,
        MissingExtension,
        UnsupportedExtension,
        CertificateUnobtainable,
        UnrecognizedName,
        BadCertificateStatusResponse,
        BadCertificateHashValue,
        UnknownPskIdentity,
        CertificateRequired,
        NoApplicationProtocol
    ),
    HandshakeType (
        ..,
        HandshakeType_HelloRequest,
        HandshakeType_ClientHello,
        HandshakeType_ServerHello,
        HandshakeType_NewSessionTicket,
        HandshakeType_EndOfEarlyData,
        HandshakeType_EncryptedExtensions,
        HandshakeType_Certificate,
        HandshakeType_ServerKeyXchg,
        HandshakeType_CertRequest,
        HandshakeType_ServerHelloDone,
        HandshakeType_CertVerify,
        HandshakeType_ClientKeyXchg,
        HandshakeType_Finished,
        HandshakeType_KeyUpdate
    ),
    Handshake (..),
    CH (..),
    packetType,
    typeOfHandshake,
) 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.Imports
import Network.TLS.Types
import Network.TLS.Util.Serialization

----------------------------------------------------------------

data CipherData = CipherData
    { CipherData -> ByteString
cipherDataContent :: ByteString
    , CipherData -> Maybe ByteString
cipherDataMAC :: Maybe ByteString
    , CipherData -> Maybe (ByteString, Int)
cipherDataPadding :: Maybe (ByteString, Int)
    }
    deriving (Int -> CipherData -> ShowS
[CipherData] -> ShowS
CipherData -> String
(Int -> CipherData -> ShowS)
-> (CipherData -> String)
-> ([CipherData] -> ShowS)
-> Show CipherData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CipherData -> ShowS
showsPrec :: Int -> CipherData -> ShowS
$cshow :: CipherData -> String
show :: CipherData -> String
$cshowList :: [CipherData] -> ShowS
showList :: [CipherData] -> ShowS
Show, CipherData -> CipherData -> Bool
(CipherData -> CipherData -> Bool)
-> (CipherData -> CipherData -> Bool) -> Eq CipherData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CipherData -> CipherData -> Bool
== :: CipherData -> CipherData -> Bool
$c/= :: CipherData -> CipherData -> Bool
/= :: CipherData -> CipherData -> Bool
Eq)

----------------------------------------------------------------

-- | Some of the IANA registered code points for 'CertificateType' are not
-- currently supported by the library.  Nor should they be, they're are either
-- unwise, obsolete or both.  There's no point in conveying these to the user
-- in the client certificate request callback.  The request callback will be
-- filtered to exclude unsupported values.  If the user cannot find a certificate
-- for a supported code point, we'll go ahead without a client certificate and
-- hope for the best, unless the user's callback decides to throw an exception.
newtype CertificateType = CertificateType {CertificateType -> Word8
fromCertificateType :: Word8}
    deriving (CertificateType -> CertificateType -> Bool
(CertificateType -> CertificateType -> Bool)
-> (CertificateType -> CertificateType -> Bool)
-> Eq CertificateType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertificateType -> CertificateType -> Bool
== :: CertificateType -> CertificateType -> Bool
$c/= :: CertificateType -> CertificateType -> Bool
/= :: CertificateType -> CertificateType -> Bool
Eq, Eq CertificateType
Eq CertificateType =>
(CertificateType -> CertificateType -> Ordering)
-> (CertificateType -> CertificateType -> Bool)
-> (CertificateType -> CertificateType -> Bool)
-> (CertificateType -> CertificateType -> Bool)
-> (CertificateType -> CertificateType -> Bool)
-> (CertificateType -> CertificateType -> CertificateType)
-> (CertificateType -> CertificateType -> CertificateType)
-> Ord CertificateType
CertificateType -> CertificateType -> Bool
CertificateType -> CertificateType -> Ordering
CertificateType -> CertificateType -> CertificateType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CertificateType -> CertificateType -> Ordering
compare :: CertificateType -> CertificateType -> Ordering
$c< :: CertificateType -> CertificateType -> Bool
< :: CertificateType -> CertificateType -> Bool
$c<= :: CertificateType -> CertificateType -> Bool
<= :: CertificateType -> CertificateType -> Bool
$c> :: CertificateType -> CertificateType -> Bool
> :: CertificateType -> CertificateType -> Bool
$c>= :: CertificateType -> CertificateType -> Bool
>= :: CertificateType -> CertificateType -> Bool
$cmax :: CertificateType -> CertificateType -> CertificateType
max :: CertificateType -> CertificateType -> CertificateType
$cmin :: CertificateType -> CertificateType -> CertificateType
min :: CertificateType -> CertificateType -> CertificateType
Ord)

{- FOURMOLU_DISABLE -}
-- | TLS10 and up, RFC5246
pattern CertificateType_RSA_Sign     :: CertificateType
pattern $mCertificateType_RSA_Sign :: forall {r}. CertificateType -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateType_RSA_Sign :: CertificateType
CertificateType_RSA_Sign      = CertificateType 1
-- | TLS10 and up, RFC5246
pattern CertificateType_DSA_Sign     :: CertificateType
pattern $mCertificateType_DSA_Sign :: forall {r}. CertificateType -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateType_DSA_Sign :: CertificateType
CertificateType_DSA_Sign      = CertificateType 2
-- | TLS10 and up, RFC8422
pattern CertificateType_ECDSA_Sign   :: CertificateType
pattern $mCertificateType_ECDSA_Sign :: forall {r}. CertificateType -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateType_ECDSA_Sign :: CertificateType
CertificateType_ECDSA_Sign    = CertificateType 64
-- \| There are no code points that map to the below synthetic types, these
-- are inferred indirectly from the @signature_algorithms@ extension of the
-- TLS 1.3 @CertificateRequest@ message.  the value assignments are there
-- only to avoid partial function warnings.
pattern CertificateType_Ed25519_Sign :: CertificateType
pattern $mCertificateType_Ed25519_Sign :: forall {r}. CertificateType -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateType_Ed25519_Sign :: CertificateType
CertificateType_Ed25519_Sign  = CertificateType 254 -- fixme: dummy value
pattern CertificateType_Ed448_Sign   :: CertificateType
pattern $mCertificateType_Ed448_Sign :: forall {r}. CertificateType -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateType_Ed448_Sign :: CertificateType
CertificateType_Ed448_Sign    = CertificateType 255 -- fixme:  dummy value

instance Show CertificateType where
    show :: CertificateType -> String
show CertificateType
CertificateType_RSA_Sign     = String
"CertificateType_RSA_Sign"
    show CertificateType
CertificateType_DSA_Sign     = String
"CertificateType_DSA_Sign"
    show CertificateType
CertificateType_ECDSA_Sign   = String
"CertificateType_ECDSA_Sign"
    show CertificateType
CertificateType_Ed25519_Sign = String
"CertificateType_Ed25519_Sign"
    show CertificateType
CertificateType_Ed448_Sign   = String
"CertificateType_Ed448_Sign"
    show (CertificateType Word8
x)          = String
"CertificateType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}

-- | Last supported certificate type, no 'CertificateType that
-- compares greater than this one (based on the 'Ord' instance,
-- not on the wire code point) will be reported to the application
-- via the client certificate request callback.
lastSupportedCertificateType :: CertificateType
lastSupportedCertificateType :: CertificateType
lastSupportedCertificateType = CertificateType
CertificateType_ECDSA_Sign

------------------------------------------------------------

newtype HashAlgorithm = HashAlgorithm {HashAlgorithm -> Word8
fromHashAlgorithm :: Word8}
    deriving (HashAlgorithm -> HashAlgorithm -> Bool
(HashAlgorithm -> HashAlgorithm -> Bool)
-> (HashAlgorithm -> HashAlgorithm -> Bool) -> Eq HashAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashAlgorithm -> HashAlgorithm -> Bool
== :: HashAlgorithm -> HashAlgorithm -> Bool
$c/= :: HashAlgorithm -> HashAlgorithm -> Bool
/= :: HashAlgorithm -> HashAlgorithm -> Bool
Eq)

{- FOURMOLU_DISABLE -}
pattern HashNone      :: HashAlgorithm
pattern $mHashNone :: forall {r}. HashAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bHashNone :: HashAlgorithm
HashNone       = HashAlgorithm 0
pattern HashMD5       :: HashAlgorithm
pattern $mHashMD5 :: forall {r}. HashAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bHashMD5 :: HashAlgorithm
HashMD5        = HashAlgorithm 1
pattern HashSHA1      :: HashAlgorithm
pattern $mHashSHA1 :: forall {r}. HashAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bHashSHA1 :: HashAlgorithm
HashSHA1       = HashAlgorithm 2
pattern HashSHA224    :: HashAlgorithm
pattern $mHashSHA224 :: forall {r}. HashAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bHashSHA224 :: HashAlgorithm
HashSHA224     = HashAlgorithm 3
pattern HashSHA256    :: HashAlgorithm
pattern $mHashSHA256 :: forall {r}. HashAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bHashSHA256 :: HashAlgorithm
HashSHA256     = HashAlgorithm 4
pattern HashSHA384    :: HashAlgorithm
pattern $mHashSHA384 :: forall {r}. HashAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bHashSHA384 :: HashAlgorithm
HashSHA384     = HashAlgorithm 5
pattern HashSHA512    :: HashAlgorithm
pattern $mHashSHA512 :: forall {r}. HashAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bHashSHA512 :: HashAlgorithm
HashSHA512     = HashAlgorithm 6
pattern HashIntrinsic :: HashAlgorithm
pattern $mHashIntrinsic :: forall {r}. HashAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bHashIntrinsic :: HashAlgorithm
HashIntrinsic  = HashAlgorithm 8

instance Show HashAlgorithm where
    show :: HashAlgorithm -> String
show HashAlgorithm
HashNone          = String
"HashNone"
    show HashAlgorithm
HashMD5           = String
"HashMD5"
    show HashAlgorithm
HashSHA1          = String
"HashSHA1"
    show HashAlgorithm
HashSHA224        = String
"HashSHA224"
    show HashAlgorithm
HashSHA256        = String
"HashSHA256"
    show HashAlgorithm
HashSHA384        = String
"HashSHA384"
    show HashAlgorithm
HashSHA512        = String
"HashSHA512"
    show HashAlgorithm
HashIntrinsic     = String
"HashIntrinsic"
    show (HashAlgorithm Word8
x) = String
"HashAlgorithm " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}

------------------------------------------------------------

newtype SignatureAlgorithm = SignatureAlgorithm {SignatureAlgorithm -> Word8
fromSignatureAlgorithm :: Word8}
    deriving (SignatureAlgorithm -> SignatureAlgorithm -> Bool
(SignatureAlgorithm -> SignatureAlgorithm -> Bool)
-> (SignatureAlgorithm -> SignatureAlgorithm -> Bool)
-> Eq SignatureAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignatureAlgorithm -> SignatureAlgorithm -> Bool
== :: SignatureAlgorithm -> SignatureAlgorithm -> Bool
$c/= :: SignatureAlgorithm -> SignatureAlgorithm -> Bool
/= :: SignatureAlgorithm -> SignatureAlgorithm -> Bool
Eq)

{- FOURMOLU_DISABLE -}
pattern SignatureAnonymous        :: SignatureAlgorithm
pattern $mSignatureAnonymous :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureAnonymous :: SignatureAlgorithm
SignatureAnonymous         = SignatureAlgorithm 0
pattern SignatureRSA              :: SignatureAlgorithm
pattern $mSignatureRSA :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureRSA :: SignatureAlgorithm
SignatureRSA               = SignatureAlgorithm 1
pattern SignatureDSA              :: SignatureAlgorithm
pattern $mSignatureDSA :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureDSA :: SignatureAlgorithm
SignatureDSA               = SignatureAlgorithm 2
pattern SignatureECDSA            :: SignatureAlgorithm
pattern $mSignatureECDSA :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureECDSA :: SignatureAlgorithm
SignatureECDSA             = SignatureAlgorithm 3
-- TLS 1.3 from here
pattern SignatureRSApssRSAeSHA256 :: SignatureAlgorithm
pattern $mSignatureRSApssRSAeSHA256 :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureRSApssRSAeSHA256 :: SignatureAlgorithm
SignatureRSApssRSAeSHA256  = SignatureAlgorithm 4
pattern SignatureRSApssRSAeSHA384 :: SignatureAlgorithm
pattern $mSignatureRSApssRSAeSHA384 :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureRSApssRSAeSHA384 :: SignatureAlgorithm
SignatureRSApssRSAeSHA384  = SignatureAlgorithm 5
pattern SignatureRSApssRSAeSHA512 :: SignatureAlgorithm
pattern $mSignatureRSApssRSAeSHA512 :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureRSApssRSAeSHA512 :: SignatureAlgorithm
SignatureRSApssRSAeSHA512  = SignatureAlgorithm 6
pattern SignatureEd25519          :: SignatureAlgorithm
pattern $mSignatureEd25519 :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureEd25519 :: SignatureAlgorithm
SignatureEd25519           = SignatureAlgorithm 7
pattern SignatureEd448            :: SignatureAlgorithm
pattern $mSignatureEd448 :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureEd448 :: SignatureAlgorithm
SignatureEd448             = SignatureAlgorithm 8
pattern SignatureRSApsspssSHA256  :: SignatureAlgorithm
pattern $mSignatureRSApsspssSHA256 :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureRSApsspssSHA256 :: SignatureAlgorithm
SignatureRSApsspssSHA256   = SignatureAlgorithm 9
pattern SignatureRSApsspssSHA384  :: SignatureAlgorithm
pattern $mSignatureRSApsspssSHA384 :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureRSApsspssSHA384 :: SignatureAlgorithm
SignatureRSApsspssSHA384   = SignatureAlgorithm 10
pattern SignatureRSApsspssSHA512  :: SignatureAlgorithm
pattern $mSignatureRSApsspssSHA512 :: forall {r}. SignatureAlgorithm -> ((# #) -> r) -> ((# #) -> r) -> r
$bSignatureRSApsspssSHA512 :: SignatureAlgorithm
SignatureRSApsspssSHA512   = SignatureAlgorithm 11

instance Show SignatureAlgorithm where
    show :: SignatureAlgorithm -> String
show SignatureAlgorithm
SignatureAnonymous        = String
"SignatureAnonymous"
    show SignatureAlgorithm
SignatureRSA              = String
"SignatureRSA"
    show SignatureAlgorithm
SignatureDSA              = String
"SignatureDSA"
    show SignatureAlgorithm
SignatureECDSA            = String
"SignatureECDSA"
    show SignatureAlgorithm
SignatureRSApssRSAeSHA256 = String
"SignatureRSApssRSAeSHA256"
    show SignatureAlgorithm
SignatureRSApssRSAeSHA384 = String
"SignatureRSApssRSAeSHA384"
    show SignatureAlgorithm
SignatureRSApssRSAeSHA512 = String
"SignatureRSApssRSAeSHA512"
    show SignatureAlgorithm
SignatureEd25519          = String
"SignatureEd25519"
    show SignatureAlgorithm
SignatureEd448            = String
"SignatureEd448"
    show SignatureAlgorithm
SignatureRSApsspssSHA256  = String
"SignatureRSApsspssSHA256"
    show SignatureAlgorithm
SignatureRSApsspssSHA384  = String
"SignatureRSApsspssSHA384"
    show SignatureAlgorithm
SignatureRSApsspssSHA512  = String
"SignatureRSApsspssSHA512"
    show (SignatureAlgorithm Word8
x)    = String
"SignatureAlgorithm " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}

------------------------------------------------------------

type HashAndSignatureAlgorithm = (HashAlgorithm, SignatureAlgorithm)

{- FOURMOLU_DISABLE -}
supportedSignatureSchemes :: [HashAndSignatureAlgorithm]
supportedSignatureSchemes :: [HashAndSignatureAlgorithm]
supportedSignatureSchemes =
    -- EdDSA algorithms
    [ (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd448)   -- ed448  (0x0808)
    , (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureEd25519) -- ed25519(0x0807)
    -- ECDSA algorithms
    , (HashAlgorithm
HashSHA256,    SignatureAlgorithm
SignatureECDSA)   -- ecdsa_secp256r1_sha256(0x0403)
    , (HashAlgorithm
HashSHA384,    SignatureAlgorithm
SignatureECDSA)   -- ecdsa_secp384r1_sha384(0x0503)
    , (HashAlgorithm
HashSHA512,    SignatureAlgorithm
SignatureECDSA)   -- ecdsa_secp256r1_sha256(0x0403)
    -- RSASSA-PSS algorithms with public key OID RSASSA-PSS
    , (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA512) -- rsa_pss_pss_sha512(0x080b)
    , (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA384) -- rsa_pss_pss_sha384(0x080a)
    , (HashAlgorithm
HashIntrinsic, SignatureAlgorithm
SignatureRSApssRSAeSHA256) -- rsa_pss_pss_sha256(0x0809)
    -- RSASSA-PKCS1-v1_5 algorithms
    , (HashAlgorithm
HashSHA512,    SignatureAlgorithm
SignatureRSA)    -- rsa_pkcs1_sha512(0x0601)
    , (HashAlgorithm
HashSHA384,    SignatureAlgorithm
SignatureRSA)    -- rsa_pkcs1_sha384(0x0501)
    , (HashAlgorithm
HashSHA256,    SignatureAlgorithm
SignatureRSA)    -- rsa_pkcs1_sha256(0x0401)
    -- Legacy algorithms
    , (HashAlgorithm
HashSHA1,      SignatureAlgorithm
SignatureRSA)    -- rsa_pkcs1_sha1  (0x0201)
    , (HashAlgorithm
HashSHA1,      SignatureAlgorithm
SignatureECDSA)  -- ecdsa_sha1      (0x0203)
    ]
{- FOURMOLU_ENABLE -}

------------------------------------------------------------

type Signature = ByteString

data DigitallySigned = DigitallySigned HashAndSignatureAlgorithm Signature
    deriving (Int -> DigitallySigned -> ShowS
[DigitallySigned] -> ShowS
DigitallySigned -> String
(Int -> DigitallySigned -> ShowS)
-> (DigitallySigned -> String)
-> ([DigitallySigned] -> ShowS)
-> Show DigitallySigned
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DigitallySigned -> ShowS
showsPrec :: Int -> DigitallySigned -> ShowS
$cshow :: DigitallySigned -> String
show :: DigitallySigned -> String
$cshowList :: [DigitallySigned] -> ShowS
showList :: [DigitallySigned] -> ShowS
Show, DigitallySigned -> DigitallySigned -> Bool
(DigitallySigned -> DigitallySigned -> Bool)
-> (DigitallySigned -> DigitallySigned -> Bool)
-> Eq DigitallySigned
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DigitallySigned -> DigitallySigned -> Bool
== :: DigitallySigned -> DigitallySigned -> Bool
$c/= :: DigitallySigned -> DigitallySigned -> Bool
/= :: DigitallySigned -> DigitallySigned -> Bool
Eq)

----------------------------------------------------------------

newtype ProtocolType = ProtocolType {ProtocolType -> Word8
fromProtocolType :: Word8} deriving (ProtocolType -> ProtocolType -> Bool
(ProtocolType -> ProtocolType -> Bool)
-> (ProtocolType -> ProtocolType -> Bool) -> Eq ProtocolType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolType -> ProtocolType -> Bool
== :: ProtocolType -> ProtocolType -> Bool
$c/= :: ProtocolType -> ProtocolType -> Bool
/= :: ProtocolType -> ProtocolType -> Bool
Eq)

{- FOURMOLU_DISABLE -}
pattern ProtocolType_ChangeCipherSpec :: ProtocolType
pattern $mProtocolType_ChangeCipherSpec :: forall {r}. ProtocolType -> ((# #) -> r) -> ((# #) -> r) -> r
$bProtocolType_ChangeCipherSpec :: ProtocolType
ProtocolType_ChangeCipherSpec  = ProtocolType 20

pattern ProtocolType_Alert            :: ProtocolType
pattern $mProtocolType_Alert :: forall {r}. ProtocolType -> ((# #) -> r) -> ((# #) -> r) -> r
$bProtocolType_Alert :: ProtocolType
ProtocolType_Alert             = ProtocolType 21

pattern ProtocolType_Handshake        :: ProtocolType
pattern $mProtocolType_Handshake :: forall {r}. ProtocolType -> ((# #) -> r) -> ((# #) -> r) -> r
$bProtocolType_Handshake :: ProtocolType
ProtocolType_Handshake         = ProtocolType 22

pattern ProtocolType_AppData          :: ProtocolType
pattern $mProtocolType_AppData :: forall {r}. ProtocolType -> ((# #) -> r) -> ((# #) -> r) -> r
$bProtocolType_AppData :: ProtocolType
ProtocolType_AppData           = ProtocolType 23

instance Show ProtocolType where
    show :: ProtocolType -> String
show ProtocolType
ProtocolType_ChangeCipherSpec = String
"ChangeCipherSpec"
    show ProtocolType
ProtocolType_Alert            = String
"Alert"
    show ProtocolType
ProtocolType_Handshake        = String
"Handshake"
    show ProtocolType
ProtocolType_AppData          = String
"AppData"
    show (ProtocolType Word8
x)              = String
"ProtocolType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}

----------------------------------------------------------------

-- | 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 (TLSError -> TLSError -> Bool
(TLSError -> TLSError -> Bool)
-> (TLSError -> TLSError -> Bool) -> Eq TLSError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TLSError -> TLSError -> Bool
== :: TLSError -> TLSError -> Bool
$c/= :: TLSError -> TLSError -> Bool
/= :: TLSError -> TLSError -> Bool
Eq, Int -> TLSError -> ShowS
[TLSError] -> ShowS
TLSError -> String
(Int -> TLSError -> ShowS)
-> (TLSError -> String) -> ([TLSError] -> ShowS) -> Show TLSError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TLSError -> ShowS
showsPrec :: Int -> TLSError -> ShowS
$cshow :: TLSError -> String
show :: TLSError -> String
$cshowList :: [TLSError] -> ShowS
showList :: [TLSError] -> ShowS
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 (Int -> TLSException -> ShowS
[TLSException] -> ShowS
TLSException -> String
(Int -> TLSException -> ShowS)
-> (TLSException -> String)
-> ([TLSException] -> ShowS)
-> Show TLSException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TLSException -> ShowS
showsPrec :: Int -> TLSException -> ShowS
$cshow :: TLSException -> String
show :: TLSException -> String
$cshowList :: [TLSException] -> ShowS
showList :: [TLSException] -> ShowS
Show, TLSException -> TLSException -> Bool
(TLSException -> TLSException -> Bool)
-> (TLSException -> TLSException -> Bool) -> Eq TLSException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TLSException -> TLSException -> Bool
== :: TLSException -> TLSException -> Bool
$c/= :: TLSException -> TLSException -> Bool
/= :: TLSException -> TLSException -> Bool
Eq, Typeable)

instance Exception TLSException

----------------------------------------------------------------

data Packet
    = Handshake [Handshake]
    | Alert [(AlertLevel, AlertDescription)]
    | ChangeCipherSpec
    | AppData ByteString
    deriving (Packet -> Packet -> Bool
(Packet -> Packet -> Bool)
-> (Packet -> Packet -> Bool) -> Eq Packet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Packet -> Packet -> Bool
== :: Packet -> Packet -> Bool
$c/= :: Packet -> Packet -> Bool
/= :: Packet -> Packet -> Bool
Eq)

instance Show Packet where
    show :: Packet -> String
show (Handshake [Handshake]
hs) = String
"Handshake " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Handshake] -> String
forall a. Show a => a -> String
show [Handshake]
hs
    show (Alert [(AlertLevel, AlertDescription)]
as) = String
"Alert " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(AlertLevel, AlertDescription)] -> String
forall a. Show a => a -> String
show [(AlertLevel, AlertDescription)]
as
    show Packet
ChangeCipherSpec = String
"ChangeCipherSpec"
    show (AppData ByteString
bs) = String
"AppData " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
B16.encode ByteString
bs)

data Header = Header ProtocolType Version Word16 deriving (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header -> ShowS
showsPrec :: Int -> Header -> ShowS
$cshow :: Header -> String
show :: Header -> String
$cshowList :: [Header] -> ShowS
showList :: [Header] -> ShowS
Show, Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
/= :: Header -> Header -> Bool
Eq)

newtype ServerRandom = ServerRandom {ServerRandom -> ByteString
unServerRandom :: ByteString}
    deriving (Int -> ServerRandom -> ShowS
[ServerRandom] -> ShowS
ServerRandom -> String
(Int -> ServerRandom -> ShowS)
-> (ServerRandom -> String)
-> ([ServerRandom] -> ShowS)
-> Show ServerRandom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerRandom -> ShowS
showsPrec :: Int -> ServerRandom -> ShowS
$cshow :: ServerRandom -> String
show :: ServerRandom -> String
$cshowList :: [ServerRandom] -> ShowS
showList :: [ServerRandom] -> ShowS
Show, ServerRandom -> ServerRandom -> Bool
(ServerRandom -> ServerRandom -> Bool)
-> (ServerRandom -> ServerRandom -> Bool) -> Eq ServerRandom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerRandom -> ServerRandom -> Bool
== :: ServerRandom -> ServerRandom -> Bool
$c/= :: ServerRandom -> ServerRandom -> Bool
/= :: ServerRandom -> ServerRandom -> Bool
Eq)
newtype ClientRandom = ClientRandom {ClientRandom -> ByteString
unClientRandom :: ByteString}
    deriving (Int -> ClientRandom -> ShowS
[ClientRandom] -> ShowS
ClientRandom -> String
(Int -> ClientRandom -> ShowS)
-> (ClientRandom -> String)
-> ([ClientRandom] -> ShowS)
-> Show ClientRandom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientRandom -> ShowS
showsPrec :: Int -> ClientRandom -> ShowS
$cshow :: ClientRandom -> String
show :: ClientRandom -> String
$cshowList :: [ClientRandom] -> ShowS
showList :: [ClientRandom] -> ShowS
Show, ClientRandom -> ClientRandom -> Bool
(ClientRandom -> ClientRandom -> Bool)
-> (ClientRandom -> ClientRandom -> Bool) -> Eq ClientRandom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientRandom -> ClientRandom -> Bool
== :: ClientRandom -> ClientRandom -> Bool
$c/= :: ClientRandom -> ClientRandom -> Bool
/= :: ClientRandom -> ClientRandom -> Bool
Eq)
newtype Session = Session (Maybe SessionID) deriving (Int -> Session -> ShowS
[Session] -> ShowS
Session -> String
(Int -> Session -> ShowS)
-> (Session -> String) -> ([Session] -> ShowS) -> Show Session
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Session -> ShowS
showsPrec :: Int -> Session -> ShowS
$cshow :: Session -> String
show :: Session -> String
$cshowList :: [Session] -> ShowS
showList :: [Session] -> ShowS
Show, Session -> Session -> Bool
(Session -> Session -> Bool)
-> (Session -> Session -> Bool) -> Eq Session
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Session -> Session -> Bool
== :: Session -> Session -> Bool
$c/= :: Session -> Session -> Bool
/= :: Session -> Session -> Bool
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 {ExtensionID -> Word16
fromExtensionID :: Word16} deriving (ExtensionID -> ExtensionID -> Bool
(ExtensionID -> ExtensionID -> Bool)
-> (ExtensionID -> ExtensionID -> Bool) -> Eq ExtensionID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtensionID -> ExtensionID -> Bool
== :: ExtensionID -> ExtensionID -> Bool
$c/= :: ExtensionID -> ExtensionID -> Bool
/= :: ExtensionID -> ExtensionID -> Bool
Eq)

{- FOURMOLU_DISABLE -}
pattern EID_ServerName                          :: ExtensionID -- RFC6066
pattern $mEID_ServerName :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_ServerName :: ExtensionID
EID_ServerName                           = ExtensionID 0x0
pattern EID_MaxFragmentLength                   :: ExtensionID -- RFC6066
pattern $mEID_MaxFragmentLength :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_MaxFragmentLength :: ExtensionID
EID_MaxFragmentLength                    = ExtensionID 0x1
pattern EID_ClientCertificateUrl                :: ExtensionID -- RFC6066
pattern $mEID_ClientCertificateUrl :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_ClientCertificateUrl :: ExtensionID
EID_ClientCertificateUrl                 = ExtensionID 0x2
pattern EID_TrustedCAKeys                       :: ExtensionID -- RFC6066
pattern $mEID_TrustedCAKeys :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_TrustedCAKeys :: ExtensionID
EID_TrustedCAKeys                        = ExtensionID 0x3
pattern EID_TruncatedHMAC                       :: ExtensionID -- RFC6066
pattern $mEID_TruncatedHMAC :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_TruncatedHMAC :: ExtensionID
EID_TruncatedHMAC                        = ExtensionID 0x4
pattern EID_StatusRequest                       :: ExtensionID -- RFC6066
pattern $mEID_StatusRequest :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_StatusRequest :: ExtensionID
EID_StatusRequest                        = ExtensionID 0x5
pattern EID_UserMapping                         :: ExtensionID -- RFC4681
pattern $mEID_UserMapping :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_UserMapping :: ExtensionID
EID_UserMapping                          = ExtensionID 0x6
pattern EID_ClientAuthz                         :: ExtensionID -- RFC5878
pattern $mEID_ClientAuthz :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_ClientAuthz :: ExtensionID
EID_ClientAuthz                          = ExtensionID 0x7
pattern EID_ServerAuthz                         :: ExtensionID -- RFC5878
pattern $mEID_ServerAuthz :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_ServerAuthz :: ExtensionID
EID_ServerAuthz                          = ExtensionID 0x8
pattern EID_CertType                            :: ExtensionID -- RFC6091
pattern $mEID_CertType :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_CertType :: ExtensionID
EID_CertType                             = ExtensionID 0x9
pattern EID_SupportedGroups                     :: ExtensionID -- RFC8422,8446
pattern $mEID_SupportedGroups :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_SupportedGroups :: ExtensionID
EID_SupportedGroups                      = ExtensionID 0xa
pattern EID_EcPointFormats                      :: ExtensionID -- RFC4492
pattern $mEID_EcPointFormats :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_EcPointFormats :: ExtensionID
EID_EcPointFormats                       = ExtensionID 0xb
pattern EID_SRP                                 :: ExtensionID -- RFC5054
pattern $mEID_SRP :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_SRP :: ExtensionID
EID_SRP                                  = ExtensionID 0xc
pattern EID_SignatureAlgorithms                 :: ExtensionID -- RFC5246,8446
pattern $mEID_SignatureAlgorithms :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_SignatureAlgorithms :: ExtensionID
EID_SignatureAlgorithms                  = ExtensionID 0xd
pattern EID_SRTP                                :: ExtensionID -- RFC5764
pattern $mEID_SRTP :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_SRTP :: ExtensionID
EID_SRTP                                 = ExtensionID 0xe
pattern EID_Heartbeat                           :: ExtensionID -- RFC6520
pattern $mEID_Heartbeat :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_Heartbeat :: ExtensionID
EID_Heartbeat                            = ExtensionID 0xf
pattern EID_ApplicationLayerProtocolNegotiation :: ExtensionID -- RFC7301
pattern $mEID_ApplicationLayerProtocolNegotiation :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_ApplicationLayerProtocolNegotiation :: ExtensionID
EID_ApplicationLayerProtocolNegotiation  = ExtensionID 0x10
pattern EID_StatusRequestv2                     :: ExtensionID -- RFC6961
pattern $mEID_StatusRequestv2 :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_StatusRequestv2 :: ExtensionID
EID_StatusRequestv2                      = ExtensionID 0x11
pattern EID_SignedCertificateTimestamp          :: ExtensionID -- RFC6962
pattern $mEID_SignedCertificateTimestamp :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_SignedCertificateTimestamp :: ExtensionID
EID_SignedCertificateTimestamp           = ExtensionID 0x12
pattern EID_ClientCertificateType               :: ExtensionID -- RFC7250
pattern $mEID_ClientCertificateType :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_ClientCertificateType :: ExtensionID
EID_ClientCertificateType                = ExtensionID 0x13
pattern EID_ServerCertificateType               :: ExtensionID -- RFC7250
pattern $mEID_ServerCertificateType :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_ServerCertificateType :: ExtensionID
EID_ServerCertificateType                = ExtensionID 0x14
pattern EID_Padding                             :: ExtensionID -- RFC5246
pattern $mEID_Padding :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_Padding :: ExtensionID
EID_Padding                              = ExtensionID 0x15
pattern EID_EncryptThenMAC                      :: ExtensionID -- RFC7366
pattern $mEID_EncryptThenMAC :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_EncryptThenMAC :: ExtensionID
EID_EncryptThenMAC                       = ExtensionID 0x16
pattern EID_ExtendedMainSecret                  :: ExtensionID -- REF7627
pattern $mEID_ExtendedMainSecret :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_ExtendedMainSecret :: ExtensionID
EID_ExtendedMainSecret                   = ExtensionID 0x17
pattern EID_SessionTicket                       :: ExtensionID -- RFC4507
pattern $mEID_SessionTicket :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_SessionTicket :: ExtensionID
EID_SessionTicket                        = ExtensionID 0x23
pattern EID_PreSharedKey                        :: ExtensionID -- RFC8446
pattern $mEID_PreSharedKey :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_PreSharedKey :: ExtensionID
EID_PreSharedKey                         = ExtensionID 0x29
pattern EID_EarlyData                           :: ExtensionID -- RFC8446
pattern $mEID_EarlyData :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_EarlyData :: ExtensionID
EID_EarlyData                            = ExtensionID 0x2a
pattern EID_SupportedVersions                   :: ExtensionID -- RFC8446
pattern $mEID_SupportedVersions :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_SupportedVersions :: ExtensionID
EID_SupportedVersions                    = ExtensionID 0x2b
pattern EID_Cookie                              :: ExtensionID -- RFC8446
pattern $mEID_Cookie :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_Cookie :: ExtensionID
EID_Cookie                               = ExtensionID 0x2c
pattern EID_PskKeyExchangeModes                 :: ExtensionID -- RFC8446
pattern $mEID_PskKeyExchangeModes :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_PskKeyExchangeModes :: ExtensionID
EID_PskKeyExchangeModes                  = ExtensionID 0x2d
pattern EID_CertificateAuthorities              :: ExtensionID -- RFC8446
pattern $mEID_CertificateAuthorities :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_CertificateAuthorities :: ExtensionID
EID_CertificateAuthorities               = ExtensionID 0x2f
pattern EID_OidFilters                          :: ExtensionID -- RFC8446
pattern $mEID_OidFilters :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_OidFilters :: ExtensionID
EID_OidFilters                           = ExtensionID 0x30
pattern EID_PostHandshakeAuth                   :: ExtensionID -- RFC8446
pattern $mEID_PostHandshakeAuth :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_PostHandshakeAuth :: ExtensionID
EID_PostHandshakeAuth                    = ExtensionID 0x31
pattern EID_SignatureAlgorithmsCert             :: ExtensionID -- RFC8446
pattern $mEID_SignatureAlgorithmsCert :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_SignatureAlgorithmsCert :: ExtensionID
EID_SignatureAlgorithmsCert              = ExtensionID 0x32
pattern EID_KeyShare                            :: ExtensionID -- RFC8446
pattern $mEID_KeyShare :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_KeyShare :: ExtensionID
EID_KeyShare                             = ExtensionID 0x33
pattern EID_QuicTransportParameters             :: ExtensionID -- RFC9001
pattern $mEID_QuicTransportParameters :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_QuicTransportParameters :: ExtensionID
EID_QuicTransportParameters              = ExtensionID 0x39
pattern EID_SecureRenegotiation                 :: ExtensionID -- RFC5746
pattern $mEID_SecureRenegotiation :: forall {r}. ExtensionID -> ((# #) -> r) -> ((# #) -> r) -> r
$bEID_SecureRenegotiation :: ExtensionID
EID_SecureRenegotiation                  = ExtensionID 0xff01

instance Show ExtensionID where
    show :: ExtensionID -> String
show ExtensionID
EID_ServerName              = String
"ServerName"
    show ExtensionID
EID_MaxFragmentLength       = String
"MaxFragmentLength"
    show ExtensionID
EID_ClientCertificateUrl    = String
"ClientCertificateUrl"
    show ExtensionID
EID_TrustedCAKeys           = String
"TrustedCAKeys"
    show ExtensionID
EID_TruncatedHMAC           = String
"TruncatedHMAC"
    show ExtensionID
EID_StatusRequest           = String
"StatusRequest"
    show ExtensionID
EID_UserMapping             = String
"UserMapping"
    show ExtensionID
EID_ClientAuthz             = String
"ClientAuthz"
    show ExtensionID
EID_ServerAuthz             = String
"ServerAuthz"
    show ExtensionID
EID_CertType                = String
"CertType"
    show ExtensionID
EID_SupportedGroups         = String
"SupportedGroups"
    show ExtensionID
EID_EcPointFormats          = String
"EcPointFormats"
    show ExtensionID
EID_SRP                     = String
"SRP"
    show ExtensionID
EID_SignatureAlgorithms     = String
"SignatureAlgorithms"
    show ExtensionID
EID_SRTP                    = String
"SRTP"
    show ExtensionID
EID_Heartbeat               = String
"Heartbeat"
    show ExtensionID
EID_ApplicationLayerProtocolNegotiation = String
"ApplicationLayerProtocolNegotiation"
    show ExtensionID
EID_StatusRequestv2         = String
"StatusRequestv2"
    show ExtensionID
EID_SignedCertificateTimestamp = String
"SignedCertificateTimestamp"
    show ExtensionID
EID_ClientCertificateType   = String
"ClientCertificateType"
    show ExtensionID
EID_ServerCertificateType   = String
"ServerCertificateType"
    show ExtensionID
EID_Padding                 = String
"Padding"
    show ExtensionID
EID_EncryptThenMAC          = String
"EncryptThenMAC"
    show ExtensionID
EID_ExtendedMainSecret      = String
"ExtendedMainSecret"
    show ExtensionID
EID_SessionTicket           = String
"SessionTicket"
    show ExtensionID
EID_PreSharedKey            = String
"PreSharedKey"
    show ExtensionID
EID_EarlyData               = String
"EarlyData"
    show ExtensionID
EID_SupportedVersions       = String
"SupportedVersions"
    show ExtensionID
EID_Cookie                  = String
"Cookie"
    show ExtensionID
EID_PskKeyExchangeModes     = String
"PskKeyExchangeModes"
    show ExtensionID
EID_CertificateAuthorities  = String
"CertificateAuthorities"
    show ExtensionID
EID_OidFilters              = String
"OidFilters"
    show ExtensionID
EID_PostHandshakeAuth       = String
"PostHandshakeAuth"
    show ExtensionID
EID_SignatureAlgorithmsCert = String
"SignatureAlgorithmsCert"
    show ExtensionID
EID_KeyShare                = String
"KeyShare"
    show ExtensionID
EID_QuicTransportParameters = String
"QuicTransportParameters"
    show ExtensionID
EID_SecureRenegotiation     = String
"SecureRenegotiation"
    show (ExtensionID Word16
x)         = String
"ExtensionID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
x
{- FOURMOLU_ENABLE -}

----------------------------------------------------------------

-- | The raw content of a TLS extension.
data ExtensionRaw = ExtensionRaw ExtensionID ByteString
    deriving (ExtensionRaw -> ExtensionRaw -> Bool
(ExtensionRaw -> ExtensionRaw -> Bool)
-> (ExtensionRaw -> ExtensionRaw -> Bool) -> Eq ExtensionRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtensionRaw -> ExtensionRaw -> Bool
== :: ExtensionRaw -> ExtensionRaw -> Bool
$c/= :: ExtensionRaw -> ExtensionRaw -> Bool
/= :: ExtensionRaw -> ExtensionRaw -> Bool
Eq)

instance Show ExtensionRaw where
    show :: ExtensionRaw -> String
show (ExtensionRaw ExtensionID
eid ByteString
bs) = String
"ExtensionRaw " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtensionID -> String
forall a. Show a => a -> String
show ExtensionID
eid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
showBytesHex ByteString
bs

----------------------------------------------------------------

newtype AlertLevel = AlertLevel {AlertLevel -> Word8
fromAlertLevel :: Word8} deriving (AlertLevel -> AlertLevel -> Bool
(AlertLevel -> AlertLevel -> Bool)
-> (AlertLevel -> AlertLevel -> Bool) -> Eq AlertLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlertLevel -> AlertLevel -> Bool
== :: AlertLevel -> AlertLevel -> Bool
$c/= :: AlertLevel -> AlertLevel -> Bool
/= :: AlertLevel -> AlertLevel -> Bool
Eq)

{- FOURMOLU_DISABLE -}
pattern AlertLevel_Warning :: AlertLevel
pattern $mAlertLevel_Warning :: forall {r}. AlertLevel -> ((# #) -> r) -> ((# #) -> r) -> r
$bAlertLevel_Warning :: AlertLevel
AlertLevel_Warning  = AlertLevel 1
pattern AlertLevel_Fatal   :: AlertLevel
pattern $mAlertLevel_Fatal :: forall {r}. AlertLevel -> ((# #) -> r) -> ((# #) -> r) -> r
$bAlertLevel_Fatal :: AlertLevel
AlertLevel_Fatal    = AlertLevel 2

instance Show AlertLevel where
    show :: AlertLevel -> String
show AlertLevel
AlertLevel_Warning = String
"AlertLevel_Warning"
    show AlertLevel
AlertLevel_Fatal   = String
"AlertLevel_Fatal"
    show (AlertLevel Word8
x)     = String
"AlertLevel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}

----------------------------------------------------------------

newtype AlertDescription = AlertDescription {AlertDescription -> Word8
fromAlertDescription :: Word8}
    deriving (AlertDescription -> AlertDescription -> Bool
(AlertDescription -> AlertDescription -> Bool)
-> (AlertDescription -> AlertDescription -> Bool)
-> Eq AlertDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlertDescription -> AlertDescription -> Bool
== :: AlertDescription -> AlertDescription -> Bool
$c/= :: AlertDescription -> AlertDescription -> Bool
/= :: AlertDescription -> AlertDescription -> Bool
Eq)

{- FOURMOLU_DISABLE -}
pattern CloseNotify                  :: AlertDescription
pattern $mCloseNotify :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCloseNotify :: AlertDescription
CloseNotify                   = AlertDescription 0
pattern UnexpectedMessage            :: AlertDescription
pattern $mUnexpectedMessage :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnexpectedMessage :: AlertDescription
UnexpectedMessage             = AlertDescription 10
pattern BadRecordMac                 :: AlertDescription
pattern $mBadRecordMac :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bBadRecordMac :: AlertDescription
BadRecordMac                  = AlertDescription 20
pattern DecryptionFailed             :: AlertDescription
pattern $mDecryptionFailed :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bDecryptionFailed :: AlertDescription
DecryptionFailed              = AlertDescription 21
pattern RecordOverflow               :: AlertDescription
pattern $mRecordOverflow :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bRecordOverflow :: AlertDescription
RecordOverflow                = AlertDescription 22
pattern DecompressionFailure         :: AlertDescription
pattern $mDecompressionFailure :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bDecompressionFailure :: AlertDescription
DecompressionFailure          = AlertDescription 30
pattern HandshakeFailure             :: AlertDescription
pattern $mHandshakeFailure :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeFailure :: AlertDescription
HandshakeFailure              = AlertDescription 40
pattern BadCertificate               :: AlertDescription
pattern $mBadCertificate :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bBadCertificate :: AlertDescription
BadCertificate                = AlertDescription 42
pattern UnsupportedCertificate       :: AlertDescription
pattern $mUnsupportedCertificate :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnsupportedCertificate :: AlertDescription
UnsupportedCertificate        = AlertDescription 43
pattern CertificateRevoked           :: AlertDescription
pattern $mCertificateRevoked :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateRevoked :: AlertDescription
CertificateRevoked            = AlertDescription 44
pattern CertificateExpired           :: AlertDescription
pattern $mCertificateExpired :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateExpired :: AlertDescription
CertificateExpired            = AlertDescription 45
pattern CertificateUnknown           :: AlertDescription
pattern $mCertificateUnknown :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateUnknown :: AlertDescription
CertificateUnknown            = AlertDescription 46
pattern IllegalParameter             :: AlertDescription
pattern $mIllegalParameter :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bIllegalParameter :: AlertDescription
IllegalParameter              = AlertDescription 47
pattern UnknownCa                    :: AlertDescription
pattern $mUnknownCa :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnknownCa :: AlertDescription
UnknownCa                     = AlertDescription 48
pattern AccessDenied                 :: AlertDescription
pattern $mAccessDenied :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bAccessDenied :: AlertDescription
AccessDenied                  = AlertDescription 49
pattern DecodeError                  :: AlertDescription
pattern $mDecodeError :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bDecodeError :: AlertDescription
DecodeError                   = AlertDescription 50
pattern DecryptError                 :: AlertDescription
pattern $mDecryptError :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bDecryptError :: AlertDescription
DecryptError                  = AlertDescription 51
pattern ExportRestriction            :: AlertDescription
pattern $mExportRestriction :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bExportRestriction :: AlertDescription
ExportRestriction             = AlertDescription 60
pattern ProtocolVersion              :: AlertDescription
pattern $mProtocolVersion :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bProtocolVersion :: AlertDescription
ProtocolVersion               = AlertDescription 70
pattern InsufficientSecurity         :: AlertDescription
pattern $mInsufficientSecurity :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bInsufficientSecurity :: AlertDescription
InsufficientSecurity          = AlertDescription 71
pattern InternalError                :: AlertDescription
pattern $mInternalError :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bInternalError :: AlertDescription
InternalError                 = AlertDescription 80
pattern InappropriateFallback        :: AlertDescription
pattern $mInappropriateFallback :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bInappropriateFallback :: AlertDescription
InappropriateFallback         = AlertDescription 86  -- RFC7507
pattern UserCanceled                 :: AlertDescription
pattern $mUserCanceled :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUserCanceled :: AlertDescription
UserCanceled                  = AlertDescription 90
pattern NoRenegotiation              :: AlertDescription
pattern $mNoRenegotiation :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoRenegotiation :: AlertDescription
NoRenegotiation               = AlertDescription 100
pattern MissingExtension             :: AlertDescription
pattern $mMissingExtension :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bMissingExtension :: AlertDescription
MissingExtension              = AlertDescription 109
pattern UnsupportedExtension         :: AlertDescription
pattern $mUnsupportedExtension :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnsupportedExtension :: AlertDescription
UnsupportedExtension          = AlertDescription 110
pattern CertificateUnobtainable      :: AlertDescription
pattern $mCertificateUnobtainable :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateUnobtainable :: AlertDescription
CertificateUnobtainable       = AlertDescription 111
pattern UnrecognizedName             :: AlertDescription
pattern $mUnrecognizedName :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnrecognizedName :: AlertDescription
UnrecognizedName              = AlertDescription 112
pattern BadCertificateStatusResponse :: AlertDescription
pattern $mBadCertificateStatusResponse :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bBadCertificateStatusResponse :: AlertDescription
BadCertificateStatusResponse  = AlertDescription 113
pattern BadCertificateHashValue      :: AlertDescription
pattern $mBadCertificateHashValue :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bBadCertificateHashValue :: AlertDescription
BadCertificateHashValue       = AlertDescription 114
pattern UnknownPskIdentity           :: AlertDescription
pattern $mUnknownPskIdentity :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnknownPskIdentity :: AlertDescription
UnknownPskIdentity            = AlertDescription 115
pattern CertificateRequired          :: AlertDescription
pattern $mCertificateRequired :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bCertificateRequired :: AlertDescription
CertificateRequired           = AlertDescription 116
pattern GeneralError                 :: AlertDescription
pattern $mGeneralError :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bGeneralError :: AlertDescription
GeneralError                  = AlertDescription 117
pattern NoApplicationProtocol        :: AlertDescription
pattern $mNoApplicationProtocol :: forall {r}. AlertDescription -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoApplicationProtocol :: AlertDescription
NoApplicationProtocol         = AlertDescription 120 -- RFC7301

instance Show AlertDescription where
    show :: AlertDescription -> String
show AlertDescription
CloseNotify                  = String
"CloseNotify"
    show AlertDescription
UnexpectedMessage            = String
"UnexpectedMessage"
    show AlertDescription
BadRecordMac                 = String
"BadRecordMac"
    show AlertDescription
DecryptionFailed             = String
"DecryptionFailed"
    show AlertDescription
RecordOverflow               = String
"RecordOverflow"
    show AlertDescription
DecompressionFailure         = String
"DecompressionFailure"
    show AlertDescription
HandshakeFailure             = String
"HandshakeFailure"
    show AlertDescription
BadCertificate               = String
"BadCertificate"
    show AlertDescription
UnsupportedCertificate       = String
"UnsupportedCertificate"
    show AlertDescription
CertificateRevoked           = String
"CertificateRevoked"
    show AlertDescription
CertificateExpired           = String
"CertificateExpired"
    show AlertDescription
CertificateUnknown           = String
"CertificateUnknown"
    show AlertDescription
IllegalParameter             = String
"IllegalParameter"
    show AlertDescription
UnknownCa                    = String
"UnknownCa"
    show AlertDescription
AccessDenied                 = String
"AccessDenied"
    show AlertDescription
DecodeError                  = String
"DecodeError"
    show AlertDescription
DecryptError                 = String
"DecryptError"
    show AlertDescription
ExportRestriction            = String
"ExportRestriction"
    show AlertDescription
ProtocolVersion              = String
"ProtocolVersion"
    show AlertDescription
InsufficientSecurity         = String
"InsufficientSecurity"
    show AlertDescription
InternalError                = String
"InternalError"
    show AlertDescription
InappropriateFallback        = String
"InappropriateFallback"
    show AlertDescription
UserCanceled                 = String
"UserCanceled"
    show AlertDescription
NoRenegotiation              = String
"NoRenegotiation"
    show AlertDescription
MissingExtension             = String
"MissingExtension"
    show AlertDescription
UnsupportedExtension         = String
"UnsupportedExtension"
    show AlertDescription
CertificateUnobtainable      = String
"CertificateUnobtainable"
    show AlertDescription
UnrecognizedName             = String
"UnrecognizedName"
    show AlertDescription
BadCertificateStatusResponse = String
"BadCertificateStatusResponse"
    show AlertDescription
BadCertificateHashValue      = String
"BadCertificateHashValue"
    show AlertDescription
UnknownPskIdentity           = String
"UnknownPskIdentity"
    show AlertDescription
CertificateRequired          = String
"CertificateRequired"
    show AlertDescription
GeneralError                 = String
"GeneralError"
    show AlertDescription
NoApplicationProtocol        = String
"NoApplicationProtocol"
    show (AlertDescription Word8
x)         = String
"AlertDescription " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}

----------------------------------------------------------------

newtype HandshakeType = HandshakeType {HandshakeType -> Word8
fromHandshakeType :: Word8}
    deriving (HandshakeType -> HandshakeType -> Bool
(HandshakeType -> HandshakeType -> Bool)
-> (HandshakeType -> HandshakeType -> Bool) -> Eq HandshakeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HandshakeType -> HandshakeType -> Bool
== :: HandshakeType -> HandshakeType -> Bool
$c/= :: HandshakeType -> HandshakeType -> Bool
/= :: HandshakeType -> HandshakeType -> Bool
Eq)

{- FOURMOLU_DISABLE -}
pattern HandshakeType_HelloRequest        :: HandshakeType
pattern $mHandshakeType_HelloRequest :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_HelloRequest :: HandshakeType
HandshakeType_HelloRequest         = HandshakeType 0
pattern HandshakeType_ClientHello         :: HandshakeType
pattern $mHandshakeType_ClientHello :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_ClientHello :: HandshakeType
HandshakeType_ClientHello          = HandshakeType 1
pattern HandshakeType_ServerHello         :: HandshakeType
pattern $mHandshakeType_ServerHello :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_ServerHello :: HandshakeType
HandshakeType_ServerHello          = HandshakeType 2
pattern HandshakeType_NewSessionTicket    :: HandshakeType
pattern $mHandshakeType_NewSessionTicket :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_NewSessionTicket :: HandshakeType
HandshakeType_NewSessionTicket     = HandshakeType 4
pattern HandshakeType_EndOfEarlyData      :: HandshakeType
pattern $mHandshakeType_EndOfEarlyData :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_EndOfEarlyData :: HandshakeType
HandshakeType_EndOfEarlyData       = HandshakeType 5
pattern HandshakeType_EncryptedExtensions :: HandshakeType
pattern $mHandshakeType_EncryptedExtensions :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_EncryptedExtensions :: HandshakeType
HandshakeType_EncryptedExtensions  = HandshakeType 8
pattern HandshakeType_Certificate         :: HandshakeType
pattern $mHandshakeType_Certificate :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_Certificate :: HandshakeType
HandshakeType_Certificate          = HandshakeType 11
pattern HandshakeType_ServerKeyXchg       :: HandshakeType
pattern $mHandshakeType_ServerKeyXchg :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_ServerKeyXchg :: HandshakeType
HandshakeType_ServerKeyXchg        = HandshakeType 12
pattern HandshakeType_CertRequest         :: HandshakeType
pattern $mHandshakeType_CertRequest :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_CertRequest :: HandshakeType
HandshakeType_CertRequest          = HandshakeType 13
pattern HandshakeType_ServerHelloDone     :: HandshakeType
pattern $mHandshakeType_ServerHelloDone :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_ServerHelloDone :: HandshakeType
HandshakeType_ServerHelloDone      = HandshakeType 14
pattern HandshakeType_CertVerify          :: HandshakeType
pattern $mHandshakeType_CertVerify :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_CertVerify :: HandshakeType
HandshakeType_CertVerify           = HandshakeType 15
pattern HandshakeType_ClientKeyXchg       :: HandshakeType
pattern $mHandshakeType_ClientKeyXchg :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_ClientKeyXchg :: HandshakeType
HandshakeType_ClientKeyXchg        = HandshakeType 16
pattern HandshakeType_Finished            :: HandshakeType
pattern $mHandshakeType_Finished :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_Finished :: HandshakeType
HandshakeType_Finished             = HandshakeType 20
pattern HandshakeType_KeyUpdate           :: HandshakeType
pattern $mHandshakeType_KeyUpdate :: forall {r}. HandshakeType -> ((# #) -> r) -> ((# #) -> r) -> r
$bHandshakeType_KeyUpdate :: HandshakeType
HandshakeType_KeyUpdate            = HandshakeType 24

instance Show HandshakeType where
    show :: HandshakeType -> String
show HandshakeType
HandshakeType_HelloRequest     = String
"HandshakeType_HelloRequest"
    show HandshakeType
HandshakeType_ClientHello      = String
"HandshakeType_ClientHello"
    show HandshakeType
HandshakeType_ServerHello      = String
"HandshakeType_ServerHello"
    show HandshakeType
HandshakeType_Certificate      = String
"HandshakeType_Certificate"
    show HandshakeType
HandshakeType_ServerKeyXchg    = String
"HandshakeType_ServerKeyXchg"
    show HandshakeType
HandshakeType_CertRequest      = String
"HandshakeType_CertRequest"
    show HandshakeType
HandshakeType_ServerHelloDone  = String
"HandshakeType_ServerHelloDone"
    show HandshakeType
HandshakeType_CertVerify       = String
"HandshakeType_CertVerify"
    show HandshakeType
HandshakeType_ClientKeyXchg    = String
"HandshakeType_ClientKeyXchg"
    show HandshakeType
HandshakeType_Finished         = String
"HandshakeType_Finished"
    show HandshakeType
HandshakeType_NewSessionTicket = String
"HandshakeType_NewSessionTicket"
    show (HandshakeType Word8
x)              = String
"HandshakeType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}

----------------------------------------------------------------

newtype BigNum = BigNum ByteString
    deriving (Int -> BigNum -> ShowS
[BigNum] -> ShowS
BigNum -> String
(Int -> BigNum -> ShowS)
-> (BigNum -> String) -> ([BigNum] -> ShowS) -> Show BigNum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BigNum -> ShowS
showsPrec :: Int -> BigNum -> ShowS
$cshow :: BigNum -> String
show :: BigNum -> String
$cshowList :: [BigNum] -> ShowS
showList :: [BigNum] -> ShowS
Show, BigNum -> BigNum -> Bool
(BigNum -> BigNum -> Bool)
-> (BigNum -> BigNum -> Bool) -> Eq BigNum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BigNum -> BigNum -> Bool
== :: BigNum -> BigNum -> Bool
$c/= :: BigNum -> BigNum -> Bool
/= :: BigNum -> BigNum -> Bool
Eq)

bigNumToInteger :: BigNum -> Integer
bigNumToInteger :: BigNum -> Integer
bigNumToInteger (BigNum ByteString
b) = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
b

bigNumFromInteger :: Integer -> BigNum
bigNumFromInteger :: Integer -> BigNum
bigNumFromInteger Integer
i = ByteString -> BigNum
BigNum (ByteString -> BigNum) -> ByteString -> BigNum
forall a b. (a -> b) -> a -> b
$ Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
i

----------------------------------------------------------------

data ServerDHParams = ServerDHParams
    { ServerDHParams -> BigNum
serverDHParams_p :: BigNum
    , ServerDHParams -> BigNum
serverDHParams_g :: BigNum
    , ServerDHParams -> BigNum
serverDHParams_y :: BigNum
    }
    deriving (Int -> ServerDHParams -> ShowS
[ServerDHParams] -> ShowS
ServerDHParams -> String
(Int -> ServerDHParams -> ShowS)
-> (ServerDHParams -> String)
-> ([ServerDHParams] -> ShowS)
-> Show ServerDHParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerDHParams -> ShowS
showsPrec :: Int -> ServerDHParams -> ShowS
$cshow :: ServerDHParams -> String
show :: ServerDHParams -> String
$cshowList :: [ServerDHParams] -> ShowS
showList :: [ServerDHParams] -> ShowS
Show, ServerDHParams -> ServerDHParams -> Bool
(ServerDHParams -> ServerDHParams -> Bool)
-> (ServerDHParams -> ServerDHParams -> Bool) -> Eq ServerDHParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerDHParams -> ServerDHParams -> Bool
== :: ServerDHParams -> ServerDHParams -> Bool
$c/= :: ServerDHParams -> ServerDHParams -> Bool
/= :: ServerDHParams -> ServerDHParams -> Bool
Eq)

serverDHParamsFrom :: DHParams -> DHPublic -> ServerDHParams
serverDHParamsFrom :: DHParams -> DHPublic -> ServerDHParams
serverDHParamsFrom DHParams
params DHPublic
dhPub =
    BigNum -> BigNum -> BigNum -> ServerDHParams
ServerDHParams
        (Integer -> BigNum
bigNumFromInteger (Integer -> BigNum) -> Integer -> BigNum
forall a b. (a -> b) -> a -> b
$ DHParams -> Integer
dhParamsGetP DHParams
params)
        (Integer -> BigNum
bigNumFromInteger (Integer -> BigNum) -> Integer -> BigNum
forall a b. (a -> b) -> a -> b
$ DHParams -> Integer
dhParamsGetG DHParams
params)
        (Integer -> BigNum
bigNumFromInteger (Integer -> BigNum) -> Integer -> BigNum
forall a b. (a -> b) -> a -> b
$ DHPublic -> Integer
dhUnwrapPublic DHPublic
dhPub)

serverDHParamsToParams :: ServerDHParams -> DHParams
serverDHParamsToParams :: ServerDHParams -> DHParams
serverDHParamsToParams ServerDHParams
serverParams =
    Integer -> Integer -> DHParams
dhParams
        (BigNum -> Integer
bigNumToInteger (BigNum -> Integer) -> BigNum -> Integer
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> BigNum
serverDHParams_p ServerDHParams
serverParams)
        (BigNum -> Integer
bigNumToInteger (BigNum -> Integer) -> BigNum -> Integer
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> BigNum
serverDHParams_g ServerDHParams
serverParams)

serverDHParamsToPublic :: ServerDHParams -> DHPublic
serverDHParamsToPublic :: ServerDHParams -> DHPublic
serverDHParamsToPublic ServerDHParams
serverParams =
    Integer -> DHPublic
dhPublic (BigNum -> Integer
bigNumToInteger (BigNum -> Integer) -> BigNum -> Integer
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> BigNum
serverDHParams_y ServerDHParams
serverParams)

----------------------------------------------------------------

data ServerECDHParams = ServerECDHParams Group GroupPublic
    deriving (Int -> ServerECDHParams -> ShowS
[ServerECDHParams] -> ShowS
ServerECDHParams -> String
(Int -> ServerECDHParams -> ShowS)
-> (ServerECDHParams -> String)
-> ([ServerECDHParams] -> ShowS)
-> Show ServerECDHParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerECDHParams -> ShowS
showsPrec :: Int -> ServerECDHParams -> ShowS
$cshow :: ServerECDHParams -> String
show :: ServerECDHParams -> String
$cshowList :: [ServerECDHParams] -> ShowS
showList :: [ServerECDHParams] -> ShowS
Show, ServerECDHParams -> ServerECDHParams -> Bool
(ServerECDHParams -> ServerECDHParams -> Bool)
-> (ServerECDHParams -> ServerECDHParams -> Bool)
-> Eq ServerECDHParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerECDHParams -> ServerECDHParams -> Bool
== :: ServerECDHParams -> ServerECDHParams -> Bool
$c/= :: ServerECDHParams -> ServerECDHParams -> Bool
/= :: ServerECDHParams -> ServerECDHParams -> Bool
Eq)

----------------------------------------------------------------

data ServerRSAParams = ServerRSAParams
    { ServerRSAParams -> Integer
rsa_modulus :: Integer
    , ServerRSAParams -> Integer
rsa_exponent :: Integer
    }
    deriving (Int -> ServerRSAParams -> ShowS
[ServerRSAParams] -> ShowS
ServerRSAParams -> String
(Int -> ServerRSAParams -> ShowS)
-> (ServerRSAParams -> String)
-> ([ServerRSAParams] -> ShowS)
-> Show ServerRSAParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerRSAParams -> ShowS
showsPrec :: Int -> ServerRSAParams -> ShowS
$cshow :: ServerRSAParams -> String
show :: ServerRSAParams -> String
$cshowList :: [ServerRSAParams] -> ShowS
showList :: [ServerRSAParams] -> ShowS
Show, ServerRSAParams -> ServerRSAParams -> Bool
(ServerRSAParams -> ServerRSAParams -> Bool)
-> (ServerRSAParams -> ServerRSAParams -> Bool)
-> Eq ServerRSAParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerRSAParams -> ServerRSAParams -> Bool
== :: ServerRSAParams -> ServerRSAParams -> Bool
$c/= :: ServerRSAParams -> ServerRSAParams -> Bool
/= :: ServerRSAParams -> ServerRSAParams -> Bool
Eq)

----------------------------------------------------------------

data ServerDSAParams = ServerDSAParams deriving (Int -> ServerDSAParams -> ShowS
[ServerDSAParams] -> ShowS
ServerDSAParams -> String
(Int -> ServerDSAParams -> ShowS)
-> (ServerDSAParams -> String)
-> ([ServerDSAParams] -> ShowS)
-> Show ServerDSAParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerDSAParams -> ShowS
showsPrec :: Int -> ServerDSAParams -> ShowS
$cshow :: ServerDSAParams -> String
show :: ServerDSAParams -> String
$cshowList :: [ServerDSAParams] -> ShowS
showList :: [ServerDSAParams] -> ShowS
Show, ServerDSAParams -> ServerDSAParams -> Bool
(ServerDSAParams -> ServerDSAParams -> Bool)
-> (ServerDSAParams -> ServerDSAParams -> Bool)
-> Eq ServerDSAParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerDSAParams -> ServerDSAParams -> Bool
== :: ServerDSAParams -> ServerDSAParams -> Bool
$c/= :: ServerDSAParams -> ServerDSAParams -> Bool
/= :: ServerDSAParams -> ServerDSAParams -> Bool
Eq)

----------------------------------------------------------------

data ServerKeyXchgAlgorithmData
    = SKX_DH_Anon ServerDHParams
    | SKX_DHE_DSA ServerDHParams DigitallySigned
    | SKX_DHE_RSA ServerDHParams DigitallySigned
    | SKX_ECDHE_RSA ServerECDHParams DigitallySigned
    | SKX_ECDHE_ECDSA ServerECDHParams DigitallySigned
    | SKX_RSA (Maybe ServerRSAParams)
    | SKX_DH_DSA (Maybe ServerDSAParams)
    | 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 (Int -> ServerKeyXchgAlgorithmData -> ShowS
[ServerKeyXchgAlgorithmData] -> ShowS
ServerKeyXchgAlgorithmData -> String
(Int -> ServerKeyXchgAlgorithmData -> ShowS)
-> (ServerKeyXchgAlgorithmData -> String)
-> ([ServerKeyXchgAlgorithmData] -> ShowS)
-> Show ServerKeyXchgAlgorithmData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerKeyXchgAlgorithmData -> ShowS
showsPrec :: Int -> ServerKeyXchgAlgorithmData -> ShowS
$cshow :: ServerKeyXchgAlgorithmData -> String
show :: ServerKeyXchgAlgorithmData -> String
$cshowList :: [ServerKeyXchgAlgorithmData] -> ShowS
showList :: [ServerKeyXchgAlgorithmData] -> ShowS
Show, ServerKeyXchgAlgorithmData -> ServerKeyXchgAlgorithmData -> Bool
(ServerKeyXchgAlgorithmData -> ServerKeyXchgAlgorithmData -> Bool)
-> (ServerKeyXchgAlgorithmData
    -> ServerKeyXchgAlgorithmData -> Bool)
-> Eq ServerKeyXchgAlgorithmData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerKeyXchgAlgorithmData -> ServerKeyXchgAlgorithmData -> Bool
== :: ServerKeyXchgAlgorithmData -> ServerKeyXchgAlgorithmData -> Bool
$c/= :: ServerKeyXchgAlgorithmData -> ServerKeyXchgAlgorithmData -> Bool
/= :: ServerKeyXchgAlgorithmData -> ServerKeyXchgAlgorithmData -> Bool
Eq)

----------------------------------------------------------------

data ClientKeyXchgAlgorithmData
    = CKX_RSA ByteString
    | CKX_DH DHPublic
    | CKX_ECDH ByteString
    deriving (Int -> ClientKeyXchgAlgorithmData -> ShowS
[ClientKeyXchgAlgorithmData] -> ShowS
ClientKeyXchgAlgorithmData -> String
(Int -> ClientKeyXchgAlgorithmData -> ShowS)
-> (ClientKeyXchgAlgorithmData -> String)
-> ([ClientKeyXchgAlgorithmData] -> ShowS)
-> Show ClientKeyXchgAlgorithmData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientKeyXchgAlgorithmData -> ShowS
showsPrec :: Int -> ClientKeyXchgAlgorithmData -> ShowS
$cshow :: ClientKeyXchgAlgorithmData -> String
show :: ClientKeyXchgAlgorithmData -> String
$cshowList :: [ClientKeyXchgAlgorithmData] -> ShowS
showList :: [ClientKeyXchgAlgorithmData] -> ShowS
Show, ClientKeyXchgAlgorithmData -> ClientKeyXchgAlgorithmData -> Bool
(ClientKeyXchgAlgorithmData -> ClientKeyXchgAlgorithmData -> Bool)
-> (ClientKeyXchgAlgorithmData
    -> ClientKeyXchgAlgorithmData -> Bool)
-> Eq ClientKeyXchgAlgorithmData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientKeyXchgAlgorithmData -> ClientKeyXchgAlgorithmData -> Bool
== :: ClientKeyXchgAlgorithmData -> ClientKeyXchgAlgorithmData -> Bool
$c/= :: ClientKeyXchgAlgorithmData -> ClientKeyXchgAlgorithmData -> Bool
/= :: ClientKeyXchgAlgorithmData -> ClientKeyXchgAlgorithmData -> Bool
Eq)

----------------------------------------------------------------

data CH = CH
    { CH -> Session
chSession :: Session
    , CH -> [Word16]
chCiphers :: [CipherID]
    , CH -> [ExtensionRaw]
chExtensions :: [ExtensionRaw]
    }
    deriving (Int -> CH -> ShowS
[CH] -> ShowS
CH -> String
(Int -> CH -> ShowS)
-> (CH -> String) -> ([CH] -> ShowS) -> Show CH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CH -> ShowS
showsPrec :: Int -> CH -> ShowS
$cshow :: CH -> String
show :: CH -> String
$cshowList :: [CH] -> ShowS
showList :: [CH] -> ShowS
Show, CH -> CH -> Bool
(CH -> CH -> Bool) -> (CH -> CH -> Bool) -> Eq CH
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CH -> CH -> Bool
== :: CH -> CH -> Bool
$c/= :: CH -> CH -> Bool
/= :: CH -> CH -> Bool
Eq)

data Handshake
    = ClientHello
        Version
        ClientRandom
        [CompressionID]
        CH
    | ServerHello
        Version
        ServerRandom
        Session
        CipherID
        CompressionID
        [ExtensionRaw]
    | Certificate CertificateChain
    | HelloRequest
    | ServerHelloDone
    | ClientKeyXchg ClientKeyXchgAlgorithmData
    | ServerKeyXchg ServerKeyXchgAlgorithmData
    | CertRequest
        [CertificateType]
        [HashAndSignatureAlgorithm]
        [DistinguishedName]
    | CertVerify DigitallySigned
    | Finished VerifyData
    | NewSessionTicket Second Ticket
    deriving (Int -> Handshake -> ShowS
[Handshake] -> ShowS
Handshake -> String
(Int -> Handshake -> ShowS)
-> (Handshake -> String)
-> ([Handshake] -> ShowS)
-> Show Handshake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Handshake -> ShowS
showsPrec :: Int -> Handshake -> ShowS
$cshow :: Handshake -> String
show :: Handshake -> String
$cshowList :: [Handshake] -> ShowS
showList :: [Handshake] -> ShowS
Show, Handshake -> Handshake -> Bool
(Handshake -> Handshake -> Bool)
-> (Handshake -> Handshake -> Bool) -> Eq Handshake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Handshake -> Handshake -> Bool
== :: Handshake -> Handshake -> Bool
$c/= :: Handshake -> Handshake -> Bool
/= :: Handshake -> Handshake -> Bool
Eq)

{- FOURMOLU_DISABLE -}
packetType :: Packet -> ProtocolType
packetType :: Packet -> ProtocolType
packetType (Handshake [Handshake]
_)    = ProtocolType
ProtocolType_Handshake
packetType (Alert [(AlertLevel, AlertDescription)]
_)        = ProtocolType
ProtocolType_Alert
packetType Packet
ChangeCipherSpec = ProtocolType
ProtocolType_ChangeCipherSpec
packetType (AppData ByteString
_)      = ProtocolType
ProtocolType_AppData

typeOfHandshake :: Handshake -> HandshakeType
typeOfHandshake :: Handshake -> HandshakeType
typeOfHandshake ClientHello{}      = HandshakeType
HandshakeType_ClientHello
typeOfHandshake ServerHello{}      = HandshakeType
HandshakeType_ServerHello
typeOfHandshake Certificate{}      = HandshakeType
HandshakeType_Certificate
typeOfHandshake Handshake
HelloRequest       = HandshakeType
HandshakeType_HelloRequest
typeOfHandshake Handshake
ServerHelloDone    = HandshakeType
HandshakeType_ServerHelloDone
typeOfHandshake ClientKeyXchg{}    = HandshakeType
HandshakeType_ClientKeyXchg
typeOfHandshake ServerKeyXchg{}    = HandshakeType
HandshakeType_ServerKeyXchg
typeOfHandshake CertRequest{}      = HandshakeType
HandshakeType_CertRequest
typeOfHandshake CertVerify{}       = HandshakeType
HandshakeType_CertVerify
typeOfHandshake Finished{}         = HandshakeType
HandshakeType_Finished
typeOfHandshake NewSessionTicket{} = HandshakeType
HandshakeType_NewSessionTicket
{- FOURMOLU_ENABLE -}