{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

-- | Basic extensions are defined in RFC 6066
module Network.TLS.Extension (
    -- * 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,
    supportedExtensions,

    -- * Extension raw
    ExtensionRaw (..),
    toExtensionRaw,
    extensionLookup,
    lookupAndDecode,
    lookupAndDecodeAndDo,

    -- * Class
    Extension (..),

    -- * Extensions
    ServerNameType (..),
    ServerName (..),
    MaxFragmentLength (..),
    MaxFragmentEnum (..),
    SecureRenegotiation (..),
    ApplicationLayerProtocolNegotiation (..),
    ExtendedMainSecret (..),
    SupportedGroups (..),
    Group (..),
    EcPointFormatsSupported (..),
    EcPointFormat (
        EcPointFormat,
        EcPointFormat_Uncompressed,
        EcPointFormat_AnsiX962_compressed_prime,
        EcPointFormat_AnsiX962_compressed_char2
    ),
    SessionTicket (..),
    HeartBeat (..),
    HeartBeatMode (
        HeartBeatMode,
        HeartBeat_PeerAllowedToSend,
        HeartBeat_PeerNotAllowedToSend
    ),
    SignatureAlgorithms (..),
    SignatureAlgorithmsCert (..),
    SupportedVersions (..),
    KeyShare (..),
    KeyShareEntry (..),
    MessageType (..),
    PostHandshakeAuth (..),
    PskKexMode (PskKexMode, PSK_KE, PSK_DHE_KE),
    PskKeyExchangeModes (..),
    PskIdentity (..),
    PreSharedKey (..),
    EarlyDataIndication (..),
    Cookie (..),
    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.Error
import Network.TLS.HashAndSignature
import Network.TLS.Imports
import Network.TLS.Packet (
    getBinaryVersion,
    getDNames,
    getSignatureHashAlgorithm,
    putBinaryVersion,
    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 {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 -}

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

definedExtensions :: [ExtensionID]
definedExtensions :: [ExtensionID]
definedExtensions =
    [ ExtensionID
EID_ServerName
    , ExtensionID
EID_MaxFragmentLength
    , ExtensionID
EID_ClientCertificateUrl
    , ExtensionID
EID_TrustedCAKeys
    , ExtensionID
EID_TruncatedHMAC
    , ExtensionID
EID_StatusRequest
    , ExtensionID
EID_UserMapping
    , ExtensionID
EID_ClientAuthz
    , ExtensionID
EID_ServerAuthz
    , ExtensionID
EID_CertType
    , ExtensionID
EID_SupportedGroups
    , ExtensionID
EID_EcPointFormats
    , ExtensionID
EID_SRP
    , ExtensionID
EID_SignatureAlgorithms
    , ExtensionID
EID_SRTP
    , ExtensionID
EID_Heartbeat
    , ExtensionID
EID_ApplicationLayerProtocolNegotiation
    , ExtensionID
EID_StatusRequestv2
    , ExtensionID
EID_SignedCertificateTimestamp
    , ExtensionID
EID_ClientCertificateType
    , ExtensionID
EID_ServerCertificateType
    , ExtensionID
EID_Padding
    , ExtensionID
EID_EncryptThenMAC
    , ExtensionID
EID_ExtendedMainSecret
    , ExtensionID
EID_SessionTicket
    , ExtensionID
EID_PreSharedKey
    , ExtensionID
EID_EarlyData
    , ExtensionID
EID_SupportedVersions
    , ExtensionID
EID_Cookie
    , ExtensionID
EID_PskKeyExchangeModes
    , ExtensionID
EID_CertificateAuthorities
    , ExtensionID
EID_OidFilters
    , ExtensionID
EID_PostHandshakeAuth
    , ExtensionID
EID_SignatureAlgorithmsCert
    , ExtensionID
EID_KeyShare
    , ExtensionID
EID_QuicTransportParameters
    , ExtensionID
EID_SecureRenegotiation
    ]

-- | all supported extensions by the implementation
{- FOURMOLU_DISABLE -}
supportedExtensions :: [ExtensionID]
supportedExtensions :: [ExtensionID]
supportedExtensions =
    [ ExtensionID
EID_ServerName                          -- 0x00
    , ExtensionID
EID_MaxFragmentLength                   -- 0x01
    , ExtensionID
EID_SupportedGroups                     -- 0x0a
    , ExtensionID
EID_EcPointFormats                      -- 0x0b
    , ExtensionID
EID_SignatureAlgorithms                 -- 0x0d
    , ExtensionID
EID_Heartbeat                           -- 0x0f
    , ExtensionID
EID_ApplicationLayerProtocolNegotiation -- 0x10
    , ExtensionID
EID_ExtendedMainSecret                  -- 0x17
    , ExtensionID
EID_SessionTicket                       -- 0x23
    , ExtensionID
EID_PreSharedKey                        -- 0x29
    , ExtensionID
EID_EarlyData                           -- 0x2a
    , ExtensionID
EID_SupportedVersions                   -- 0x2b
    , ExtensionID
EID_Cookie                              -- 0x2c
    , ExtensionID
EID_PskKeyExchangeModes                 -- 0x2d
    , ExtensionID
EID_CertificateAuthorities              -- 0x2f
    , ExtensionID
EID_PostHandshakeAuth                   -- 0x31
    , ExtensionID
EID_SignatureAlgorithmsCert             -- 0x32
    , ExtensionID
EID_KeyShare                            -- 0x33
    , ExtensionID
EID_QuicTransportParameters             -- 0x39
    , ExtensionID
EID_SecureRenegotiation                 -- 0xff01
    ]
{- 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 eid :: ExtensionID
eid@ExtensionID
EID_ServerName ByteString
bs) = ExtensionID
-> ByteString -> (ByteString -> Maybe ServerName) -> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe ServerName
decodeServerName
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_MaxFragmentLength ByteString
bs) = ExtensionID
-> ByteString -> (ByteString -> Maybe MaxFragmentLength) -> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe MaxFragmentLength
decodeMaxFragmentLength
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_SupportedGroups ByteString
bs) = ExtensionID
-> ByteString -> (ByteString -> Maybe SupportedGroups) -> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe SupportedGroups
decodeSupportedGroups
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_EcPointFormats ByteString
bs) = ExtensionID
-> ByteString
-> (ByteString -> Maybe EcPointFormatsSupported)
-> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe EcPointFormatsSupported
decodeEcPointFormatsSupported
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_SignatureAlgorithms ByteString
bs) = ExtensionID
-> ByteString
-> (ByteString -> Maybe SignatureAlgorithms)
-> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe SignatureAlgorithms
decodeSignatureAlgorithms
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_Heartbeat ByteString
bs) = ExtensionID
-> ByteString -> (ByteString -> Maybe HeartBeat) -> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe HeartBeat
decodeHeartBeat
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_ApplicationLayerProtocolNegotiation ByteString
bs) = ExtensionID
-> ByteString
-> (ByteString -> Maybe ApplicationLayerProtocolNegotiation)
-> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe ApplicationLayerProtocolNegotiation
decodeApplicationLayerProtocolNegotiation
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_ExtendedMainSecret ByteString
_) = ExtensionID -> String
forall a. Show a => a -> String
show ExtensionID
eid
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_SessionTicket ByteString
bs) = ExtensionID
-> ByteString -> (ByteString -> Maybe SessionTicket) -> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe SessionTicket
decodeSessionTicket
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_PreSharedKey ByteString
bs) = 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
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_EarlyData ByteString
_) = ExtensionID -> String
forall a. Show a => a -> String
show ExtensionID
eid
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_SupportedVersions ByteString
bs) = 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
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_Cookie ByteString
bs) = 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
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_PskKeyExchangeModes ByteString
bs) = ExtensionID
-> ByteString
-> (ByteString -> Maybe PskKeyExchangeModes)
-> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe PskKeyExchangeModes
decodePskKeyExchangeModes
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_CertificateAuthorities ByteString
bs) = ExtensionID
-> ByteString
-> (ByteString -> Maybe CertificateAuthorities)
-> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe CertificateAuthorities
decodeCertificateAuthorities
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_PostHandshakeAuth ByteString
_) = ExtensionID -> String
forall a. Show a => a -> String
show ExtensionID
eid
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_SignatureAlgorithmsCert ByteString
bs) = ExtensionID
-> ByteString
-> (ByteString -> Maybe SignatureAlgorithmsCert)
-> String
forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe SignatureAlgorithmsCert
decodeSignatureAlgorithmsCert
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_KeyShare ByteString
bs) = 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
    show (ExtensionRaw eid :: ExtensionID
eid@ExtensionID
EID_SecureRenegotiation ByteString
bs) = 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
    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

showExtensionRaw
    :: Show a => ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw :: forall a.
Show a =>
ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
showExtensionRaw ExtensionID
eid ByteString
bs ByteString -> Maybe a
decode = case ByteString -> Maybe a
decode ByteString
bs of
    Maybe a
Nothing -> ExtensionID -> String
forall a. Show a => a -> String
show ExtensionID
eid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" broken"
    Just a
x -> a -> String
forall a. Show a => a -> String
show a
x

toExtensionRaw :: Extension e => e -> ExtensionRaw
toExtensionRaw :: forall e. Extension e => e -> ExtensionRaw
toExtensionRaw e
ext = ExtensionID -> ByteString -> ExtensionRaw
ExtensionRaw (e -> ExtensionID
forall a. Extension a => a -> ExtensionID
extensionID e
ext) (e -> ByteString
forall a. Extension a => a -> ByteString
extensionEncode e
ext)

extensionLookup :: ExtensionID -> [ExtensionRaw] -> Maybe ByteString
extensionLookup :: ExtensionID -> [ExtensionRaw] -> Maybe ByteString
extensionLookup ExtensionID
toFind [ExtensionRaw]
exts = ExtensionRaw -> ByteString
extract (ExtensionRaw -> ByteString)
-> Maybe ExtensionRaw -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExtensionRaw -> Bool) -> [ExtensionRaw] -> Maybe ExtensionRaw
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ExtensionRaw -> Bool
idEq [ExtensionRaw]
exts
  where
    extract :: ExtensionRaw -> ByteString
extract (ExtensionRaw ExtensionID
_ ByteString
content) = ByteString
content
    idEq :: ExtensionRaw -> Bool
idEq (ExtensionRaw ExtensionID
eid ByteString
_) = ExtensionID
eid ExtensionID -> ExtensionID -> Bool
forall a. Eq a => a -> a -> Bool
== ExtensionID
toFind

lookupAndDecode
    :: Extension e
    => ExtensionID
    -> MessageType
    -> [ExtensionRaw]
    -> a
    -> (e -> a)
    -> a
lookupAndDecode :: forall e a.
Extension e =>
ExtensionID -> MessageType -> [ExtensionRaw] -> a -> (e -> a) -> a
lookupAndDecode ExtensionID
eid MessageType
msgtyp [ExtensionRaw]
exts a
defval e -> a
conv = case ExtensionID -> [ExtensionRaw] -> Maybe ByteString
extensionLookup ExtensionID
eid [ExtensionRaw]
exts of
    Maybe ByteString
Nothing -> a
defval
    Just ByteString
bs -> case MessageType -> ByteString -> Maybe e
forall a. Extension a => MessageType -> ByteString -> Maybe a
extensionDecode MessageType
msgtyp ByteString
bs of
        Maybe e
Nothing ->
            TLSException -> a
forall a e. Exception e => e -> a
E.throw (TLSException -> a) -> TLSException -> a
forall a b. (a -> b) -> a -> b
$
                TLSError -> TLSException
Uncontextualized (TLSError -> TLSException) -> TLSError -> TLSException
forall a b. (a -> b) -> a -> b
$
                    String -> AlertDescription -> TLSError
Error_Protocol (String
"Illegal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtensionID -> String
forall a. Show a => a -> String
show ExtensionID
eid) AlertDescription
DecodeError
        Just e
val -> e -> a
conv e
val

lookupAndDecodeAndDo
    :: Extension a
    => ExtensionID
    -> MessageType
    -> [ExtensionRaw]
    -> IO b
    -> (a -> IO b)
    -> IO b
lookupAndDecodeAndDo :: forall a b.
Extension a =>
ExtensionID
-> MessageType -> [ExtensionRaw] -> IO b -> (a -> IO b) -> IO b
lookupAndDecodeAndDo ExtensionID
eid MessageType
msgtyp [ExtensionRaw]
exts IO b
defAction a -> IO b
action = case ExtensionID -> [ExtensionRaw] -> Maybe ByteString
extensionLookup ExtensionID
eid [ExtensionRaw]
exts of
    Maybe ByteString
Nothing -> IO b
defAction
    Just ByteString
bs -> case MessageType -> ByteString -> Maybe a
forall a. Extension a => MessageType -> ByteString -> Maybe a
extensionDecode MessageType
msgtyp ByteString
bs of
        Maybe a
Nothing ->
            TLSException -> IO b
forall e a. Exception e => e -> IO a
E.throwIO (TLSException -> IO b) -> TLSException -> IO b
forall a b. (a -> b) -> a -> b
$
                TLSError -> TLSException
Uncontextualized (TLSError -> TLSException) -> TLSError -> TLSException
forall a b. (a -> b) -> a -> b
$
                    String -> AlertDescription -> TLSError
Error_Protocol (String
"Illegal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtensionID -> String
forall a. Show a => a -> String
show ExtensionID
eid) AlertDescription
DecodeError
        Just a
val -> a -> IO b
action a
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
    | MsgTHelloRetryRequest
    | MsgTEncryptedExtensions
    | MsgTNewSessionTicket
    | MsgTCertificateRequest
    deriving (MessageType -> MessageType -> Bool
(MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool) -> Eq MessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
/= :: MessageType -> MessageType -> Bool
Eq, Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> String
(Int -> MessageType -> ShowS)
-> (MessageType -> String)
-> ([MessageType] -> ShowS)
-> Show MessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageType -> ShowS
showsPrec :: Int -> MessageType -> ShowS
$cshow :: MessageType -> String
show :: MessageType -> String
$cshowList :: [MessageType] -> ShowS
showList :: [MessageType] -> ShowS
Show)

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

-- | Server Name extension including the name type and the associated name.
-- the associated name decoding is dependant of its name type.
-- name type = 0 : hostname
newtype ServerName = ServerName [ServerNameType] deriving (Int -> ServerName -> ShowS
[ServerName] -> ShowS
ServerName -> String
(Int -> ServerName -> ShowS)
-> (ServerName -> String)
-> ([ServerName] -> ShowS)
-> Show ServerName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerName -> ShowS
showsPrec :: Int -> ServerName -> ShowS
$cshow :: ServerName -> String
show :: ServerName -> String
$cshowList :: [ServerName] -> ShowS
showList :: [ServerName] -> ShowS
Show, ServerName -> ServerName -> Bool
(ServerName -> ServerName -> Bool)
-> (ServerName -> ServerName -> Bool) -> Eq ServerName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerName -> ServerName -> Bool
== :: ServerName -> ServerName -> Bool
$c/= :: ServerName -> ServerName -> Bool
/= :: ServerName -> ServerName -> Bool
Eq)

data ServerNameType
    = ServerNameHostName HostName
    | ServerNameOther (Word8, ByteString)
    deriving (ServerNameType -> ServerNameType -> Bool
(ServerNameType -> ServerNameType -> Bool)
-> (ServerNameType -> ServerNameType -> Bool) -> Eq ServerNameType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerNameType -> ServerNameType -> Bool
== :: ServerNameType -> ServerNameType -> Bool
$c/= :: ServerNameType -> ServerNameType -> Bool
/= :: ServerNameType -> ServerNameType -> Bool
Eq)

instance Show ServerNameType where
    show :: ServerNameType -> String
show (ServerNameHostName String
host) = String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
    show (ServerNameOther (Word8
w, ByteString
_)) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", )"

instance Extension ServerName where
    extensionID :: ServerName -> ExtensionID
extensionID ServerName
_ = ExtensionID
EID_ServerName

    -- dirty hack for servers
    extensionEncode :: ServerName -> ByteString
extensionEncode (ServerName []) = ByteString
""
    -- for clients
    extensionEncode (ServerName [ServerNameType]
l) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putOpaque16 (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (ServerNameType -> Put) -> [ServerNameType] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ServerNameType -> Put
encodeNameType [ServerNameType]
l)
      where
        encodeNameType :: ServerNameType -> Put
encodeNameType (ServerNameHostName String
hn) = Putter Word8
putWord8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putOpaque16 (String -> ByteString
BC.pack String
hn) -- FIXME: should be puny code conversion
        encodeNameType (ServerNameOther (Word8
nt, ByteString
opaque)) = Putter Word8
putWord8 Word8
nt Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putBytes ByteString
opaque
    extensionDecode :: MessageType -> ByteString -> Maybe ServerName
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe ServerName
decodeServerName
    extensionDecode MessageType
MsgTServerHello = ByteString -> Maybe ServerName
decodeServerName
    extensionDecode MessageType
MsgTEncryptedExtensions = ByteString -> Maybe ServerName
decodeServerName
    extensionDecode MessageType
_ = String -> ByteString -> Maybe ServerName
forall a. HasCallStack => String -> a
error String
"extensionDecode: ServerName"

decodeServerName :: ByteString -> Maybe ServerName
decodeServerName :: ByteString -> Maybe ServerName
decodeServerName ByteString
"" = ServerName -> Maybe ServerName
forall a. a -> Maybe a
Just (ServerName -> Maybe ServerName) -> ServerName -> Maybe ServerName
forall a b. (a -> b) -> a -> b
$ [ServerNameType] -> ServerName
ServerName [] -- dirty hack for servers
decodeServerName ByteString
bs = Get ServerName -> ByteString -> Maybe ServerName
forall a. Get a -> ByteString -> Maybe a
runGetMaybe Get ServerName
decode ByteString
bs
  where
    decode :: Get ServerName
decode = do
        Int
len <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
        [ServerNameType] -> ServerName
ServerName ([ServerNameType] -> ServerName)
-> Get [ServerNameType] -> Get ServerName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Int, ServerNameType) -> Get [ServerNameType]
forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len Get (Int, ServerNameType)
getServerName
    getServerName :: Get (Int, ServerNameType)
getServerName = do
        Word8
ty <- Get Word8
getWord8
        ByteString
snameParsed <- Get ByteString
getOpaque16
        let sname :: ByteString
sname = ByteString -> ByteString
B.copy ByteString
snameParsed
            name :: ServerNameType
name = case Word8
ty of
                Word8
0 -> String -> ServerNameType
ServerNameHostName (String -> ServerNameType) -> String -> ServerNameType
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BC.unpack ByteString
sname -- FIXME: should be puny code conversion
                Word8
_ -> (Word8, ByteString) -> ServerNameType
ServerNameOther (Word8
ty, ByteString
sname)
        (Int, ServerNameType) -> Get (Int, ServerNameType)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
sname, ServerNameType
name)

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

-- | Max fragment extension with length from 512 bytes to 4096 bytes
--
-- RFC 6066 defines:
-- If a server receives a maximum fragment length negotiation request
-- for a value other than the allowed values, it MUST abort the
-- handshake with an "illegal_parameter" alert.
--
-- So, if a server receives MaxFragmentLengthOther, it must send the alert.
data MaxFragmentLength
    = MaxFragmentLength MaxFragmentEnum
    | MaxFragmentLengthOther Word8
    deriving (Int -> MaxFragmentLength -> ShowS
[MaxFragmentLength] -> ShowS
MaxFragmentLength -> String
(Int -> MaxFragmentLength -> ShowS)
-> (MaxFragmentLength -> String)
-> ([MaxFragmentLength] -> ShowS)
-> Show MaxFragmentLength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaxFragmentLength -> ShowS
showsPrec :: Int -> MaxFragmentLength -> ShowS
$cshow :: MaxFragmentLength -> String
show :: MaxFragmentLength -> String
$cshowList :: [MaxFragmentLength] -> ShowS
showList :: [MaxFragmentLength] -> ShowS
Show, MaxFragmentLength -> MaxFragmentLength -> Bool
(MaxFragmentLength -> MaxFragmentLength -> Bool)
-> (MaxFragmentLength -> MaxFragmentLength -> Bool)
-> Eq MaxFragmentLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxFragmentLength -> MaxFragmentLength -> Bool
== :: MaxFragmentLength -> MaxFragmentLength -> Bool
$c/= :: MaxFragmentLength -> MaxFragmentLength -> Bool
/= :: MaxFragmentLength -> MaxFragmentLength -> Bool
Eq)

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

instance Extension MaxFragmentLength where
    extensionID :: MaxFragmentLength -> ExtensionID
extensionID MaxFragmentLength
_ = ExtensionID
EID_MaxFragmentLength
    extensionEncode :: MaxFragmentLength -> ByteString
extensionEncode (MaxFragmentLength MaxFragmentEnum
l) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 Putter Word8 -> Putter Word8
forall a b. (a -> b) -> a -> b
$ MaxFragmentEnum -> Word8
forall {a}. Num a => MaxFragmentEnum -> a
fromMaxFragmentEnum MaxFragmentEnum
l
      where
        fromMaxFragmentEnum :: MaxFragmentEnum -> a
fromMaxFragmentEnum MaxFragmentEnum
MaxFragment512 = a
1
        fromMaxFragmentEnum MaxFragmentEnum
MaxFragment1024 = a
2
        fromMaxFragmentEnum MaxFragmentEnum
MaxFragment2048 = a
3
        fromMaxFragmentEnum MaxFragmentEnum
MaxFragment4096 = a
4
    extensionEncode (MaxFragmentLengthOther Word8
l) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 Word8
l
    extensionDecode :: MessageType -> ByteString -> Maybe MaxFragmentLength
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe MaxFragmentLength
decodeMaxFragmentLength
    extensionDecode MessageType
MsgTServerHello = ByteString -> Maybe MaxFragmentLength
decodeMaxFragmentLength
    extensionDecode MessageType
MsgTEncryptedExtensions = ByteString -> Maybe MaxFragmentLength
decodeMaxFragmentLength
    extensionDecode MessageType
_ = String -> ByteString -> Maybe MaxFragmentLength
forall a. HasCallStack => String -> a
error String
"extensionDecode: MaxFragmentLength"

decodeMaxFragmentLength :: ByteString -> Maybe MaxFragmentLength
decodeMaxFragmentLength :: ByteString -> Maybe MaxFragmentLength
decodeMaxFragmentLength = Get MaxFragmentLength -> ByteString -> Maybe MaxFragmentLength
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get MaxFragmentLength -> ByteString -> Maybe MaxFragmentLength)
-> Get MaxFragmentLength -> ByteString -> Maybe MaxFragmentLength
forall a b. (a -> b) -> a -> b
$ Word8 -> MaxFragmentLength
toMaxFragmentEnum (Word8 -> MaxFragmentLength) -> Get Word8 -> Get MaxFragmentLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  where
    toMaxFragmentEnum :: Word8 -> MaxFragmentLength
toMaxFragmentEnum Word8
1 = MaxFragmentEnum -> MaxFragmentLength
MaxFragmentLength MaxFragmentEnum
MaxFragment512
    toMaxFragmentEnum Word8
2 = MaxFragmentEnum -> MaxFragmentLength
MaxFragmentLength MaxFragmentEnum
MaxFragment1024
    toMaxFragmentEnum Word8
3 = MaxFragmentEnum -> MaxFragmentLength
MaxFragmentLength MaxFragmentEnum
MaxFragment2048
    toMaxFragmentEnum Word8
4 = MaxFragmentEnum -> MaxFragmentLength
MaxFragmentLength MaxFragmentEnum
MaxFragment4096
    toMaxFragmentEnum Word8
n = Word8 -> MaxFragmentLength
MaxFragmentLengthOther Word8
n

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

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

-- on decode, filter all unknown curves
instance Extension SupportedGroups where
    extensionID :: SupportedGroups -> ExtensionID
extensionID SupportedGroups
_ = ExtensionID
EID_SupportedGroups
    extensionEncode :: SupportedGroups -> ByteString
extensionEncode (SupportedGroups [Group]
groups) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ [Word16] -> Put
putWords16 ([Word16] -> Put) -> [Word16] -> Put
forall a b. (a -> b) -> a -> b
$ (Group -> Word16) -> [Group] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map (\(Group Word16
g) -> Word16
g) [Group]
groups
    extensionDecode :: MessageType -> ByteString -> Maybe SupportedGroups
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe SupportedGroups
decodeSupportedGroups
    extensionDecode MessageType
MsgTEncryptedExtensions = ByteString -> Maybe SupportedGroups
decodeSupportedGroups
    extensionDecode MessageType
_ = String -> ByteString -> Maybe SupportedGroups
forall a. HasCallStack => String -> a
error String
"extensionDecode: SupportedGroups"

decodeSupportedGroups :: ByteString -> Maybe SupportedGroups
decodeSupportedGroups :: ByteString -> Maybe SupportedGroups
decodeSupportedGroups =
    Get SupportedGroups -> ByteString -> Maybe SupportedGroups
forall a. Get a -> ByteString -> Maybe a
runGetMaybe ([Group] -> SupportedGroups
SupportedGroups ([Group] -> SupportedGroups)
-> ([Word16] -> [Group]) -> [Word16] -> SupportedGroups
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Group) -> [Word16] -> [Group]
forall a b. (a -> b) -> [a] -> [b]
map Word16 -> Group
Group ([Word16] -> SupportedGroups)
-> Get [Word16] -> Get SupportedGroups
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word16]
getWords16)

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

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

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

{- FOURMOLU_DISABLE -}
pattern EcPointFormat_Uncompressed              :: EcPointFormat
pattern $mEcPointFormat_Uncompressed :: forall {r}. EcPointFormat -> ((# #) -> r) -> ((# #) -> r) -> r
$bEcPointFormat_Uncompressed :: EcPointFormat
EcPointFormat_Uncompressed               = EcPointFormat 0
pattern EcPointFormat_AnsiX962_compressed_prime :: EcPointFormat
pattern $mEcPointFormat_AnsiX962_compressed_prime :: forall {r}. EcPointFormat -> ((# #) -> r) -> ((# #) -> r) -> r
$bEcPointFormat_AnsiX962_compressed_prime :: EcPointFormat
EcPointFormat_AnsiX962_compressed_prime  = EcPointFormat 1
pattern EcPointFormat_AnsiX962_compressed_char2 :: EcPointFormat
pattern $mEcPointFormat_AnsiX962_compressed_char2 :: forall {r}. EcPointFormat -> ((# #) -> r) -> ((# #) -> r) -> r
$bEcPointFormat_AnsiX962_compressed_char2 :: EcPointFormat
EcPointFormat_AnsiX962_compressed_char2  = EcPointFormat 2

instance Show EcPointFormat where
    show :: EcPointFormat -> String
show EcPointFormat
EcPointFormat_Uncompressed = String
"EcPointFormat_Uncompressed"
    show EcPointFormat
EcPointFormat_AnsiX962_compressed_prime = String
"EcPointFormat_AnsiX962_compressed_prime"
    show EcPointFormat
EcPointFormat_AnsiX962_compressed_char2 = String
"EcPointFormat_AnsiX962_compressed_char2"
    show (EcPointFormat Word8
x) = String
"EcPointFormat " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
{- FOURMOLU_ENABLE -}

-- on decode, filter all unknown formats
instance Extension EcPointFormatsSupported where
    extensionID :: EcPointFormatsSupported -> ExtensionID
extensionID EcPointFormatsSupported
_ = ExtensionID
EID_EcPointFormats
    extensionEncode :: EcPointFormatsSupported -> ByteString
extensionEncode (EcPointFormatsSupported [EcPointFormat]
formats) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> Put
putWords8 ([Word8] -> Put) -> [Word8] -> Put
forall a b. (a -> b) -> a -> b
$ (EcPointFormat -> Word8) -> [EcPointFormat] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map EcPointFormat -> Word8
fromEcPointFormat [EcPointFormat]
formats
    extensionDecode :: MessageType -> ByteString -> Maybe EcPointFormatsSupported
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe EcPointFormatsSupported
decodeEcPointFormatsSupported
    extensionDecode MessageType
MsgTServerHello = ByteString -> Maybe EcPointFormatsSupported
decodeEcPointFormatsSupported
    extensionDecode MessageType
_ = String -> ByteString -> Maybe EcPointFormatsSupported
forall a. HasCallStack => String -> a
error String
"extensionDecode: EcPointFormatsSupported"

decodeEcPointFormatsSupported :: ByteString -> Maybe EcPointFormatsSupported
decodeEcPointFormatsSupported :: ByteString -> Maybe EcPointFormatsSupported
decodeEcPointFormatsSupported =
    Get EcPointFormatsSupported
-> ByteString -> Maybe EcPointFormatsSupported
forall a. Get a -> ByteString -> Maybe a
runGetMaybe ([EcPointFormat] -> EcPointFormatsSupported
EcPointFormatsSupported ([EcPointFormat] -> EcPointFormatsSupported)
-> ([Word8] -> [EcPointFormat])
-> [Word8]
-> EcPointFormatsSupported
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> EcPointFormat) -> [Word8] -> [EcPointFormat]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> EcPointFormat
EcPointFormat ([Word8] -> EcPointFormatsSupported)
-> Get [Word8] -> Get EcPointFormatsSupported
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
getWords8)

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

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

instance Extension SignatureAlgorithms where
    extensionID :: SignatureAlgorithms -> ExtensionID
extensionID SignatureAlgorithms
_ = ExtensionID
EID_SignatureAlgorithms
    extensionEncode :: SignatureAlgorithms -> ByteString
extensionEncode (SignatureAlgorithms [HashAndSignatureAlgorithm]
algs) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
            Word16 -> Put
putWord16 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([HashAndSignatureAlgorithm] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashAndSignatureAlgorithm]
algs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2))
                Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (HashAndSignatureAlgorithm -> Put)
-> [HashAndSignatureAlgorithm] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm [HashAndSignatureAlgorithm]
algs
    extensionDecode :: MessageType -> ByteString -> Maybe SignatureAlgorithms
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe SignatureAlgorithms
decodeSignatureAlgorithms
    extensionDecode MessageType
MsgTCertificateRequest = ByteString -> Maybe SignatureAlgorithms
decodeSignatureAlgorithms
    extensionDecode MessageType
_ = String -> ByteString -> Maybe SignatureAlgorithms
forall a. HasCallStack => String -> a
error String
"extensionDecode: SignatureAlgorithms"

decodeSignatureAlgorithms :: ByteString -> Maybe SignatureAlgorithms
decodeSignatureAlgorithms :: ByteString -> Maybe SignatureAlgorithms
decodeSignatureAlgorithms = Get SignatureAlgorithms -> ByteString -> Maybe SignatureAlgorithms
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get SignatureAlgorithms
 -> ByteString -> Maybe SignatureAlgorithms)
-> Get SignatureAlgorithms
-> ByteString
-> Maybe SignatureAlgorithms
forall a b. (a -> b) -> a -> b
$ do
    Word16
len <- Get Word16
getWord16
    [HashAndSignatureAlgorithm]
sas <-
        Int
-> Get (Int, HashAndSignatureAlgorithm)
-> Get [HashAndSignatureAlgorithm]
forall a. Int -> Get (Int, a) -> Get [a]
getList (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) (Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm Get HashAndSignatureAlgorithm
-> (HashAndSignatureAlgorithm
    -> Get (Int, HashAndSignatureAlgorithm))
-> Get (Int, HashAndSignatureAlgorithm)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashAndSignatureAlgorithm
sh -> (Int, HashAndSignatureAlgorithm)
-> Get (Int, HashAndSignatureAlgorithm)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2, HashAndSignatureAlgorithm
sh))
    Int
leftoverLen <- Get Int
remaining
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
leftoverLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeSignatureAlgorithms: broken length"
    SignatureAlgorithms -> Get SignatureAlgorithms
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SignatureAlgorithms -> Get SignatureAlgorithms)
-> SignatureAlgorithms -> Get SignatureAlgorithms
forall a b. (a -> b) -> a -> b
$ [HashAndSignatureAlgorithm] -> SignatureAlgorithms
SignatureAlgorithms [HashAndSignatureAlgorithm]
sas

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

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

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

{- FOURMOLU_DISABLE -}
pattern HeartBeat_PeerAllowedToSend    :: HeartBeatMode
pattern $mHeartBeat_PeerAllowedToSend :: forall {r}. HeartBeatMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bHeartBeat_PeerAllowedToSend :: HeartBeatMode
HeartBeat_PeerAllowedToSend     = HeartBeatMode 1
pattern HeartBeat_PeerNotAllowedToSend :: HeartBeatMode
pattern $mHeartBeat_PeerNotAllowedToSend :: forall {r}. HeartBeatMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bHeartBeat_PeerNotAllowedToSend :: HeartBeatMode
HeartBeat_PeerNotAllowedToSend  = HeartBeatMode 2

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

instance Extension HeartBeat where
    extensionID :: HeartBeat -> ExtensionID
extensionID HeartBeat
_ = ExtensionID
EID_Heartbeat
    extensionEncode :: HeartBeat -> ByteString
extensionEncode (HeartBeat HeartBeatMode
mode) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 Putter Word8 -> Putter Word8
forall a b. (a -> b) -> a -> b
$ HeartBeatMode -> Word8
fromHeartBeatMode HeartBeatMode
mode
    extensionDecode :: MessageType -> ByteString -> Maybe HeartBeat
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe HeartBeat
decodeHeartBeat
    extensionDecode MessageType
MsgTServerHello = ByteString -> Maybe HeartBeat
decodeHeartBeat
    extensionDecode MessageType
_ = String -> ByteString -> Maybe HeartBeat
forall a. HasCallStack => String -> a
error String
"extensionDecode: HeartBeat"

decodeHeartBeat :: ByteString -> Maybe HeartBeat
decodeHeartBeat :: ByteString -> Maybe HeartBeat
decodeHeartBeat = Get HeartBeat -> ByteString -> Maybe HeartBeat
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get HeartBeat -> ByteString -> Maybe HeartBeat)
-> Get HeartBeat -> ByteString -> Maybe HeartBeat
forall a b. (a -> b) -> a -> b
$ HeartBeatMode -> HeartBeat
HeartBeat (HeartBeatMode -> HeartBeat)
-> (Word8 -> HeartBeatMode) -> Word8 -> HeartBeat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> HeartBeatMode
HeartBeatMode (Word8 -> HeartBeat) -> Get Word8 -> Get HeartBeat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

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

-- | Application Layer Protocol Negotiation (ALPN)
newtype ApplicationLayerProtocolNegotiation
    = ApplicationLayerProtocolNegotiation [ByteString]
    deriving (Int -> ApplicationLayerProtocolNegotiation -> ShowS
[ApplicationLayerProtocolNegotiation] -> ShowS
ApplicationLayerProtocolNegotiation -> String
(Int -> ApplicationLayerProtocolNegotiation -> ShowS)
-> (ApplicationLayerProtocolNegotiation -> String)
-> ([ApplicationLayerProtocolNegotiation] -> ShowS)
-> Show ApplicationLayerProtocolNegotiation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplicationLayerProtocolNegotiation -> ShowS
showsPrec :: Int -> ApplicationLayerProtocolNegotiation -> ShowS
$cshow :: ApplicationLayerProtocolNegotiation -> String
show :: ApplicationLayerProtocolNegotiation -> String
$cshowList :: [ApplicationLayerProtocolNegotiation] -> ShowS
showList :: [ApplicationLayerProtocolNegotiation] -> ShowS
Show, ApplicationLayerProtocolNegotiation
-> ApplicationLayerProtocolNegotiation -> Bool
(ApplicationLayerProtocolNegotiation
 -> ApplicationLayerProtocolNegotiation -> Bool)
-> (ApplicationLayerProtocolNegotiation
    -> ApplicationLayerProtocolNegotiation -> Bool)
-> Eq ApplicationLayerProtocolNegotiation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationLayerProtocolNegotiation
-> ApplicationLayerProtocolNegotiation -> Bool
== :: ApplicationLayerProtocolNegotiation
-> ApplicationLayerProtocolNegotiation -> Bool
$c/= :: ApplicationLayerProtocolNegotiation
-> ApplicationLayerProtocolNegotiation -> Bool
/= :: ApplicationLayerProtocolNegotiation
-> ApplicationLayerProtocolNegotiation -> Bool
Eq)

instance Extension ApplicationLayerProtocolNegotiation where
    extensionID :: ApplicationLayerProtocolNegotiation -> ExtensionID
extensionID ApplicationLayerProtocolNegotiation
_ = ExtensionID
EID_ApplicationLayerProtocolNegotiation
    extensionEncode :: ApplicationLayerProtocolNegotiation -> ByteString
extensionEncode (ApplicationLayerProtocolNegotiation [ByteString]
bytes) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putOpaque16 (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Put) -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> Put
putOpaque8 [ByteString]
bytes
    extensionDecode :: MessageType
-> ByteString -> Maybe ApplicationLayerProtocolNegotiation
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe ApplicationLayerProtocolNegotiation
decodeApplicationLayerProtocolNegotiation
    extensionDecode MessageType
MsgTServerHello = ByteString -> Maybe ApplicationLayerProtocolNegotiation
decodeApplicationLayerProtocolNegotiation
    extensionDecode MessageType
MsgTEncryptedExtensions = ByteString -> Maybe ApplicationLayerProtocolNegotiation
decodeApplicationLayerProtocolNegotiation
    extensionDecode MessageType
_ = String -> ByteString -> Maybe ApplicationLayerProtocolNegotiation
forall a. HasCallStack => String -> a
error String
"extensionDecode: ApplicationLayerProtocolNegotiation"

decodeApplicationLayerProtocolNegotiation
    :: ByteString -> Maybe ApplicationLayerProtocolNegotiation
decodeApplicationLayerProtocolNegotiation :: ByteString -> Maybe ApplicationLayerProtocolNegotiation
decodeApplicationLayerProtocolNegotiation = Get ApplicationLayerProtocolNegotiation
-> ByteString -> Maybe ApplicationLayerProtocolNegotiation
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get ApplicationLayerProtocolNegotiation
 -> ByteString -> Maybe ApplicationLayerProtocolNegotiation)
-> Get ApplicationLayerProtocolNegotiation
-> ByteString
-> Maybe ApplicationLayerProtocolNegotiation
forall a b. (a -> b) -> a -> b
$ do
    Word16
len <- Get Word16
getWord16
    [ByteString] -> ApplicationLayerProtocolNegotiation
ApplicationLayerProtocolNegotiation ([ByteString] -> ApplicationLayerProtocolNegotiation)
-> Get [ByteString] -> Get ApplicationLayerProtocolNegotiation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Int, ByteString) -> Get [ByteString]
forall a. Int -> Get (Int, a) -> Get [a]
getList (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) Get (Int, ByteString)
getALPN
  where
    getALPN :: Get (Int, ByteString)
getALPN = do
        ByteString
alpnParsed <- Get ByteString
getOpaque8
        let alpn :: ByteString
alpn = ByteString -> ByteString
B.copy ByteString
alpnParsed
        (Int, ByteString) -> Get (Int, ByteString)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Int
B.length ByteString
alpn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, ByteString
alpn)

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

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

instance Extension ExtendedMainSecret where
    extensionID :: ExtendedMainSecret -> ExtensionID
extensionID ExtendedMainSecret
_ = ExtensionID
EID_ExtendedMainSecret
    extensionEncode :: ExtendedMainSecret -> ByteString
extensionEncode ExtendedMainSecret
ExtendedMainSecret = ByteString
B.empty
    extensionDecode :: MessageType -> ByteString -> Maybe ExtendedMainSecret
extensionDecode MessageType
MsgTClientHello ByteString
"" = ExtendedMainSecret -> Maybe ExtendedMainSecret
forall a. a -> Maybe a
Just ExtendedMainSecret
ExtendedMainSecret
    extensionDecode MessageType
MsgTServerHello ByteString
"" = ExtendedMainSecret -> Maybe ExtendedMainSecret
forall a. a -> Maybe a
Just ExtendedMainSecret
ExtendedMainSecret
    extensionDecode MessageType
_ ByteString
_ = String -> Maybe ExtendedMainSecret
forall a. HasCallStack => String -> a
error String
"extensionDecode: ExtendedMainSecret"

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

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

-- https://datatracker.ietf.org/doc/html/rfc5077#appendix-A
instance Extension SessionTicket where
    extensionID :: SessionTicket -> ExtensionID
extensionID SessionTicket
_ = ExtensionID
EID_SessionTicket
    extensionEncode :: SessionTicket -> ByteString
extensionEncode (SessionTicket ByteString
ticket) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putBytes ByteString
ticket
    extensionDecode :: MessageType -> ByteString -> Maybe SessionTicket
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe SessionTicket
decodeSessionTicket
    extensionDecode MessageType
MsgTServerHello = ByteString -> Maybe SessionTicket
decodeSessionTicket
    extensionDecode MessageType
_ = String -> ByteString -> Maybe SessionTicket
forall a. HasCallStack => String -> a
error String
"extensionDecode: SessionTicket"

decodeSessionTicket :: ByteString -> Maybe SessionTicket
decodeSessionTicket :: ByteString -> Maybe SessionTicket
decodeSessionTicket = Get SessionTicket -> ByteString -> Maybe SessionTicket
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get SessionTicket -> ByteString -> Maybe SessionTicket)
-> Get SessionTicket -> ByteString -> Maybe SessionTicket
forall a b. (a -> b) -> a -> b
$ ByteString -> SessionTicket
SessionTicket (ByteString -> SessionTicket)
-> Get ByteString -> Get SessionTicket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
remaining Get Int -> (Int -> Get ByteString) -> Get ByteString
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes)

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

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

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

instance Extension PreSharedKey where
    extensionID :: PreSharedKey -> ExtensionID
extensionID PreSharedKey
_ = ExtensionID
EID_PreSharedKey
    extensionEncode :: PreSharedKey -> ByteString
extensionEncode (PreSharedKeyClientHello [PskIdentity]
ids [ByteString]
bds) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> Put
putOpaque16 (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut ((PskIdentity -> Put) -> [PskIdentity] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PskIdentity -> Put
putIdentity [PskIdentity]
ids)
        ByteString -> Put
putOpaque16 (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut ((ByteString -> Put) -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> Put
putBinder [ByteString]
bds)
      where
        putIdentity :: PskIdentity -> Put
putIdentity (PskIdentity ByteString
bs Word32
w) = do
            ByteString -> Put
putOpaque16 ByteString
bs
            Word32 -> Put
putWord32 Word32
w
        putBinder :: ByteString -> Put
putBinder = ByteString -> Put
putOpaque8
    extensionEncode (PreSharedKeyServerHello Int
w16) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
            Word16 -> Put
putWord16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$
                Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w16
    extensionDecode :: MessageType -> ByteString -> Maybe PreSharedKey
extensionDecode MessageType
MsgTServerHello =
        Get PreSharedKey -> ByteString -> Maybe PreSharedKey
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get PreSharedKey -> ByteString -> Maybe PreSharedKey)
-> Get PreSharedKey -> ByteString -> Maybe PreSharedKey
forall a b. (a -> b) -> a -> b
$
            Int -> PreSharedKey
PreSharedKeyServerHello (Int -> PreSharedKey) -> (Word16 -> Int) -> Word16 -> PreSharedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> PreSharedKey) -> Get Word16 -> Get PreSharedKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    extensionDecode MessageType
MsgTClientHello = Get PreSharedKey -> ByteString -> Maybe PreSharedKey
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get PreSharedKey -> ByteString -> Maybe PreSharedKey)
-> Get PreSharedKey -> ByteString -> Maybe PreSharedKey
forall a b. (a -> b) -> a -> b
$ do
        Int
len1 <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
        [PskIdentity]
identities <- Int -> Get (Int, PskIdentity) -> Get [PskIdentity]
forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len1 Get (Int, PskIdentity)
getIdentity
        Int
len2 <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
        [ByteString]
binders <- Int -> Get (Int, ByteString) -> Get [ByteString]
forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len2 Get (Int, ByteString)
getBinder
        PreSharedKey -> Get PreSharedKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (PreSharedKey -> Get PreSharedKey)
-> PreSharedKey -> Get PreSharedKey
forall a b. (a -> b) -> a -> b
$ [PskIdentity] -> [ByteString] -> PreSharedKey
PreSharedKeyClientHello [PskIdentity]
identities [ByteString]
binders
      where
        getIdentity :: Get (Int, PskIdentity)
getIdentity = do
            ByteString
identity <- Get ByteString
getOpaque16
            Word32
age <- Get Word32
getWord32
            let len :: Int
len = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
identity Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
            (Int, PskIdentity) -> Get (Int, PskIdentity)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, ByteString -> Word32 -> PskIdentity
PskIdentity ByteString
identity Word32
age)
        getBinder :: Get (Int, ByteString)
getBinder = do
            Int
l <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
            ByteString
binder <- Int -> Get ByteString
getBytes Int
l
            let len :: Int
len = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            (Int, ByteString) -> Get (Int, ByteString)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, ByteString
binder)
    extensionDecode MessageType
_ = String -> ByteString -> Maybe PreSharedKey
forall a. HasCallStack => String -> a
error String
"extensionDecode: PreShareKey"

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

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

instance Extension EarlyDataIndication where
    extensionID :: EarlyDataIndication -> ExtensionID
extensionID EarlyDataIndication
_ = ExtensionID
EID_EarlyData
    extensionEncode :: EarlyDataIndication -> ByteString
extensionEncode (EarlyDataIndication Maybe Word32
Nothing) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putBytes ByteString
B.empty
    extensionEncode (EarlyDataIndication (Just Word32
w32)) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Put
putWord32 Word32
w32
    extensionDecode :: MessageType -> ByteString -> Maybe EarlyDataIndication
extensionDecode MessageType
MsgTClientHello = Maybe EarlyDataIndication
-> ByteString -> Maybe EarlyDataIndication
forall a. a -> ByteString -> a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EarlyDataIndication
 -> ByteString -> Maybe EarlyDataIndication)
-> Maybe EarlyDataIndication
-> ByteString
-> Maybe EarlyDataIndication
forall a b. (a -> b) -> a -> b
$ EarlyDataIndication -> Maybe EarlyDataIndication
forall a. a -> Maybe a
Just (Maybe Word32 -> EarlyDataIndication
EarlyDataIndication Maybe Word32
forall a. Maybe a
Nothing)
    extensionDecode MessageType
MsgTEncryptedExtensions = Maybe EarlyDataIndication
-> ByteString -> Maybe EarlyDataIndication
forall a. a -> ByteString -> a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EarlyDataIndication
 -> ByteString -> Maybe EarlyDataIndication)
-> Maybe EarlyDataIndication
-> ByteString
-> Maybe EarlyDataIndication
forall a b. (a -> b) -> a -> b
$ EarlyDataIndication -> Maybe EarlyDataIndication
forall a. a -> Maybe a
Just (Maybe Word32 -> EarlyDataIndication
EarlyDataIndication Maybe Word32
forall a. Maybe a
Nothing)
    extensionDecode MessageType
MsgTNewSessionTicket =
        Get EarlyDataIndication -> ByteString -> Maybe EarlyDataIndication
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get EarlyDataIndication
 -> ByteString -> Maybe EarlyDataIndication)
-> Get EarlyDataIndication
-> ByteString
-> Maybe EarlyDataIndication
forall a b. (a -> b) -> a -> b
$
            Maybe Word32 -> EarlyDataIndication
EarlyDataIndication (Maybe Word32 -> EarlyDataIndication)
-> (Word32 -> Maybe Word32) -> Word32 -> EarlyDataIndication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> EarlyDataIndication)
-> Get Word32 -> Get EarlyDataIndication
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
    extensionDecode MessageType
_ = String -> ByteString -> Maybe EarlyDataIndication
forall a. HasCallStack => String -> a
error String
"extensionDecode: EarlyDataIndication"

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

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

instance Extension SupportedVersions where
    extensionID :: SupportedVersions -> ExtensionID
extensionID SupportedVersions
_ = ExtensionID
EID_SupportedVersions
    extensionEncode :: SupportedVersions -> ByteString
extensionEncode (SupportedVersionsClientHello [Version]
vers) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
        Putter Word8
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Version] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Version]
vers Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2))
        (Version -> Put) -> [Version] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Version -> Put
putBinaryVersion [Version]
vers
    extensionEncode (SupportedVersionsServerHello Version
ver) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
            Version -> Put
putBinaryVersion Version
ver
    extensionDecode :: MessageType -> ByteString -> Maybe SupportedVersions
extensionDecode MessageType
MsgTClientHello = Get SupportedVersions -> ByteString -> Maybe SupportedVersions
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get SupportedVersions -> ByteString -> Maybe SupportedVersions)
-> Get SupportedVersions -> ByteString -> Maybe SupportedVersions
forall a b. (a -> b) -> a -> b
$ do
        Int
len <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        [Version] -> SupportedVersions
SupportedVersionsClientHello ([Version] -> SupportedVersions)
-> Get [Version] -> Get SupportedVersions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Int, Version) -> Get [Version]
forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len Get (Int, Version)
getVer
      where
        getVer :: Get (Int, Version)
getVer = do
            Version
ver <- Get Version
getBinaryVersion
            (Int, Version) -> Get (Int, Version)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2, Version
ver)
    extensionDecode MessageType
MsgTServerHello =
        Get SupportedVersions -> ByteString -> Maybe SupportedVersions
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Version -> SupportedVersions
SupportedVersionsServerHello (Version -> SupportedVersions)
-> Get Version -> Get SupportedVersions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Version
getBinaryVersion)
    extensionDecode MessageType
_ = String -> ByteString -> Maybe SupportedVersions
forall a. HasCallStack => String -> a
error String
"extensionDecode: SupportedVersionsServerHello"

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

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

instance Extension Cookie where
    extensionID :: Cookie -> ExtensionID
extensionID Cookie
_ = ExtensionID
EID_Cookie
    extensionEncode :: Cookie -> ByteString
extensionEncode (Cookie ByteString
opaque) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putOpaque16 ByteString
opaque
    extensionDecode :: MessageType -> ByteString -> Maybe Cookie
extensionDecode MessageType
MsgTServerHello = Get Cookie -> ByteString -> Maybe Cookie
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (ByteString -> Cookie
Cookie (ByteString -> Cookie) -> Get ByteString -> Get Cookie
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getOpaque16)
    extensionDecode MessageType
_ = String -> ByteString -> Maybe Cookie
forall a. HasCallStack => String -> a
error String
"extensionDecode: Cookie"

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

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

{- FOURMOLU_DISABLE -}
pattern PSK_KE     :: PskKexMode
pattern $mPSK_KE :: forall {r}. PskKexMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bPSK_KE :: PskKexMode
PSK_KE      = PskKexMode 0
pattern PSK_DHE_KE :: PskKexMode
pattern $mPSK_DHE_KE :: forall {r}. PskKexMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bPSK_DHE_KE :: PskKexMode
PSK_DHE_KE  = PskKexMode 1

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

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

instance Extension PskKeyExchangeModes where
    extensionID :: PskKeyExchangeModes -> ExtensionID
extensionID PskKeyExchangeModes
_ = ExtensionID
EID_PskKeyExchangeModes
    extensionEncode :: PskKeyExchangeModes -> ByteString
extensionEncode (PskKeyExchangeModes [PskKexMode]
pkms) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
            [Word8] -> Put
putWords8 ([Word8] -> Put) -> [Word8] -> Put
forall a b. (a -> b) -> a -> b
$
                (PskKexMode -> Word8) -> [PskKexMode] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map PskKexMode -> Word8
fromPskKexMode [PskKexMode]
pkms
    extensionDecode :: MessageType -> ByteString -> Maybe PskKeyExchangeModes
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe PskKeyExchangeModes
decodePskKeyExchangeModes
    extensionDecode MessageType
_ = String -> ByteString -> Maybe PskKeyExchangeModes
forall a. HasCallStack => String -> a
error String
"extensionDecode: PskKeyExchangeModes"

decodePskKeyExchangeModes :: ByteString -> Maybe PskKeyExchangeModes
decodePskKeyExchangeModes :: ByteString -> Maybe PskKeyExchangeModes
decodePskKeyExchangeModes =
    Get PskKeyExchangeModes -> ByteString -> Maybe PskKeyExchangeModes
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get PskKeyExchangeModes
 -> ByteString -> Maybe PskKeyExchangeModes)
-> Get PskKeyExchangeModes
-> ByteString
-> Maybe PskKeyExchangeModes
forall a b. (a -> b) -> a -> b
$
        [PskKexMode] -> PskKeyExchangeModes
PskKeyExchangeModes ([PskKexMode] -> PskKeyExchangeModes)
-> ([Word8] -> [PskKexMode]) -> [Word8] -> PskKeyExchangeModes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> PskKexMode) -> [Word8] -> [PskKexMode]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> PskKexMode
PskKexMode ([Word8] -> PskKeyExchangeModes)
-> Get [Word8] -> Get PskKeyExchangeModes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
getWords8

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

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

instance Extension CertificateAuthorities where
    extensionID :: CertificateAuthorities -> ExtensionID
extensionID CertificateAuthorities
_ = ExtensionID
EID_CertificateAuthorities
    extensionEncode :: CertificateAuthorities -> ByteString
extensionEncode (CertificateAuthorities [DistinguishedName]
names) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
            [DistinguishedName] -> Put
putDNames [DistinguishedName]
names
    extensionDecode :: MessageType -> ByteString -> Maybe CertificateAuthorities
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe CertificateAuthorities
decodeCertificateAuthorities
    extensionDecode MessageType
MsgTCertificateRequest = ByteString -> Maybe CertificateAuthorities
decodeCertificateAuthorities
    extensionDecode MessageType
_ = String -> ByteString -> Maybe CertificateAuthorities
forall a. HasCallStack => String -> a
error String
"extensionDecode: CertificateAuthorities"

decodeCertificateAuthorities :: ByteString -> Maybe CertificateAuthorities
decodeCertificateAuthorities :: ByteString -> Maybe CertificateAuthorities
decodeCertificateAuthorities =
    Get CertificateAuthorities
-> ByteString -> Maybe CertificateAuthorities
forall a. Get a -> ByteString -> Maybe a
runGetMaybe ([DistinguishedName] -> CertificateAuthorities
CertificateAuthorities ([DistinguishedName] -> CertificateAuthorities)
-> Get [DistinguishedName] -> Get CertificateAuthorities
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [DistinguishedName]
getDNames)

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

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

instance Extension PostHandshakeAuth where
    extensionID :: PostHandshakeAuth -> ExtensionID
extensionID PostHandshakeAuth
_ = ExtensionID
EID_PostHandshakeAuth
    extensionEncode :: PostHandshakeAuth -> ByteString
extensionEncode PostHandshakeAuth
_ = ByteString
B.empty
    extensionDecode :: MessageType -> ByteString -> Maybe PostHandshakeAuth
extensionDecode MessageType
MsgTClientHello = Get PostHandshakeAuth -> ByteString -> Maybe PostHandshakeAuth
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get PostHandshakeAuth -> ByteString -> Maybe PostHandshakeAuth)
-> Get PostHandshakeAuth -> ByteString -> Maybe PostHandshakeAuth
forall a b. (a -> b) -> a -> b
$ PostHandshakeAuth -> Get PostHandshakeAuth
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return PostHandshakeAuth
PostHandshakeAuth
    extensionDecode MessageType
_ = String -> ByteString -> Maybe PostHandshakeAuth
forall a. HasCallStack => String -> a
error String
"extensionDecode: PostHandshakeAuth"

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

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

instance Extension SignatureAlgorithmsCert where
    extensionID :: SignatureAlgorithmsCert -> ExtensionID
extensionID SignatureAlgorithmsCert
_ = ExtensionID
EID_SignatureAlgorithmsCert
    extensionEncode :: SignatureAlgorithmsCert -> ByteString
extensionEncode (SignatureAlgorithmsCert [HashAndSignatureAlgorithm]
algs) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
            Word16 -> Put
putWord16 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([HashAndSignatureAlgorithm] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashAndSignatureAlgorithm]
algs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2))
                Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (HashAndSignatureAlgorithm -> Put)
-> [HashAndSignatureAlgorithm] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm [HashAndSignatureAlgorithm]
algs
    extensionDecode :: MessageType -> ByteString -> Maybe SignatureAlgorithmsCert
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe SignatureAlgorithmsCert
decodeSignatureAlgorithmsCert
    extensionDecode MessageType
MsgTCertificateRequest = ByteString -> Maybe SignatureAlgorithmsCert
decodeSignatureAlgorithmsCert
    extensionDecode MessageType
_ = String -> ByteString -> Maybe SignatureAlgorithmsCert
forall a. HasCallStack => String -> a
error String
"extensionDecode: SignatureAlgorithmsCert"

decodeSignatureAlgorithmsCert :: ByteString -> Maybe SignatureAlgorithmsCert
decodeSignatureAlgorithmsCert :: ByteString -> Maybe SignatureAlgorithmsCert
decodeSignatureAlgorithmsCert = Get SignatureAlgorithmsCert
-> ByteString -> Maybe SignatureAlgorithmsCert
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get SignatureAlgorithmsCert
 -> ByteString -> Maybe SignatureAlgorithmsCert)
-> Get SignatureAlgorithmsCert
-> ByteString
-> Maybe SignatureAlgorithmsCert
forall a b. (a -> b) -> a -> b
$ do
    Word16
len <- Get Word16
getWord16
    [HashAndSignatureAlgorithm] -> SignatureAlgorithmsCert
SignatureAlgorithmsCert
        ([HashAndSignatureAlgorithm] -> SignatureAlgorithmsCert)
-> Get [HashAndSignatureAlgorithm] -> Get SignatureAlgorithmsCert
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Get (Int, HashAndSignatureAlgorithm)
-> Get [HashAndSignatureAlgorithm]
forall a. Int -> Get (Int, a) -> Get [a]
getList (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) (Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm Get HashAndSignatureAlgorithm
-> (HashAndSignatureAlgorithm
    -> Get (Int, HashAndSignatureAlgorithm))
-> Get (Int, HashAndSignatureAlgorithm)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashAndSignatureAlgorithm
sh -> (Int, HashAndSignatureAlgorithm)
-> Get (Int, HashAndSignatureAlgorithm)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2, HashAndSignatureAlgorithm
sh))

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

data KeyShareEntry = KeyShareEntry
    { KeyShareEntry -> Group
keyShareEntryGroup :: Group
    , KeyShareEntry -> ByteString
keyShareEntryKeyExchange :: ByteString
    }
    deriving (Int -> KeyShareEntry -> ShowS
[KeyShareEntry] -> ShowS
KeyShareEntry -> String
(Int -> KeyShareEntry -> ShowS)
-> (KeyShareEntry -> String)
-> ([KeyShareEntry] -> ShowS)
-> Show KeyShareEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyShareEntry -> ShowS
showsPrec :: Int -> KeyShareEntry -> ShowS
$cshow :: KeyShareEntry -> String
show :: KeyShareEntry -> String
$cshowList :: [KeyShareEntry] -> ShowS
showList :: [KeyShareEntry] -> ShowS
Show, KeyShareEntry -> KeyShareEntry -> Bool
(KeyShareEntry -> KeyShareEntry -> Bool)
-> (KeyShareEntry -> KeyShareEntry -> Bool) -> Eq KeyShareEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyShareEntry -> KeyShareEntry -> Bool
== :: KeyShareEntry -> KeyShareEntry -> Bool
$c/= :: KeyShareEntry -> KeyShareEntry -> Bool
/= :: KeyShareEntry -> KeyShareEntry -> Bool
Eq)

getKeyShareEntry :: Get (Int, Maybe KeyShareEntry)
getKeyShareEntry :: Get (Int, Maybe KeyShareEntry)
getKeyShareEntry = do
    Group
grp <- Word16 -> Group
Group (Word16 -> Group) -> Get Word16 -> Get Group
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    Int
l <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    ByteString
key <- Int -> Get ByteString
getBytes Int
l
    let len :: Int
len = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
    (Int, Maybe KeyShareEntry) -> Get (Int, Maybe KeyShareEntry)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, KeyShareEntry -> Maybe KeyShareEntry
forall a. a -> Maybe a
Just (KeyShareEntry -> Maybe KeyShareEntry)
-> KeyShareEntry -> Maybe KeyShareEntry
forall a b. (a -> b) -> a -> b
$ Group -> ByteString -> KeyShareEntry
KeyShareEntry Group
grp ByteString
key)

putKeyShareEntry :: KeyShareEntry -> Put
putKeyShareEntry :: KeyShareEntry -> Put
putKeyShareEntry (KeyShareEntry (Group Word16
grp) ByteString
key) = do
    Word16 -> Put
putWord16 Word16
grp
    Word16 -> Put
putWord16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
key
    ByteString -> Put
putBytes ByteString
key

data KeyShare
    = KeyShareClientHello [KeyShareEntry]
    | KeyShareServerHello KeyShareEntry
    | KeyShareHRR Group
    deriving (Int -> KeyShare -> ShowS
[KeyShare] -> ShowS
KeyShare -> String
(Int -> KeyShare -> ShowS)
-> (KeyShare -> String) -> ([KeyShare] -> ShowS) -> Show KeyShare
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyShare -> ShowS
showsPrec :: Int -> KeyShare -> ShowS
$cshow :: KeyShare -> String
show :: KeyShare -> String
$cshowList :: [KeyShare] -> ShowS
showList :: [KeyShare] -> ShowS
Show, KeyShare -> KeyShare -> Bool
(KeyShare -> KeyShare -> Bool)
-> (KeyShare -> KeyShare -> Bool) -> Eq KeyShare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyShare -> KeyShare -> Bool
== :: KeyShare -> KeyShare -> Bool
$c/= :: KeyShare -> KeyShare -> Bool
/= :: KeyShare -> KeyShare -> Bool
Eq)

instance Extension KeyShare where
    extensionID :: KeyShare -> ExtensionID
extensionID KeyShare
_ = ExtensionID
EID_KeyShare
    extensionEncode :: KeyShare -> ByteString
extensionEncode (KeyShareClientHello [KeyShareEntry]
kses) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
        let len :: Int
len = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ByteString -> Int
B.length ByteString
key Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 | KeyShareEntry Group
_ ByteString
key <- [KeyShareEntry]
kses]
        Word16 -> Put
putWord16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
        (KeyShareEntry -> Put) -> [KeyShareEntry] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ KeyShareEntry -> Put
putKeyShareEntry [KeyShareEntry]
kses
    extensionEncode (KeyShareServerHello KeyShareEntry
kse) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ KeyShareEntry -> Put
putKeyShareEntry KeyShareEntry
kse
    extensionEncode (KeyShareHRR (Group Word16
grp)) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Put
putWord16 Word16
grp
    extensionDecode :: MessageType -> ByteString -> Maybe KeyShare
extensionDecode MessageType
MsgTServerHello = Get KeyShare -> ByteString -> Maybe KeyShare
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get KeyShare -> ByteString -> Maybe KeyShare)
-> Get KeyShare -> ByteString -> Maybe KeyShare
forall a b. (a -> b) -> a -> b
$ do
        (Int
_, Maybe KeyShareEntry
ment) <- Get (Int, Maybe KeyShareEntry)
getKeyShareEntry
        case Maybe KeyShareEntry
ment of
            Maybe KeyShareEntry
Nothing -> String -> Get KeyShare
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decoding KeyShare for ServerHello"
            Just KeyShareEntry
ent -> KeyShare -> Get KeyShare
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyShare -> Get KeyShare) -> KeyShare -> Get KeyShare
forall a b. (a -> b) -> a -> b
$ KeyShareEntry -> KeyShare
KeyShareServerHello KeyShareEntry
ent
    extensionDecode MessageType
MsgTClientHello = Get KeyShare -> ByteString -> Maybe KeyShare
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get KeyShare -> ByteString -> Maybe KeyShare)
-> Get KeyShare -> ByteString -> Maybe KeyShare
forall a b. (a -> b) -> a -> b
$ do
        Int
len <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
        --      len == 0 allows for HRR
        [Maybe KeyShareEntry]
grps <- Int -> Get (Int, Maybe KeyShareEntry) -> Get [Maybe KeyShareEntry]
forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len Get (Int, Maybe KeyShareEntry)
getKeyShareEntry
        KeyShare -> Get KeyShare
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyShare -> Get KeyShare) -> KeyShare -> Get KeyShare
forall a b. (a -> b) -> a -> b
$ [KeyShareEntry] -> KeyShare
KeyShareClientHello ([KeyShareEntry] -> KeyShare) -> [KeyShareEntry] -> KeyShare
forall a b. (a -> b) -> a -> b
$ [Maybe KeyShareEntry] -> [KeyShareEntry]
forall a. [Maybe a] -> [a]
catMaybes [Maybe KeyShareEntry]
grps
    extensionDecode MessageType
MsgTHelloRetryRequest =
        Get KeyShare -> ByteString -> Maybe KeyShare
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get KeyShare -> ByteString -> Maybe KeyShare)
-> Get KeyShare -> ByteString -> Maybe KeyShare
forall a b. (a -> b) -> a -> b
$
            Group -> KeyShare
KeyShareHRR (Group -> KeyShare) -> (Word16 -> Group) -> Word16 -> KeyShare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Group
Group (Word16 -> KeyShare) -> Get Word16 -> Get KeyShare
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    extensionDecode MessageType
_ = String -> ByteString -> Maybe KeyShare
forall a. HasCallStack => String -> a
error String
"extensionDecode: KeyShare"

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

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

instance Extension SecureRenegotiation where
    extensionID :: SecureRenegotiation -> ExtensionID
extensionID SecureRenegotiation
_ = ExtensionID
EID_SecureRenegotiation
    extensionEncode :: SecureRenegotiation -> ByteString
extensionEncode (SecureRenegotiation ByteString
cvd ByteString
svd) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putOpaque8 (ByteString
cvd ByteString -> ByteString -> ByteString
`B.append` ByteString
svd)
    extensionDecode :: MessageType -> ByteString -> Maybe SecureRenegotiation
extensionDecode MessageType
MsgTClientHello = Get SecureRenegotiation -> ByteString -> Maybe SecureRenegotiation
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get SecureRenegotiation
 -> ByteString -> Maybe SecureRenegotiation)
-> Get SecureRenegotiation
-> ByteString
-> Maybe SecureRenegotiation
forall a b. (a -> b) -> a -> b
$ do
        ByteString
opaque <- Get ByteString
getOpaque8
        SecureRenegotiation -> Get SecureRenegotiation
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureRenegotiation -> Get SecureRenegotiation)
-> SecureRenegotiation -> Get SecureRenegotiation
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> SecureRenegotiation
SecureRenegotiation ByteString
opaque ByteString
""
    extensionDecode MessageType
MsgTServerHello = Get SecureRenegotiation -> ByteString -> Maybe SecureRenegotiation
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get SecureRenegotiation
 -> ByteString -> Maybe SecureRenegotiation)
-> Get SecureRenegotiation
-> ByteString
-> Maybe SecureRenegotiation
forall a b. (a -> b) -> a -> b
$ do
        ByteString
opaque <- Get ByteString
getOpaque8
        let (ByteString
cvd, ByteString
svd) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteString -> Int
B.length ByteString
opaque Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ByteString
opaque
        SecureRenegotiation -> Get SecureRenegotiation
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureRenegotiation -> Get SecureRenegotiation)
-> SecureRenegotiation -> Get SecureRenegotiation
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> SecureRenegotiation
SecureRenegotiation ByteString
cvd ByteString
svd
    extensionDecode MessageType
_ = String -> ByteString -> Maybe SecureRenegotiation
forall a. HasCallStack => String -> a
error String
"extensionDecode: SecureRenegotiation"