{-# LANGUAGE BangPatterns #-}
-- |
-- Module      : Network.TLS.Extension
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- basic extensions are defined in RFC 6066
--
module Network.TLS.Extension
    ( Extension(..)
    , supportedExtensions
    , definedExtensions
    -- all extensions ID supported
    , extensionID_ServerName
    , extensionID_MaxFragmentLength
    , extensionID_SecureRenegotiation
    , extensionID_ApplicationLayerProtocolNegotiation
    , extensionID_ExtendedMasterSecret
    , extensionID_NegotiatedGroups
    , extensionID_EcPointFormats
    , extensionID_Heartbeat
    , extensionID_SignatureAlgorithms
    , extensionID_PreSharedKey
    , extensionID_EarlyData
    , extensionID_SupportedVersions
    , extensionID_Cookie
    , extensionID_PskKeyExchangeModes
    , extensionID_CertificateAuthorities
    , extensionID_OidFilters
    , extensionID_PostHandshakeAuth
    , extensionID_SignatureAlgorithmsCert
    , extensionID_KeyShare
    , extensionID_QuicTransportParameters
    -- all implemented extensions
    , ServerNameType(..)
    , ServerName(..)
    , MaxFragmentLength(..)
    , MaxFragmentEnum(..)
    , SecureRenegotiation(..)
    , ApplicationLayerProtocolNegotiation(..)
    , ExtendedMasterSecret(..)
    , NegotiatedGroups(..)
    , Group(..)
    , EcPointFormatsSupported(..)
    , EcPointFormat(..)
    , SessionTicket(..)
    , HeartBeat(..)
    , HeartBeatMode(..)
    , SignatureAlgorithms(..)
    , SignatureAlgorithmsCert(..)
    , SupportedVersions(..)
    , KeyShare(..)
    , KeyShareEntry(..)
    , MessageType(..)
    , PostHandshakeAuth(..)
    , PskKexMode(..)
    , PskKeyExchangeModes(..)
    , PskIdentity(..)
    , PreSharedKey(..)
    , EarlyDataIndication(..)
    , Cookie(..)
    , CertificateAuthorities(..)
    ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC

import Network.TLS.Struct ( DistinguishedName
                          , ExtensionID
                          , EnumSafe8(..)
                          , EnumSafe16(..)
                          , HashAndSignatureAlgorithm )
import Network.TLS.Crypto.Types
import Network.TLS.Types (Version(..), HostName)

import Network.TLS.Wire
import Network.TLS.Imports
import Network.TLS.Packet ( putDNames
                          , getDNames
                          , putSignatureHashAlgorithm
                          , getSignatureHashAlgorithm
                          , putBinaryVersion
                          , getBinaryVersion
                          )

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

-- central list defined in <http://www.iana.org/assignments/tls-extensiontype-values/tls-extensiontype-values.txt>
extensionID_ServerName
  , extensionID_MaxFragmentLength
  , extensionID_ClientCertificateUrl
  , extensionID_TrustedCAKeys
  , extensionID_TruncatedHMAC
  , extensionID_StatusRequest
  , extensionID_UserMapping
  , extensionID_ClientAuthz
  , extensionID_ServerAuthz
  , extensionID_CertType
  , extensionID_NegotiatedGroups
  , extensionID_EcPointFormats
  , extensionID_SRP
  , extensionID_SignatureAlgorithms
  , extensionID_SRTP
  , extensionID_Heartbeat
  , extensionID_ApplicationLayerProtocolNegotiation
  , extensionID_StatusRequestv2
  , extensionID_SignedCertificateTimestamp
  , extensionID_ClientCertificateType
  , extensionID_ServerCertificateType
  , extensionID_Padding
  , extensionID_EncryptThenMAC
  , extensionID_ExtendedMasterSecret
  , extensionID_SessionTicket
  , extensionID_PreSharedKey
  , extensionID_EarlyData
  , extensionID_SupportedVersions
  , extensionID_Cookie
  , extensionID_PskKeyExchangeModes
  , extensionID_CertificateAuthorities
  , extensionID_OidFilters
  , extensionID_PostHandshakeAuth
  , extensionID_SignatureAlgorithmsCert
  , extensionID_KeyShare
  , extensionID_SecureRenegotiation
  , extensionID_QuicTransportParameters :: ExtensionID
extensionID_ServerName :: ExtensionID
extensionID_ServerName                          = ExtensionID
0x0 -- RFC6066
extensionID_MaxFragmentLength :: ExtensionID
extensionID_MaxFragmentLength                   = ExtensionID
0x1 -- RFC6066
extensionID_ClientCertificateUrl :: ExtensionID
extensionID_ClientCertificateUrl                = ExtensionID
0x2 -- RFC6066
extensionID_TrustedCAKeys :: ExtensionID
extensionID_TrustedCAKeys                       = ExtensionID
0x3 -- RFC6066
extensionID_TruncatedHMAC :: ExtensionID
extensionID_TruncatedHMAC                       = ExtensionID
0x4 -- RFC6066
extensionID_StatusRequest :: ExtensionID
extensionID_StatusRequest                       = ExtensionID
0x5 -- RFC6066
extensionID_UserMapping :: ExtensionID
extensionID_UserMapping                         = ExtensionID
0x6 -- RFC4681
extensionID_ClientAuthz :: ExtensionID
extensionID_ClientAuthz                         = ExtensionID
0x7 -- RFC5878
extensionID_ServerAuthz :: ExtensionID
extensionID_ServerAuthz                         = ExtensionID
0x8 -- RFC5878
extensionID_CertType :: ExtensionID
extensionID_CertType                            = ExtensionID
0x9 -- RFC6091
extensionID_NegotiatedGroups :: ExtensionID
extensionID_NegotiatedGroups                    = ExtensionID
0xa -- RFC4492bis and TLS 1.3
extensionID_EcPointFormats :: ExtensionID
extensionID_EcPointFormats                      = ExtensionID
0xb -- RFC4492
extensionID_SRP :: ExtensionID
extensionID_SRP                                 = ExtensionID
0xc -- RFC5054
extensionID_SignatureAlgorithms :: ExtensionID
extensionID_SignatureAlgorithms                 = ExtensionID
0xd -- RFC5246, TLS 1.3
extensionID_SRTP :: ExtensionID
extensionID_SRTP                                = ExtensionID
0xe -- RFC5764
extensionID_Heartbeat :: ExtensionID
extensionID_Heartbeat                           = ExtensionID
0xf -- RFC6520
extensionID_ApplicationLayerProtocolNegotiation :: ExtensionID
extensionID_ApplicationLayerProtocolNegotiation = ExtensionID
0x10 -- RFC7301
extensionID_StatusRequestv2 :: ExtensionID
extensionID_StatusRequestv2                     = ExtensionID
0x11 -- RFC6961
extensionID_SignedCertificateTimestamp :: ExtensionID
extensionID_SignedCertificateTimestamp          = ExtensionID
0x12 -- RFC6962
extensionID_ClientCertificateType :: ExtensionID
extensionID_ClientCertificateType               = ExtensionID
0x13 -- RFC7250
extensionID_ServerCertificateType :: ExtensionID
extensionID_ServerCertificateType               = ExtensionID
0x14 -- RFC7250
extensionID_Padding :: ExtensionID
extensionID_Padding                             = ExtensionID
0x15 -- draft-agl-tls-padding. expires 2015-03-12
extensionID_EncryptThenMAC :: ExtensionID
extensionID_EncryptThenMAC                      = ExtensionID
0x16 -- RFC7366
extensionID_ExtendedMasterSecret :: ExtensionID
extensionID_ExtendedMasterSecret                = ExtensionID
0x17 -- REF7627
extensionID_SessionTicket :: ExtensionID
extensionID_SessionTicket                       = ExtensionID
0x23 -- RFC4507
-- Reserved                                       0x28 -- TLS 1.3
extensionID_PreSharedKey :: ExtensionID
extensionID_PreSharedKey                        = ExtensionID
0x29 -- TLS 1.3
extensionID_EarlyData :: ExtensionID
extensionID_EarlyData                           = ExtensionID
0x2a -- TLS 1.3
extensionID_SupportedVersions :: ExtensionID
extensionID_SupportedVersions                   = ExtensionID
0x2b -- TLS 1.3
extensionID_Cookie :: ExtensionID
extensionID_Cookie                              = ExtensionID
0x2c -- TLS 1.3
extensionID_PskKeyExchangeModes :: ExtensionID
extensionID_PskKeyExchangeModes                 = ExtensionID
0x2d -- TLS 1.3
-- Reserved                                       0x2e -- TLS 1.3
extensionID_CertificateAuthorities :: ExtensionID
extensionID_CertificateAuthorities              = ExtensionID
0x2f -- TLS 1.3
extensionID_OidFilters :: ExtensionID
extensionID_OidFilters                          = ExtensionID
0x30 -- TLS 1.3
extensionID_PostHandshakeAuth :: ExtensionID
extensionID_PostHandshakeAuth                   = ExtensionID
0x31 -- TLS 1.3
extensionID_SignatureAlgorithmsCert :: ExtensionID
extensionID_SignatureAlgorithmsCert             = ExtensionID
0x32 -- TLS 1.3
extensionID_KeyShare :: ExtensionID
extensionID_KeyShare                            = ExtensionID
0x33 -- TLS 1.3
extensionID_QuicTransportParameters :: ExtensionID
extensionID_QuicTransportParameters             = ExtensionID
0x39 -- QUIC
extensionID_SecureRenegotiation :: ExtensionID
extensionID_SecureRenegotiation                 = ExtensionID
0xff01 -- RFC5746

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

definedExtensions :: [ExtensionID]
definedExtensions :: [ExtensionID]
definedExtensions =
    [ ExtensionID
extensionID_ServerName
    , ExtensionID
extensionID_MaxFragmentLength
    , ExtensionID
extensionID_ClientCertificateUrl
    , ExtensionID
extensionID_TrustedCAKeys
    , ExtensionID
extensionID_TruncatedHMAC
    , ExtensionID
extensionID_StatusRequest
    , ExtensionID
extensionID_UserMapping
    , ExtensionID
extensionID_ClientAuthz
    , ExtensionID
extensionID_ServerAuthz
    , ExtensionID
extensionID_CertType
    , ExtensionID
extensionID_NegotiatedGroups
    , ExtensionID
extensionID_EcPointFormats
    , ExtensionID
extensionID_SRP
    , ExtensionID
extensionID_SignatureAlgorithms
    , ExtensionID
extensionID_SRTP
    , ExtensionID
extensionID_Heartbeat
    , ExtensionID
extensionID_ApplicationLayerProtocolNegotiation
    , ExtensionID
extensionID_StatusRequestv2
    , ExtensionID
extensionID_SignedCertificateTimestamp
    , ExtensionID
extensionID_ClientCertificateType
    , ExtensionID
extensionID_ServerCertificateType
    , ExtensionID
extensionID_Padding
    , ExtensionID
extensionID_EncryptThenMAC
    , ExtensionID
extensionID_ExtendedMasterSecret
    , ExtensionID
extensionID_SessionTicket
    , ExtensionID
extensionID_PreSharedKey
    , ExtensionID
extensionID_EarlyData
    , ExtensionID
extensionID_SupportedVersions
    , ExtensionID
extensionID_Cookie
    , ExtensionID
extensionID_PskKeyExchangeModes
    , ExtensionID
extensionID_KeyShare
    , ExtensionID
extensionID_SignatureAlgorithmsCert
    , ExtensionID
extensionID_CertificateAuthorities
    , ExtensionID
extensionID_SecureRenegotiation
    , ExtensionID
extensionID_QuicTransportParameters
    ]

-- | all supported extensions by the implementation
supportedExtensions :: [ExtensionID]
supportedExtensions :: [ExtensionID]
supportedExtensions = [ ExtensionID
extensionID_ServerName
                      , ExtensionID
extensionID_MaxFragmentLength
                      , ExtensionID
extensionID_ApplicationLayerProtocolNegotiation
                      , ExtensionID
extensionID_ExtendedMasterSecret
                      , ExtensionID
extensionID_SecureRenegotiation
                      , ExtensionID
extensionID_NegotiatedGroups
                      , ExtensionID
extensionID_EcPointFormats
                      , ExtensionID
extensionID_SignatureAlgorithms
                      , ExtensionID
extensionID_SignatureAlgorithmsCert
                      , ExtensionID
extensionID_KeyShare
                      , ExtensionID
extensionID_PreSharedKey
                      , ExtensionID
extensionID_EarlyData
                      , ExtensionID
extensionID_SupportedVersions
                      , ExtensionID
extensionID_Cookie
                      , ExtensionID
extensionID_PskKeyExchangeModes
                      , ExtensionID
extensionID_CertificateAuthorities
                      , ExtensionID
extensionID_QuicTransportParameters
                      ]

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

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
/= :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c== :: 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
showList :: [MessageType] -> ShowS
$cshowList :: [MessageType] -> ShowS
show :: MessageType -> String
$cshow :: MessageType -> String
showsPrec :: Int -> MessageType -> ShowS
$cshowsPrec :: Int -> MessageType -> ShowS
Show)

-- | Extension class to transform bytes to and from a high level Extension type.
class Extension a where
    extensionID     :: a -> ExtensionID
    extensionDecode :: MessageType -> ByteString -> Maybe a
    extensionEncode :: a -> ByteString

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

-- | Server Name extension including the name type and the associated name.
-- 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
showList :: [ServerName] -> ShowS
$cshowList :: [ServerName] -> ShowS
show :: ServerName -> String
$cshow :: ServerName -> String
showsPrec :: Int -> ServerName -> ShowS
$cshowsPrec :: Int -> ServerName -> ShowS
Show,ServerName -> ServerName -> Bool
(ServerName -> ServerName -> Bool)
-> (ServerName -> ServerName -> Bool) -> Eq ServerName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerName -> ServerName -> Bool
$c/= :: ServerName -> ServerName -> Bool
== :: ServerName -> ServerName -> Bool
$c== :: ServerName -> ServerName -> Bool
Eq)

data ServerNameType = ServerNameHostName HostName
                    | ServerNameOther    (Word8, ByteString)
                    deriving (Int -> ServerNameType -> ShowS
[ServerNameType] -> ShowS
ServerNameType -> String
(Int -> ServerNameType -> ShowS)
-> (ServerNameType -> String)
-> ([ServerNameType] -> ShowS)
-> Show ServerNameType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerNameType] -> ShowS
$cshowList :: [ServerNameType] -> ShowS
show :: ServerNameType -> String
$cshow :: ServerNameType -> String
showsPrec :: Int -> ServerNameType -> ShowS
$cshowsPrec :: Int -> ServerNameType -> ShowS
Show,ServerNameType -> ServerNameType -> Bool
(ServerNameType -> ServerNameType -> Bool)
-> (ServerNameType -> ServerNameType -> Bool) -> Eq ServerNameType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerNameType -> ServerNameType -> Bool
$c/= :: ServerNameType -> ServerNameType -> Bool
== :: ServerNameType -> ServerNameType -> Bool
$c== :: ServerNameType -> ServerNameType -> Bool
Eq)

instance Extension ServerName where
    extensionID :: ServerName -> ExtensionID
extensionID ServerName
_ = ExtensionID
extensionID_ServerName
    extensionEncode :: ServerName -> ByteString
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 (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 (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 = Get ServerName -> ByteString -> Maybe ServerName
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Get ServerName -> ByteString -> Maybe ServerName)
-> Get ServerName -> ByteString -> Maybe ServerName
forall a b. (a -> b) -> a -> b
$ do
    Int
len <- ExtensionID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ExtensionID -> Int) -> Get ExtensionID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ExtensionID
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
  where
    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 (m :: * -> *) a. Monad m => a -> m a
return (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> 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
showList :: [MaxFragmentLength] -> ShowS
$cshowList :: [MaxFragmentLength] -> ShowS
show :: MaxFragmentLength -> String
$cshow :: MaxFragmentLength -> String
showsPrec :: Int -> MaxFragmentLength -> ShowS
$cshowsPrec :: Int -> MaxFragmentLength -> ShowS
Show,MaxFragmentLength -> MaxFragmentLength -> Bool
(MaxFragmentLength -> MaxFragmentLength -> Bool)
-> (MaxFragmentLength -> MaxFragmentLength -> Bool)
-> Eq MaxFragmentLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxFragmentLength -> MaxFragmentLength -> Bool
$c/= :: MaxFragmentLength -> MaxFragmentLength -> Bool
== :: MaxFragmentLength -> MaxFragmentLength -> Bool
$c== :: 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
showList :: [MaxFragmentEnum] -> ShowS
$cshowList :: [MaxFragmentEnum] -> ShowS
show :: MaxFragmentEnum -> String
$cshow :: MaxFragmentEnum -> String
showsPrec :: Int -> MaxFragmentEnum -> ShowS
$cshowsPrec :: Int -> MaxFragmentEnum -> ShowS
Show,MaxFragmentEnum -> MaxFragmentEnum -> Bool
(MaxFragmentEnum -> MaxFragmentEnum -> Bool)
-> (MaxFragmentEnum -> MaxFragmentEnum -> Bool)
-> Eq MaxFragmentEnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxFragmentEnum -> MaxFragmentEnum -> Bool
$c/= :: MaxFragmentEnum -> MaxFragmentEnum -> Bool
== :: MaxFragmentEnum -> MaxFragmentEnum -> Bool
$c== :: MaxFragmentEnum -> MaxFragmentEnum -> Bool
Eq)

instance Extension MaxFragmentLength where
    extensionID :: MaxFragmentLength -> ExtensionID
extensionID MaxFragmentLength
_ = ExtensionID
extensionID_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 p. Num p => MaxFragmentEnum -> p
fromMaxFragmentEnum MaxFragmentEnum
l
      where
        fromMaxFragmentEnum :: MaxFragmentEnum -> p
fromMaxFragmentEnum MaxFragmentEnum
MaxFragment512  = p
1
        fromMaxFragmentEnum MaxFragmentEnum
MaxFragment1024 = p
2
        fromMaxFragmentEnum MaxFragmentEnum
MaxFragment2048 = p
3
        fromMaxFragmentEnum MaxFragmentEnum
MaxFragment4096 = p
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

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

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

instance Extension SecureRenegotiation where
    extensionID :: SecureRenegotiation -> ExtensionID
extensionID SecureRenegotiation
_ = ExtensionID
extensionID_SecureRenegotiation
    extensionEncode :: SecureRenegotiation -> ByteString
extensionEncode (SecureRenegotiation ByteString
cvd Maybe 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 -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
B.empty Maybe ByteString
svd)
    extensionDecode :: MessageType -> ByteString -> Maybe SecureRenegotiation
extensionDecode MessageType
msgtype = 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
        case MessageType
msgtype of
          MessageType
MsgTServerHello -> 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
                             in SecureRenegotiation -> Get SecureRenegotiation
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureRenegotiation -> Get SecureRenegotiation)
-> SecureRenegotiation -> Get SecureRenegotiation
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> SecureRenegotiation
SecureRenegotiation ByteString
cvd (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
svd)
          MessageType
MsgTClientHello -> SecureRenegotiation -> Get SecureRenegotiation
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureRenegotiation -> Get SecureRenegotiation)
-> SecureRenegotiation -> Get SecureRenegotiation
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> SecureRenegotiation
SecureRenegotiation ByteString
opaque Maybe ByteString
forall a. Maybe a
Nothing
          MessageType
_               -> String -> Get SecureRenegotiation
forall a. HasCallStack => String -> a
error String
"extensionDecode: SecureRenegotiation"

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

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

instance Extension ApplicationLayerProtocolNegotiation where
    extensionID :: ApplicationLayerProtocolNegotiation -> ExtensionID
extensionID ApplicationLayerProtocolNegotiation
_ = ExtensionID
extensionID_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
    ExtensionID
len <- Get ExtensionID
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 (ExtensionID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ExtensionID
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 (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 Master Secret
data ExtendedMasterSecret = ExtendedMasterSecret deriving (Int -> ExtendedMasterSecret -> ShowS
[ExtendedMasterSecret] -> ShowS
ExtendedMasterSecret -> String
(Int -> ExtendedMasterSecret -> ShowS)
-> (ExtendedMasterSecret -> String)
-> ([ExtendedMasterSecret] -> ShowS)
-> Show ExtendedMasterSecret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendedMasterSecret] -> ShowS
$cshowList :: [ExtendedMasterSecret] -> ShowS
show :: ExtendedMasterSecret -> String
$cshow :: ExtendedMasterSecret -> String
showsPrec :: Int -> ExtendedMasterSecret -> ShowS
$cshowsPrec :: Int -> ExtendedMasterSecret -> ShowS
Show,ExtendedMasterSecret -> ExtendedMasterSecret -> Bool
(ExtendedMasterSecret -> ExtendedMasterSecret -> Bool)
-> (ExtendedMasterSecret -> ExtendedMasterSecret -> Bool)
-> Eq ExtendedMasterSecret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendedMasterSecret -> ExtendedMasterSecret -> Bool
$c/= :: ExtendedMasterSecret -> ExtendedMasterSecret -> Bool
== :: ExtendedMasterSecret -> ExtendedMasterSecret -> Bool
$c== :: ExtendedMasterSecret -> ExtendedMasterSecret -> Bool
Eq)

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

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

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

-- on decode, filter all unknown curves
instance Extension NegotiatedGroups where
    extensionID :: NegotiatedGroups -> ExtensionID
extensionID NegotiatedGroups
_ = ExtensionID
extensionID_NegotiatedGroups
    extensionEncode :: NegotiatedGroups -> ByteString
extensionEncode (NegotiatedGroups [Group]
groups) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ [ExtensionID] -> Put
putWords16 ([ExtensionID] -> Put) -> [ExtensionID] -> Put
forall a b. (a -> b) -> a -> b
$ (Group -> ExtensionID) -> [Group] -> [ExtensionID]
forall a b. (a -> b) -> [a] -> [b]
map Group -> ExtensionID
forall a. EnumSafe16 a => a -> ExtensionID
fromEnumSafe16 [Group]
groups
    extensionDecode :: MessageType -> ByteString -> Maybe NegotiatedGroups
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe NegotiatedGroups
decodeNegotiatedGroups
    extensionDecode MessageType
MsgTEncryptedExtensions = ByteString -> Maybe NegotiatedGroups
decodeNegotiatedGroups
    extensionDecode MessageType
_               = String -> ByteString -> Maybe NegotiatedGroups
forall a. HasCallStack => String -> a
error String
"extensionDecode: NegotiatedGroups"

decodeNegotiatedGroups :: ByteString -> Maybe NegotiatedGroups
decodeNegotiatedGroups :: ByteString -> Maybe NegotiatedGroups
decodeNegotiatedGroups =
    Get NegotiatedGroups -> ByteString -> Maybe NegotiatedGroups
forall a. Get a -> ByteString -> Maybe a
runGetMaybe ([Group] -> NegotiatedGroups
NegotiatedGroups ([Group] -> NegotiatedGroups)
-> ([ExtensionID] -> [Group]) -> [ExtensionID] -> NegotiatedGroups
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExtensionID -> Maybe Group) -> [ExtensionID] -> [Group]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExtensionID -> Maybe Group
forall a. EnumSafe16 a => ExtensionID -> Maybe a
toEnumSafe16 ([ExtensionID] -> NegotiatedGroups)
-> Get [ExtensionID] -> Get NegotiatedGroups
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExtensionID]
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
showList :: [EcPointFormatsSupported] -> ShowS
$cshowList :: [EcPointFormatsSupported] -> ShowS
show :: EcPointFormatsSupported -> String
$cshow :: EcPointFormatsSupported -> String
showsPrec :: Int -> EcPointFormatsSupported -> ShowS
$cshowsPrec :: Int -> EcPointFormatsSupported -> ShowS
Show,EcPointFormatsSupported -> EcPointFormatsSupported -> Bool
(EcPointFormatsSupported -> EcPointFormatsSupported -> Bool)
-> (EcPointFormatsSupported -> EcPointFormatsSupported -> Bool)
-> Eq EcPointFormatsSupported
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EcPointFormatsSupported -> EcPointFormatsSupported -> Bool
$c/= :: EcPointFormatsSupported -> EcPointFormatsSupported -> Bool
== :: EcPointFormatsSupported -> EcPointFormatsSupported -> Bool
$c== :: EcPointFormatsSupported -> EcPointFormatsSupported -> Bool
Eq)

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

instance EnumSafe8 EcPointFormat where
    fromEnumSafe8 :: EcPointFormat -> Word8
fromEnumSafe8 EcPointFormat
EcPointFormat_Uncompressed = Word8
0
    fromEnumSafe8 EcPointFormat
EcPointFormat_AnsiX962_compressed_prime = Word8
1
    fromEnumSafe8 EcPointFormat
EcPointFormat_AnsiX962_compressed_char2 = Word8
2

    toEnumSafe8 :: Word8 -> Maybe EcPointFormat
toEnumSafe8 Word8
0 = EcPointFormat -> Maybe EcPointFormat
forall a. a -> Maybe a
Just EcPointFormat
EcPointFormat_Uncompressed
    toEnumSafe8 Word8
1 = EcPointFormat -> Maybe EcPointFormat
forall a. a -> Maybe a
Just EcPointFormat
EcPointFormat_AnsiX962_compressed_prime
    toEnumSafe8 Word8
2 = EcPointFormat -> Maybe EcPointFormat
forall a. a -> Maybe a
Just EcPointFormat
EcPointFormat_AnsiX962_compressed_char2
    toEnumSafe8 Word8
_ = Maybe EcPointFormat
forall a. Maybe a
Nothing

-- on decode, filter all unknown formats
instance Extension EcPointFormatsSupported where
    extensionID :: EcPointFormatsSupported -> ExtensionID
extensionID EcPointFormatsSupported
_ = ExtensionID
extensionID_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
forall a. EnumSafe8 a => a -> Word8
fromEnumSafe8 [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 -> Maybe EcPointFormat) -> [Word8] -> [EcPointFormat]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Word8 -> Maybe EcPointFormat
forall a. EnumSafe8 a => Word8 -> Maybe a
toEnumSafe8 ([Word8] -> EcPointFormatsSupported)
-> Get [Word8] -> Get EcPointFormatsSupported
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
getWords8)

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

-- Fixme: this is incomplete
-- newtype SessionTicket = SessionTicket ByteString
data SessionTicket = SessionTicket
    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
showList :: [SessionTicket] -> ShowS
$cshowList :: [SessionTicket] -> ShowS
show :: SessionTicket -> String
$cshow :: SessionTicket -> String
showsPrec :: Int -> SessionTicket -> ShowS
$cshowsPrec :: Int -> SessionTicket -> ShowS
Show,SessionTicket -> SessionTicket -> Bool
(SessionTicket -> SessionTicket -> Bool)
-> (SessionTicket -> SessionTicket -> Bool) -> Eq SessionTicket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionTicket -> SessionTicket -> Bool
$c/= :: SessionTicket -> SessionTicket -> Bool
== :: SessionTicket -> SessionTicket -> Bool
$c== :: SessionTicket -> SessionTicket -> Bool
Eq)

instance Extension SessionTicket where
    extensionID :: SessionTicket -> ExtensionID
extensionID SessionTicket
_ = ExtensionID
extensionID_SessionTicket
    extensionEncode :: SessionTicket -> ByteString
extensionEncode SessionTicket{} = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    extensionDecode :: MessageType -> ByteString -> Maybe SessionTicket
extensionDecode MessageType
MsgTClientHello = Get SessionTicket -> ByteString -> Maybe SessionTicket
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (SessionTicket -> Get SessionTicket
forall (m :: * -> *) a. Monad m => a -> m a
return SessionTicket
SessionTicket)
    extensionDecode MessageType
MsgTServerHello = Get SessionTicket -> ByteString -> Maybe SessionTicket
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (SessionTicket -> Get SessionTicket
forall (m :: * -> *) a. Monad m => a -> m a
return SessionTicket
SessionTicket)
    extensionDecode MessageType
_               = String -> ByteString -> Maybe SessionTicket
forall a. HasCallStack => String -> a
error String
"extensionDecode: SessionTicket"

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

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

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

instance EnumSafe8 HeartBeatMode where
    fromEnumSafe8 :: HeartBeatMode -> Word8
fromEnumSafe8 HeartBeatMode
HeartBeat_PeerAllowedToSend    = Word8
1
    fromEnumSafe8 HeartBeatMode
HeartBeat_PeerNotAllowedToSend = Word8
2

    toEnumSafe8 :: Word8 -> Maybe HeartBeatMode
toEnumSafe8 Word8
1 = HeartBeatMode -> Maybe HeartBeatMode
forall a. a -> Maybe a
Just HeartBeatMode
HeartBeat_PeerAllowedToSend
    toEnumSafe8 Word8
2 = HeartBeatMode -> Maybe HeartBeatMode
forall a. a -> Maybe a
Just HeartBeatMode
HeartBeat_PeerNotAllowedToSend
    toEnumSafe8 Word8
_ = Maybe HeartBeatMode
forall a. Maybe a
Nothing

instance Extension HeartBeat where
    extensionID :: HeartBeat -> ExtensionID
extensionID HeartBeat
_ = ExtensionID
extensionID_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
forall a. EnumSafe8 a => a -> Word8
fromEnumSafe8 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
$ do
    Maybe HeartBeatMode
mm <- Word8 -> Maybe HeartBeatMode
forall a. EnumSafe8 a => Word8 -> Maybe a
toEnumSafe8 (Word8 -> Maybe HeartBeatMode)
-> Get Word8 -> Get (Maybe HeartBeatMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    case Maybe HeartBeatMode
mm of
      Just HeartBeatMode
m  -> HeartBeat -> Get HeartBeat
forall (m :: * -> *) a. Monad m => a -> m a
return (HeartBeat -> Get HeartBeat) -> HeartBeat -> Get HeartBeat
forall a b. (a -> b) -> a -> b
$ HeartBeatMode -> HeartBeat
HeartBeat HeartBeatMode
m
      Maybe HeartBeatMode
Nothing -> String -> Get HeartBeat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown HeartBeatMode"

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

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

instance Extension SignatureAlgorithms where
    extensionID :: SignatureAlgorithms -> ExtensionID
extensionID SignatureAlgorithms
_ = ExtensionID
extensionID_SignatureAlgorithms
    extensionEncode :: SignatureAlgorithms -> ByteString
extensionEncode (SignatureAlgorithms [HashAndSignatureAlgorithm]
algs) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ExtensionID -> Put
putWord16 (Int -> ExtensionID
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([HashAndSignatureAlgorithm] -> 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 (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
    ExtensionID
len <- Get ExtensionID
getWord16
    [HashAndSignatureAlgorithm]
sas <- Int
-> Get (Int, HashAndSignatureAlgorithm)
-> Get [HashAndSignatureAlgorithm]
forall a. Int -> Get (Int, a) -> Get [a]
getList (ExtensionID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ExtensionID
len) (Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm Get HashAndSignatureAlgorithm
-> (HashAndSignatureAlgorithm
    -> Get (Int, HashAndSignatureAlgorithm))
-> Get (Int, HashAndSignatureAlgorithm)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashAndSignatureAlgorithm
sh -> (Int, HashAndSignatureAlgorithm)
-> Get (Int, HashAndSignatureAlgorithm)
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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeSignatureAlgorithms: broken length"
    SignatureAlgorithms -> Get SignatureAlgorithms
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

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

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

instance Extension PostHandshakeAuth where
    extensionID :: PostHandshakeAuth -> ExtensionID
extensionID PostHandshakeAuth
_ = ExtensionID
extensionID_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 (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
showList :: [SignatureAlgorithmsCert] -> ShowS
$cshowList :: [SignatureAlgorithmsCert] -> ShowS
show :: SignatureAlgorithmsCert -> String
$cshow :: SignatureAlgorithmsCert -> String
showsPrec :: Int -> SignatureAlgorithmsCert -> ShowS
$cshowsPrec :: Int -> SignatureAlgorithmsCert -> ShowS
Show,SignatureAlgorithmsCert -> SignatureAlgorithmsCert -> Bool
(SignatureAlgorithmsCert -> SignatureAlgorithmsCert -> Bool)
-> (SignatureAlgorithmsCert -> SignatureAlgorithmsCert -> Bool)
-> Eq SignatureAlgorithmsCert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureAlgorithmsCert -> SignatureAlgorithmsCert -> Bool
$c/= :: SignatureAlgorithmsCert -> SignatureAlgorithmsCert -> Bool
== :: SignatureAlgorithmsCert -> SignatureAlgorithmsCert -> Bool
$c== :: SignatureAlgorithmsCert -> SignatureAlgorithmsCert -> Bool
Eq)

instance Extension SignatureAlgorithmsCert where
    extensionID :: SignatureAlgorithmsCert -> ExtensionID
extensionID SignatureAlgorithmsCert
_ = ExtensionID
extensionID_SignatureAlgorithmsCert
    extensionEncode :: SignatureAlgorithmsCert -> ByteString
extensionEncode (SignatureAlgorithmsCert [HashAndSignatureAlgorithm]
algs) =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ExtensionID -> Put
putWord16 (Int -> ExtensionID
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([HashAndSignatureAlgorithm] -> 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 (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
    ExtensionID
len <- Get ExtensionID
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 (ExtensionID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ExtensionID
len) (Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm Get HashAndSignatureAlgorithm
-> (HashAndSignatureAlgorithm
    -> Get (Int, HashAndSignatureAlgorithm))
-> Get (Int, HashAndSignatureAlgorithm)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashAndSignatureAlgorithm
sh -> (Int, HashAndSignatureAlgorithm)
-> Get (Int, HashAndSignatureAlgorithm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2, HashAndSignatureAlgorithm
sh))

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

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

instance Extension SupportedVersions where
    extensionID :: SupportedVersions -> ExtensionID
extensionID SupportedVersions
_ = ExtensionID
extensionID_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 (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)
-> ([Maybe Version] -> [Version])
-> [Maybe Version]
-> SupportedVersions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Version] -> [Version]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Version] -> SupportedVersions)
-> Get [Maybe Version] -> Get SupportedVersions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Int, Maybe Version) -> Get [Maybe Version]
forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len Get (Int, Maybe Version)
getVer
      where
        getVer :: Get (Int, Maybe Version)
getVer = do
            Maybe Version
ver <- Get (Maybe Version)
getBinaryVersion
            (Int, Maybe Version) -> Get (Int, Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2,Maybe Version
ver)
    extensionDecode MessageType
MsgTServerHello = 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
        Maybe Version
mver <- Get (Maybe Version)
getBinaryVersion
        case Maybe Version
mver of
          Just Version
ver -> SupportedVersions -> Get SupportedVersions
forall (m :: * -> *) a. Monad m => a -> m a
return (SupportedVersions -> Get SupportedVersions)
-> SupportedVersions -> Get SupportedVersions
forall a b. (a -> b) -> a -> b
$ Version -> SupportedVersions
SupportedVersionsServerHello Version
ver
          Maybe Version
Nothing  -> String -> Get SupportedVersions
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"extensionDecode: SupportedVersionsServerHello"
    extensionDecode MessageType
_ = String -> ByteString -> Maybe SupportedVersions
forall a. HasCallStack => String -> a
error String
"extensionDecode: SupportedVersionsServerHello"

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

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

getKeyShareEntry :: Get (Int, Maybe KeyShareEntry)
getKeyShareEntry :: Get (Int, Maybe KeyShareEntry)
getKeyShareEntry = do
    ExtensionID
g <- Get ExtensionID
getWord16
    Int
l <- ExtensionID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ExtensionID -> Int) -> Get ExtensionID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ExtensionID
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
    case ExtensionID -> Maybe Group
forall a. EnumSafe16 a => ExtensionID -> Maybe a
toEnumSafe16 ExtensionID
g of
      Maybe Group
Nothing  -> (Int, Maybe KeyShareEntry) -> Get (Int, Maybe KeyShareEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, Maybe KeyShareEntry
forall a. Maybe a
Nothing)
      Just Group
grp -> (Int, Maybe KeyShareEntry) -> Get (Int, Maybe KeyShareEntry)
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
grp ByteString
key) = do
    ExtensionID -> Put
putWord16 (ExtensionID -> Put) -> ExtensionID -> Put
forall a b. (a -> b) -> a -> b
$ Group -> ExtensionID
forall a. EnumSafe16 a => a -> ExtensionID
fromEnumSafe16 Group
grp
    ExtensionID -> Put
putWord16 (ExtensionID -> Put) -> ExtensionID -> Put
forall a b. (a -> b) -> a -> b
$ Int -> ExtensionID
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ExtensionID) -> Int -> ExtensionID
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
showList :: [KeyShare] -> ShowS
$cshowList :: [KeyShare] -> ShowS
show :: KeyShare -> String
$cshow :: KeyShare -> String
showsPrec :: Int -> KeyShare -> ShowS
$cshowsPrec :: Int -> KeyShare -> ShowS
Show,KeyShare -> KeyShare -> Bool
(KeyShare -> KeyShare -> Bool)
-> (KeyShare -> KeyShare -> Bool) -> Eq KeyShare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyShare -> KeyShare -> Bool
$c/= :: KeyShare -> KeyShare -> Bool
== :: KeyShare -> KeyShare -> Bool
$c== :: KeyShare -> KeyShare -> Bool
Eq)

instance Extension KeyShare where
    extensionID :: KeyShare -> ExtensionID
extensionID KeyShare
_ = ExtensionID
extensionID_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 (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]
        ExtensionID -> Put
putWord16 (ExtensionID -> Put) -> ExtensionID -> Put
forall a b. (a -> b) -> a -> b
$ Int -> ExtensionID
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
grp) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ExtensionID -> Put
putWord16 (ExtensionID -> Put) -> ExtensionID -> Put
forall a b. (a -> b) -> a -> b
$ Group -> ExtensionID
forall a. EnumSafe16 a => a -> ExtensionID
fromEnumSafe16 Group
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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decoding KeyShare for ServerHello"
            Just KeyShareEntry
ent -> KeyShare -> Get KeyShare
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 <- ExtensionID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ExtensionID -> Int) -> Get ExtensionID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ExtensionID
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 (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
$ do
        Maybe Group
mgrp <- ExtensionID -> Maybe Group
forall a. EnumSafe16 a => ExtensionID -> Maybe a
toEnumSafe16 (ExtensionID -> Maybe Group)
-> Get ExtensionID -> Get (Maybe Group)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ExtensionID
getWord16
        case Maybe Group
mgrp of
          Maybe Group
Nothing  -> String -> Get KeyShare
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decoding KeyShare for HRR"
          Just Group
grp -> KeyShare -> Get KeyShare
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyShare -> Get KeyShare) -> KeyShare -> Get KeyShare
forall a b. (a -> b) -> a -> b
$ Group -> KeyShare
KeyShareHRR Group
grp
    extensionDecode MessageType
_ = String -> ByteString -> Maybe KeyShare
forall a. HasCallStack => String -> a
error String
"extensionDecode: KeyShare"

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

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

instance EnumSafe8 PskKexMode where
    fromEnumSafe8 :: PskKexMode -> Word8
fromEnumSafe8 PskKexMode
PSK_KE     = Word8
0
    fromEnumSafe8 PskKexMode
PSK_DHE_KE = Word8
1

    toEnumSafe8 :: Word8 -> Maybe PskKexMode
toEnumSafe8 Word8
0 = PskKexMode -> Maybe PskKexMode
forall a. a -> Maybe a
Just PskKexMode
PSK_KE
    toEnumSafe8 Word8
1 = PskKexMode -> Maybe PskKexMode
forall a. a -> Maybe a
Just PskKexMode
PSK_DHE_KE
    toEnumSafe8 Word8
_ = Maybe PskKexMode
forall a. Maybe a
Nothing

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
/= :: PskKeyExchangeModes -> PskKeyExchangeModes -> Bool
$c/= :: PskKeyExchangeModes -> PskKeyExchangeModes -> Bool
== :: PskKeyExchangeModes -> PskKeyExchangeModes -> Bool
$c== :: 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
showList :: [PskKeyExchangeModes] -> ShowS
$cshowList :: [PskKeyExchangeModes] -> ShowS
show :: PskKeyExchangeModes -> String
$cshow :: PskKeyExchangeModes -> String
showsPrec :: Int -> PskKeyExchangeModes -> ShowS
$cshowsPrec :: Int -> PskKeyExchangeModes -> ShowS
Show)

instance Extension PskKeyExchangeModes where
    extensionID :: PskKeyExchangeModes -> ExtensionID
extensionID PskKeyExchangeModes
_ = ExtensionID
extensionID_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
forall a. EnumSafe8 a => a -> Word8
fromEnumSafe8 [PskKexMode]
pkms
    extensionDecode :: MessageType -> ByteString -> Maybe PskKeyExchangeModes
extensionDecode MessageType
MsgTClientHello = 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 -> Maybe PskKexMode) -> [Word8] -> [PskKexMode]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Word8 -> Maybe PskKexMode
forall a. EnumSafe8 a => Word8 -> Maybe a
toEnumSafe8 ([Word8] -> PskKeyExchangeModes)
-> Get [Word8] -> Get PskKeyExchangeModes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
getWords8
    extensionDecode MessageType
_ = String -> ByteString -> Maybe PskKeyExchangeModes
forall a. HasCallStack => String -> a
error String
"extensionDecode: PskKeyExchangeModes"

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

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
/= :: PskIdentity -> PskIdentity -> Bool
$c/= :: PskIdentity -> PskIdentity -> Bool
== :: PskIdentity -> PskIdentity -> Bool
$c== :: 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
showList :: [PskIdentity] -> ShowS
$cshowList :: [PskIdentity] -> ShowS
show :: PskIdentity -> String
$cshow :: PskIdentity -> String
showsPrec :: Int -> PskIdentity -> ShowS
$cshowsPrec :: Int -> 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
/= :: PreSharedKey -> PreSharedKey -> Bool
$c/= :: PreSharedKey -> PreSharedKey -> Bool
== :: PreSharedKey -> PreSharedKey -> Bool
$c== :: 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
showList :: [PreSharedKey] -> ShowS
$cshowList :: [PreSharedKey] -> ShowS
show :: PreSharedKey -> String
$cshow :: PreSharedKey -> String
showsPrec :: Int -> PreSharedKey -> ShowS
$cshowsPrec :: Int -> PreSharedKey -> ShowS
Show)

instance Extension PreSharedKey where
    extensionID :: PreSharedKey -> ExtensionID
extensionID PreSharedKey
_ = ExtensionID
extensionID_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
$
        ExtensionID -> Put
putWord16 (ExtensionID -> Put) -> ExtensionID -> Put
forall a b. (a -> b) -> a -> b
$ Int -> ExtensionID
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)
-> (ExtensionID -> Int) -> ExtensionID -> PreSharedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtensionID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ExtensionID -> PreSharedKey)
-> Get ExtensionID -> Get PreSharedKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ExtensionID
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 <- ExtensionID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ExtensionID -> Int) -> Get ExtensionID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ExtensionID
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 <- ExtensionID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ExtensionID -> Int) -> Get ExtensionID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ExtensionID
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 (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 (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 (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
/= :: EarlyDataIndication -> EarlyDataIndication -> Bool
$c/= :: EarlyDataIndication -> EarlyDataIndication -> Bool
== :: EarlyDataIndication -> EarlyDataIndication -> Bool
$c== :: 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
showList :: [EarlyDataIndication] -> ShowS
$cshowList :: [EarlyDataIndication] -> ShowS
show :: EarlyDataIndication -> String
$cshow :: EarlyDataIndication -> String
showsPrec :: Int -> EarlyDataIndication -> ShowS
$cshowsPrec :: Int -> EarlyDataIndication -> ShowS
Show)

instance Extension EarlyDataIndication where
    extensionID :: EarlyDataIndication -> ExtensionID
extensionID EarlyDataIndication
_ = ExtensionID
extensionID_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 (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 (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"

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

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
/= :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c== :: 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
showList :: [Cookie] -> ShowS
$cshowList :: [Cookie] -> ShowS
show :: Cookie -> String
$cshow :: Cookie -> String
showsPrec :: Int -> Cookie -> ShowS
$cshowsPrec :: Int -> Cookie -> ShowS
Show)

instance Extension Cookie where
    extensionID :: Cookie -> ExtensionID
extensionID Cookie
_ = ExtensionID
extensionID_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 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
/= :: CertificateAuthorities -> CertificateAuthorities -> Bool
$c/= :: CertificateAuthorities -> CertificateAuthorities -> Bool
== :: CertificateAuthorities -> CertificateAuthorities -> Bool
$c== :: 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
showList :: [CertificateAuthorities] -> ShowS
$cshowList :: [CertificateAuthorities] -> ShowS
show :: CertificateAuthorities -> String
$cshow :: CertificateAuthorities -> String
showsPrec :: Int -> CertificateAuthorities -> ShowS
$cshowsPrec :: Int -> CertificateAuthorities -> ShowS
Show)

instance Extension CertificateAuthorities where
    extensionID :: CertificateAuthorities -> ExtensionID
extensionID CertificateAuthorities
_ = ExtensionID
extensionID_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 =
       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)
    extensionDecode MessageType
MsgTCertificateRequest =
       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)
    extensionDecode MessageType
_ = String -> ByteString -> Maybe CertificateAuthorities
forall a. HasCallStack => String -> a
error String
"extensionDecode: CertificateAuthorities"