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

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

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

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

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

data MessageType = MsgTClientHello
                 | MsgTServerHello
                 | MsgTHelloRetryRequest
                 | MsgTEncryptedExtensions
                 | MsgTNewSessionTicket
                 | MsgTCertificateRequest
                 deriving (MessageType -> MessageType -> Bool
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
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
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
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
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
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 -> Word16
extensionID ServerName
_ = Word16
extensionID_ServerName
    extensionEncode :: ServerName -> ByteString
extensionEncode (ServerName [ServerNameType]
l) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putOpaque16 (Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ 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  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 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
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: ServerName"

decodeServerName :: ByteString -> Maybe ServerName
decodeServerName :: ByteString -> Maybe ServerName
decodeServerName = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ do
    Int
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    [ServerNameType] -> ServerName
ServerName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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)
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1forall a. Num a => a -> a -> a
+Int
2forall 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
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
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
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
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 -> Word16
extensionID MaxFragmentLength
_ = Word16
extensionID_MaxFragmentLength
    extensionEncode :: MaxFragmentLength -> ByteString
extensionEncode (MaxFragmentLength MaxFragmentEnum
l) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 forall a b. (a -> b) -> a -> b
$ forall {a}. Num a => MaxFragmentEnum -> a
fromMaxFragmentEnum MaxFragmentEnum
l
      where
        fromMaxFragmentEnum :: MaxFragmentEnum -> a
fromMaxFragmentEnum MaxFragmentEnum
MaxFragment512  = a
1
        fromMaxFragmentEnum MaxFragmentEnum
MaxFragment1024 = a
2
        fromMaxFragmentEnum MaxFragmentEnum
MaxFragment2048 = a
3
        fromMaxFragmentEnum MaxFragmentEnum
MaxFragment4096 = a
4
    extensionEncode (MaxFragmentLengthOther Word8
l) = Put -> ByteString
runPut 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
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: MaxFragmentLength"

decodeMaxFragmentLength :: ByteString -> Maybe MaxFragmentLength
decodeMaxFragmentLength :: ByteString -> Maybe MaxFragmentLength
decodeMaxFragmentLength = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ Word8 -> MaxFragmentLength
toMaxFragmentEnum 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
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
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 -> Word16
extensionID SecureRenegotiation
_ = Word16
extensionID_SecureRenegotiation
    extensionEncode :: SecureRenegotiation -> ByteString
extensionEncode (SecureRenegotiation ByteString
cvd Maybe ByteString
svd) =
        Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putOpaque8 (ByteString
cvd ByteString -> ByteString -> ByteString
`B.append` forall a. a -> Maybe a -> a
fromMaybe ByteString
B.empty Maybe ByteString
svd)
    extensionDecode :: MessageType -> ByteString -> Maybe SecureRenegotiation
extensionDecode MessageType
msgtype = forall a. Get a -> ByteString -> Maybe a
runGetMaybe 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 forall a. Integral a => a -> a -> a
`div` Int
2) ByteString
opaque
                             in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> SecureRenegotiation
SecureRenegotiation ByteString
cvd (forall a. a -> Maybe a
Just ByteString
svd)
          MessageType
MsgTClientHello -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> SecureRenegotiation
SecureRenegotiation ByteString
opaque forall a. Maybe a
Nothing
          MessageType
_               -> 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
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
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 -> Word16
extensionID ApplicationLayerProtocolNegotiation
_ = Word16
extensionID_ApplicationLayerProtocolNegotiation
    extensionEncode :: ApplicationLayerProtocolNegotiation -> ByteString
extensionEncode (ApplicationLayerProtocolNegotiation [ByteString]
bytes) =
        Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putOpaque16 forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ 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
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: ApplicationLayerProtocolNegotiation"

decodeApplicationLayerProtocolNegotiation :: ByteString -> Maybe ApplicationLayerProtocolNegotiation
decodeApplicationLayerProtocolNegotiation :: ByteString -> Maybe ApplicationLayerProtocolNegotiation
decodeApplicationLayerProtocolNegotiation = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ do
    Word16
len <- Get Word16
getWord16
    [ByteString] -> ApplicationLayerProtocolNegotiation
ApplicationLayerProtocolNegotiation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Get (Int, a) -> Get [a]
getList (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) Get (Int, ByteString)
getALPN
  where
    getALPN :: Get (Int, ByteString)
getALPN = do
        ByteString
alpnParsed <- Get ByteString
getOpaque8
        let !alpn :: ByteString
alpn = ByteString -> ByteString
B.copy ByteString
alpnParsed
        forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Int
B.length ByteString
alpn 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
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
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 -> Word16
extensionID ExtendedMasterSecret
_ = Word16
extensionID_ExtendedMasterSecret
    extensionEncode :: ExtendedMasterSecret -> ByteString
extensionEncode ExtendedMasterSecret
ExtendedMasterSecret = ByteString
B.empty
    extensionDecode :: MessageType -> ByteString -> Maybe ExtendedMasterSecret
extensionDecode MessageType
MsgTClientHello ByteString
_ = forall a. a -> Maybe a
Just ExtendedMasterSecret
ExtendedMasterSecret
    extensionDecode MessageType
MsgTServerHello ByteString
_ = forall a. a -> Maybe a
Just ExtendedMasterSecret
ExtendedMasterSecret
    extensionDecode MessageType
_               ByteString
_ = forall a. HasCallStack => String -> a
error String
"extensionDecode: ExtendedMasterSecret"

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

newtype NegotiatedGroups = NegotiatedGroups [Group] deriving (Int -> NegotiatedGroups -> ShowS
[NegotiatedGroups] -> ShowS
NegotiatedGroups -> String
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
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 -> Word16
extensionID NegotiatedGroups
_ = Word16
extensionID_NegotiatedGroups
    extensionEncode :: NegotiatedGroups -> ByteString
extensionEncode (NegotiatedGroups [Group]
groups) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ [Word16] -> Put
putWords16 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. EnumSafe16 a => a -> Word16
fromEnumSafe16 [Group]
groups
    extensionDecode :: MessageType -> ByteString -> Maybe NegotiatedGroups
extensionDecode MessageType
MsgTClientHello = ByteString -> Maybe NegotiatedGroups
decodeNegotiatedGroups
    extensionDecode MessageType
MsgTEncryptedExtensions = ByteString -> Maybe NegotiatedGroups
decodeNegotiatedGroups
    extensionDecode MessageType
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: NegotiatedGroups"

decodeNegotiatedGroups :: ByteString -> Maybe NegotiatedGroups
decodeNegotiatedGroups :: ByteString -> Maybe NegotiatedGroups
decodeNegotiatedGroups =
    forall a. Get a -> ByteString -> Maybe a
runGetMaybe ([Group] -> NegotiatedGroups
NegotiatedGroups forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. EnumSafe16 a => Word16 -> Maybe a
toEnumSafe16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word16]
getWords16)

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

newtype EcPointFormatsSupported = EcPointFormatsSupported [EcPointFormat] deriving (Int -> EcPointFormatsSupported -> ShowS
[EcPointFormatsSupported] -> ShowS
EcPointFormatsSupported -> String
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
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
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
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 = forall a. a -> Maybe a
Just EcPointFormat
EcPointFormat_Uncompressed
    toEnumSafe8 Word8
1 = forall a. a -> Maybe a
Just EcPointFormat
EcPointFormat_AnsiX962_compressed_prime
    toEnumSafe8 Word8
2 = forall a. a -> Maybe a
Just EcPointFormat
EcPointFormat_AnsiX962_compressed_char2
    toEnumSafe8 Word8
_ = forall a. Maybe a
Nothing

-- on decode, filter all unknown formats
instance Extension EcPointFormatsSupported where
    extensionID :: EcPointFormatsSupported -> Word16
extensionID EcPointFormatsSupported
_ = Word16
extensionID_EcPointFormats
    extensionEncode :: EcPointFormatsSupported -> ByteString
extensionEncode (EcPointFormatsSupported [EcPointFormat]
formats) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ [Word8] -> Put
putWords8 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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
_ = forall a. HasCallStack => String -> a
error String
"extensionDecode: EcPointFormatsSupported"

decodeEcPointFormatsSupported :: ByteString -> Maybe EcPointFormatsSupported
decodeEcPointFormatsSupported :: ByteString -> Maybe EcPointFormatsSupported
decodeEcPointFormatsSupported =
    forall a. Get a -> ByteString -> Maybe a
runGetMaybe ([EcPointFormat] -> EcPointFormatsSupported
EcPointFormatsSupported forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. EnumSafe8 a => Word8 -> Maybe a
toEnumSafe8 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
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
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 -> Word16
extensionID SessionTicket
_ = Word16
extensionID_SessionTicket
    extensionEncode :: SessionTicket -> ByteString
extensionEncode SessionTicket{} = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
    extensionDecode :: MessageType -> ByteString -> Maybe SessionTicket
extensionDecode MessageType
MsgTClientHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe (forall (m :: * -> *) a. Monad m => a -> m a
return SessionTicket
SessionTicket)
    extensionDecode MessageType
MsgTServerHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe (forall (m :: * -> *) a. Monad m => a -> m a
return SessionTicket
SessionTicket)
    extensionDecode MessageType
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: SessionTicket"

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

newtype HeartBeat = HeartBeat HeartBeatMode deriving (Int -> HeartBeat -> ShowS
[HeartBeat] -> ShowS
HeartBeat -> String
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
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
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
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 = forall a. a -> Maybe a
Just HeartBeatMode
HeartBeat_PeerAllowedToSend
    toEnumSafe8 Word8
2 = forall a. a -> Maybe a
Just HeartBeatMode
HeartBeat_PeerNotAllowedToSend
    toEnumSafe8 Word8
_ = forall a. Maybe a
Nothing

instance Extension HeartBeat where
    extensionID :: HeartBeat -> Word16
extensionID HeartBeat
_ = Word16
extensionID_Heartbeat
    extensionEncode :: HeartBeat -> ByteString
extensionEncode (HeartBeat HeartBeatMode
mode) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 forall a b. (a -> b) -> a -> b
$ 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
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: HeartBeat"

decodeHeartBeat :: ByteString -> Maybe HeartBeat
decodeHeartBeat :: ByteString -> Maybe HeartBeat
decodeHeartBeat = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ do
    Maybe HeartBeatMode
mm <- forall a. EnumSafe8 a => Word8 -> Maybe a
toEnumSafe8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    case Maybe HeartBeatMode
mm of
      Just HeartBeatMode
m  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HeartBeatMode -> HeartBeat
HeartBeat HeartBeatMode
m
      Maybe HeartBeatMode
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown HeartBeatMode"

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

newtype SignatureAlgorithms = SignatureAlgorithms [HashAndSignatureAlgorithm] deriving (Int -> SignatureAlgorithms -> ShowS
[SignatureAlgorithms] -> ShowS
SignatureAlgorithms -> String
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
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 -> Word16
extensionID SignatureAlgorithms
_ = Word16
extensionID_SignatureAlgorithms
    extensionEncode :: SignatureAlgorithms -> ByteString
extensionEncode (SignatureAlgorithms [HashAndSignatureAlgorithm]
algs) =
        Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Word16 -> Put
putWord16 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashAndSignatureAlgorithm]
algs forall a. Num a => a -> a -> a
* Int
2)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: SignatureAlgorithms"

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

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

data PostHandshakeAuth = PostHandshakeAuth deriving (Int -> PostHandshakeAuth -> ShowS
[PostHandshakeAuth] -> ShowS
PostHandshakeAuth -> String
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
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 -> Word16
extensionID PostHandshakeAuth
_ = Word16
extensionID_PostHandshakeAuth
    extensionEncode :: PostHandshakeAuth -> ByteString
extensionEncode PostHandshakeAuth
_               = ByteString
B.empty
    extensionDecode :: MessageType -> ByteString -> Maybe PostHandshakeAuth
extensionDecode MessageType
MsgTClientHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return PostHandshakeAuth
PostHandshakeAuth
    extensionDecode MessageType
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: PostHandshakeAuth"

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

newtype SignatureAlgorithmsCert = SignatureAlgorithmsCert [HashAndSignatureAlgorithm] deriving (Int -> SignatureAlgorithmsCert -> ShowS
[SignatureAlgorithmsCert] -> ShowS
SignatureAlgorithmsCert -> String
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
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 -> Word16
extensionID SignatureAlgorithmsCert
_ = Word16
extensionID_SignatureAlgorithmsCert
    extensionEncode :: SignatureAlgorithmsCert -> ByteString
extensionEncode (SignatureAlgorithmsCert [HashAndSignatureAlgorithm]
algs) =
        Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Word16 -> Put
putWord16 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashAndSignatureAlgorithm]
algs forall a. Num a => a -> a -> a
* Int
2)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: SignatureAlgorithmsCert"

decodeSignatureAlgorithmsCert :: ByteString -> Maybe SignatureAlgorithmsCert
decodeSignatureAlgorithmsCert :: ByteString -> Maybe SignatureAlgorithmsCert
decodeSignatureAlgorithmsCert = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ do
    Word16
len <- Get Word16
getWord16
    [HashAndSignatureAlgorithm] -> SignatureAlgorithmsCert
SignatureAlgorithmsCert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Get (Int, a) -> Get [a]
getList (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) (Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HashAndSignatureAlgorithm
sh -> 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
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
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 -> Word16
extensionID SupportedVersions
_ = Word16
extensionID_SupportedVersions
    extensionEncode :: SupportedVersions -> ByteString
extensionEncode (SupportedVersionsClientHello [Version]
vers) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
        Putter Word8
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Version]
vers forall a. Num a => a -> a -> a
* Int
2))
        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 forall a b. (a -> b) -> a -> b
$
        Version -> Put
putBinaryVersion Version
ver
    extensionDecode :: MessageType -> ByteString -> Maybe SupportedVersions
extensionDecode MessageType
MsgTClientHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ do
        Int
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        [Version] -> SupportedVersions
SupportedVersionsClientHello forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
            forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2,Maybe Version
ver)
    extensionDecode MessageType
MsgTServerHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ do
        Maybe Version
mver <- Get (Maybe Version)
getBinaryVersion
        case Maybe Version
mver of
          Just Version
ver -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Version -> SupportedVersions
SupportedVersionsServerHello Version
ver
          Maybe Version
Nothing  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"extensionDecode: SupportedVersionsServerHello"
    extensionDecode MessageType
_ = 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
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
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
    Word16
g <- Get Word16
getWord16
    Int
l <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    ByteString
key <- Int -> Get ByteString
getBytes Int
l
    let !len :: Int
len = Int
l forall a. Num a => a -> a -> a
+ Int
4
    case forall a. EnumSafe16 a => Word16 -> Maybe a
toEnumSafe16 Word16
g of
      Maybe Group
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, forall a. Maybe a
Nothing)
      Just Group
grp -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, forall a. a -> Maybe a
Just 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
    Word16 -> Put
putWord16 forall a b. (a -> b) -> a -> b
$ forall a. EnumSafe16 a => a -> Word16
fromEnumSafe16 Group
grp
    Word16 -> Put
putWord16 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral 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
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
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 -> Word16
extensionID KeyShare
_ = Word16
extensionID_KeyShare
    extensionEncode :: KeyShare -> ByteString
extensionEncode (KeyShareClientHello [KeyShareEntry]
kses) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
        let !len :: Int
len = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ByteString -> Int
B.length ByteString
key forall a. Num a => a -> a -> a
+ Int
4 | KeyShareEntry Group
_ ByteString
key <- [KeyShareEntry]
kses]
        Word16 -> Put
putWord16 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
        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 forall a b. (a -> b) -> a -> b
$ KeyShareEntry -> Put
putKeyShareEntry KeyShareEntry
kse
    extensionEncode (KeyShareHRR Group
grp) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Word16 -> Put
putWord16 forall a b. (a -> b) -> a -> b
$ forall a. EnumSafe16 a => a -> Word16
fromEnumSafe16 Group
grp
    extensionDecode :: MessageType -> ByteString -> Maybe KeyShare
extensionDecode MessageType
MsgTServerHello  = forall a. Get a -> ByteString -> Maybe a
runGetMaybe 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  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decoding KeyShare for ServerHello"
            Just KeyShareEntry
ent -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ KeyShareEntry -> KeyShare
KeyShareServerHello KeyShareEntry
ent
    extensionDecode MessageType
MsgTClientHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ do
        Int
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
--      len == 0 allows for HRR
        [Maybe KeyShareEntry]
grps <- forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len Get (Int, Maybe KeyShareEntry)
getKeyShareEntry
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [KeyShareEntry] -> KeyShare
KeyShareClientHello forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe KeyShareEntry]
grps
    extensionDecode MessageType
MsgTHelloRetryRequest = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ do
        Maybe Group
mgrp <- forall a. EnumSafe16 a => Word16 -> Maybe a
toEnumSafe16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
        case Maybe Group
mgrp of
          Maybe Group
Nothing  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decoding KeyShare for HRR"
          Just Group
grp -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Group -> KeyShare
KeyShareHRR Group
grp
    extensionDecode MessageType
_ = forall a. HasCallStack => String -> a
error String
"extensionDecode: KeyShare"

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

data PskKexMode = PSK_KE | PSK_DHE_KE deriving (PskKexMode -> PskKexMode -> Bool
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
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 = forall a. a -> Maybe a
Just PskKexMode
PSK_KE
    toEnumSafe8 Word8
1 = forall a. a -> Maybe a
Just PskKexMode
PSK_DHE_KE
    toEnumSafe8 Word8
_ = forall a. Maybe a
Nothing

newtype PskKeyExchangeModes = PskKeyExchangeModes [PskKexMode] deriving (PskKeyExchangeModes -> PskKeyExchangeModes -> Bool
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
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 -> Word16
extensionID PskKeyExchangeModes
_ = Word16
extensionID_PskKeyExchangeModes
    extensionEncode :: PskKeyExchangeModes -> ByteString
extensionEncode (PskKeyExchangeModes [PskKexMode]
pkms) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$
        [Word8] -> Put
putWords8 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. EnumSafe8 a => a -> Word8
fromEnumSafe8 [PskKexMode]
pkms
    extensionDecode :: MessageType -> ByteString -> Maybe PskKeyExchangeModes
extensionDecode MessageType
MsgTClientHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$
        [PskKexMode] -> PskKeyExchangeModes
PskKeyExchangeModes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. EnumSafe8 a => Word8 -> Maybe a
toEnumSafe8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
getWords8
    extensionDecode MessageType
_ = forall a. HasCallStack => String -> a
error String
"extensionDecode: PskKeyExchangeModes"

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

data PskIdentity = PskIdentity ByteString Word32 deriving (PskIdentity -> PskIdentity -> Bool
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
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
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
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 -> Word16
extensionID PreSharedKey
_ = Word16
extensionID_PreSharedKey
    extensionEncode :: PreSharedKey -> ByteString
extensionEncode (PreSharedKeyClientHello [PskIdentity]
ids [ByteString]
bds) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
        ByteString -> Put
putOpaque16 forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PskIdentity -> Put
putIdentity [PskIdentity]
ids)
        ByteString -> Put
putOpaque16 forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (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 forall a b. (a -> b) -> a -> b
$
        Word16 -> Put
putWord16 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w16
    extensionDecode :: MessageType -> ByteString -> Maybe PreSharedKey
extensionDecode MessageType
MsgTServerHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$
        Int -> PreSharedKey
PreSharedKeyServerHello forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    extensionDecode MessageType
MsgTClientHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$ do
        Int
len1 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
        [PskIdentity]
identities <- forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len1 Get (Int, PskIdentity)
getIdentity
        Int
len2 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
        [ByteString]
binders <- forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len2 Get (Int, ByteString)
getBinder
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
identity forall a. Num a => a -> a -> a
+ Int
4
            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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a. Num a => a -> a -> a
+ Int
1
            forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, ByteString
binder)
    extensionDecode MessageType
_ = forall a. HasCallStack => String -> a
error String
"extensionDecode: PreShareKey"

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

newtype EarlyDataIndication = EarlyDataIndication (Maybe Word32) deriving (EarlyDataIndication -> EarlyDataIndication -> Bool
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
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 -> Word16
extensionID EarlyDataIndication
_ = Word16
extensionID_EarlyData
    extensionEncode :: EarlyDataIndication -> ByteString
extensionEncode (EarlyDataIndication Maybe Word32
Nothing)   = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putBytes ByteString
B.empty
    extensionEncode (EarlyDataIndication (Just Word32
w32)) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Word32 -> Put
putWord32 Word32
w32
    extensionDecode :: MessageType -> ByteString -> Maybe EarlyDataIndication
extensionDecode MessageType
MsgTClientHello         = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Maybe Word32 -> EarlyDataIndication
EarlyDataIndication forall a. Maybe a
Nothing)
    extensionDecode MessageType
MsgTEncryptedExtensions = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Maybe Word32 -> EarlyDataIndication
EarlyDataIndication forall a. Maybe a
Nothing)
    extensionDecode MessageType
MsgTNewSessionTicket    = forall a. Get a -> ByteString -> Maybe a
runGetMaybe forall a b. (a -> b) -> a -> b
$
        Maybe Word32 -> EarlyDataIndication
EarlyDataIndication forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
    extensionDecode MessageType
_                       = forall a. HasCallStack => String -> a
error String
"extensionDecode: EarlyDataIndication"

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

newtype Cookie = Cookie ByteString deriving (Cookie -> Cookie -> Bool
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
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 -> Word16
extensionID Cookie
_ = Word16
extensionID_Cookie
    extensionEncode :: Cookie -> ByteString
extensionEncode (Cookie ByteString
opaque) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putOpaque16 ByteString
opaque
    extensionDecode :: MessageType -> ByteString -> Maybe Cookie
extensionDecode MessageType
MsgTServerHello = forall a. Get a -> ByteString -> Maybe a
runGetMaybe (ByteString -> Cookie
Cookie forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getOpaque16)
    extensionDecode MessageType
_               = forall a. HasCallStack => String -> a
error String
"extensionDecode: Cookie"

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

newtype CertificateAuthorities = CertificateAuthorities [DistinguishedName]
    deriving (CertificateAuthorities -> CertificateAuthorities -> Bool
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
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 -> Word16
extensionID CertificateAuthorities
_ = Word16
extensionID_CertificateAuthorities
    extensionEncode :: CertificateAuthorities -> ByteString
extensionEncode (CertificateAuthorities [DistinguishedName]
names) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$
        [DistinguishedName] -> Put
putDNames [DistinguishedName]
names
    extensionDecode :: MessageType -> ByteString -> Maybe CertificateAuthorities
extensionDecode MessageType
MsgTClientHello =
       forall a. Get a -> ByteString -> Maybe a
runGetMaybe ([DistinguishedName] -> CertificateAuthorities
CertificateAuthorities forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [DistinguishedName]
getDNames)
    extensionDecode MessageType
MsgTCertificateRequest =
       forall a. Get a -> ByteString -> Maybe a
runGetMaybe ([DistinguishedName] -> CertificateAuthorities
CertificateAuthorities forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [DistinguishedName]
getDNames)
    extensionDecode MessageType
_ = forall a. HasCallStack => String -> a
error String
"extensionDecode: CertificateAuthorities"