{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.TLS.Handshake.Server.ServerHello12 (
    sendServerHello12,
) where

import Network.TLS.Cipher
import Network.TLS.Compression
import Network.TLS.Context.Internal
import Network.TLS.Credentials
import Network.TLS.Crypto
import Network.TLS.Extension
import Network.TLS.Handshake.Certificate
import Network.TLS.Handshake.Common
import Network.TLS.Handshake.Key
import Network.TLS.Handshake.Random
import Network.TLS.Handshake.Server.Common
import Network.TLS.Handshake.Signature
import Network.TLS.Handshake.State
import Network.TLS.IO
import Network.TLS.Imports
import Network.TLS.Parameters
import Network.TLS.Session
import Network.TLS.State
import Network.TLS.Struct
import Network.TLS.Types
import Network.TLS.X509 hiding (Certificate)

sendServerHello12
    :: ServerParams
    -> Context
    -> (Cipher, Maybe Credential)
    -> ClientHello
    -> IO (Maybe SessionData)
sendServerHello12 :: ServerParams
-> Context
-> (Cipher, Maybe Credential)
-> ClientHello
-> IO (Maybe SessionData)
sendServerHello12 ServerParams
sparams Context
ctx (Cipher
usedCipher, Maybe Credential
mcred) ch :: ClientHello
ch@CH{[CompressionID]
[CipherId]
[ExtensionRaw]
Version
Session
ClientRandom
chVersion :: Version
chRandom :: ClientRandom
chSession :: Session
chCiphers :: [CipherId]
chComps :: [CompressionID]
chExtensions :: [ExtensionRaw]
chVersion :: ClientHello -> Version
chRandom :: ClientHello -> ClientRandom
chSession :: ClientHello -> Session
chCiphers :: ClientHello -> [CipherId]
chComps :: ClientHello -> [CompressionID]
chExtensions :: ClientHello -> [ExtensionRaw]
..} = do
    Maybe SessionData
resumeSessionData <- Context -> ClientHello -> IO (Maybe SessionData)
recoverSessionData Context
ctx ClientHello
ch
    case Maybe SessionData
resumeSessionData of
        Maybe SessionData
Nothing -> do
            Session
serverSession <- Context -> IO Session
newSession Context
ctx
            Context -> TLSSt () -> IO ()
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
forall a b. (a -> b) -> a -> b
$ Session -> TLSSt ()
setSession Session
serverSession
            ServerHello
sh <- ServerParams
-> Context
-> Cipher
-> Maybe Credential
-> [ExtensionRaw]
-> Session
-> IO ServerHello
makeServerHello ServerParams
sparams Context
ctx Cipher
usedCipher Maybe Credential
mcred [ExtensionRaw]
chExtensions Session
serverSession
            [Handshake] -> [Handshake]
build <- ServerParams
-> Context
-> Cipher
-> Maybe Credential
-> [ExtensionRaw]
-> IO ([Handshake] -> [Handshake])
sendServerFirstFlight ServerParams
sparams Context
ctx Cipher
usedCipher Maybe Credential
mcred [ExtensionRaw]
chExtensions
            let ff :: [Handshake]
ff = ServerHello -> Handshake
ServerHello ServerHello
sh Handshake -> [Handshake] -> [Handshake]
forall a. a -> [a] -> [a]
: [Handshake] -> [Handshake]
build [Handshake
ServerHelloDone]
            Context -> Packet -> IO ()
sendPacket12 Context
ctx (Packet -> IO ()) -> Packet -> IO ()
forall a b. (a -> b) -> a -> b
$ [Handshake] -> Packet
Handshake [Handshake]
ff
            Context -> IO ()
contextFlush Context
ctx
        Just SessionData
sessionData -> do
            Context -> TLSSt () -> IO ()
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Session -> TLSSt ()
setSession Session
chSession
                Bool -> TLSSt ()
setTLS12SessionResuming Bool
True
            ServerHello
sh <-
                ServerParams
-> Context
-> Cipher
-> Maybe Credential
-> [ExtensionRaw]
-> Session
-> IO ServerHello
makeServerHello ServerParams
sparams Context
ctx Cipher
usedCipher Maybe Credential
mcred [ExtensionRaw]
chExtensions Session
chSession
            Context -> Packet -> IO ()
sendPacket12 Context
ctx (Packet -> IO ()) -> Packet -> IO ()
forall a b. (a -> b) -> a -> b
$ [Handshake] -> Packet
Handshake [ServerHello -> Handshake
ServerHello ServerHello
sh]
            let mainSecret :: ByteString
mainSecret = SessionData -> ByteString
sessionSecret SessionData
sessionData
            Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> Role -> ByteString -> HandshakeM ()
setMainSecret Version
TLS12 Role
ServerRole ByteString
mainSecret
            Context -> MainSecret -> IO ()
forall a. LogLabel a => Context -> a -> IO ()
logKey Context
ctx (MainSecret -> IO ()) -> MainSecret -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> MainSecret
MainSecret ByteString
mainSecret
            Context -> Role -> IO ()
sendCCSandFinished Context
ctx Role
ServerRole
    Maybe SessionData -> IO (Maybe SessionData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
resumeSessionData

recoverSessionData :: Context -> ClientHello -> IO (Maybe SessionData)
recoverSessionData :: Context -> ClientHello -> IO (Maybe SessionData)
recoverSessionData Context
ctx CH{[CompressionID]
[CipherId]
[ExtensionRaw]
Version
Session
ClientRandom
chVersion :: ClientHello -> Version
chRandom :: ClientHello -> ClientRandom
chSession :: ClientHello -> Session
chCiphers :: ClientHello -> [CipherId]
chComps :: ClientHello -> [CompressionID]
chExtensions :: ClientHello -> [ExtensionRaw]
chVersion :: Version
chRandom :: ClientRandom
chSession :: Session
chCiphers :: [CipherId]
chComps :: [CompressionID]
chExtensions :: [ExtensionRaw]
..} = do
    Maybe HostName
serverName <- Context -> TLSSt (Maybe HostName) -> IO (Maybe HostName)
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt (Maybe HostName)
getClientSNI
    Bool
ems <- Context -> Version -> MessageType -> [ExtensionRaw] -> IO Bool
forall (m :: * -> *).
MonadIO m =>
Context -> Version -> MessageType -> [ExtensionRaw] -> m Bool
processExtendedMainSecret Context
ctx Version
TLS12 MessageType
MsgTClientHello [ExtensionRaw]
chExtensions
    let mticket :: Maybe ByteString
mticket =
            ExtensionID
-> MessageType
-> [ExtensionRaw]
-> Maybe ByteString
-> (SessionTicket -> Maybe ByteString)
-> Maybe ByteString
forall e a.
Extension e =>
ExtensionID -> MessageType -> [ExtensionRaw] -> a -> (e -> a) -> a
lookupAndDecode
                ExtensionID
EID_SessionTicket
                MessageType
MsgTClientHello
                [ExtensionRaw]
chExtensions
                Maybe ByteString
forall a. Maybe a
Nothing
                (\(SessionTicket ByteString
ticket) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
ticket)
        midentity :: Maybe ByteString
midentity = Maybe ByteString -> Session -> Maybe ByteString
ticketOrSessionID12 Maybe ByteString
mticket Session
chSession
    case Maybe ByteString
midentity of
        Maybe ByteString
Nothing -> Maybe SessionData -> IO (Maybe SessionData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
forall a. Maybe a
Nothing
        Just ByteString
identity -> do
            Maybe SessionData
sd <- SessionManager -> ByteString -> IO (Maybe SessionData)
sessionResume (Shared -> SessionManager
sharedSessionManager (Shared -> SessionManager) -> Shared -> SessionManager
forall a b. (a -> b) -> a -> b
$ Context -> Shared
ctxShared Context
ctx) ByteString
identity
            Context
-> [CipherId]
-> Maybe HostName
-> Bool
-> Maybe SessionData
-> IO (Maybe SessionData)
validateSession Context
ctx [CipherId]
chCiphers Maybe HostName
serverName Bool
ems Maybe SessionData
sd

validateSession
    :: Context
    -> [CipherId]
    -> Maybe HostName
    -> Bool
    -> Maybe SessionData
    -> IO (Maybe SessionData)
validateSession :: Context
-> [CipherId]
-> Maybe HostName
-> Bool
-> Maybe SessionData
-> IO (Maybe SessionData)
validateSession Context
_ [CipherId]
_ Maybe HostName
_ Bool
_ Maybe SessionData
Nothing = Maybe SessionData -> IO (Maybe SessionData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
forall a. Maybe a
Nothing
validateSession Context
ctx [CipherId]
ciphers Maybe HostName
sni Bool
ems m :: Maybe SessionData
m@(Just SessionData
sd)
    -- SessionData parameters are assumed to match the local server configuration
    -- so we need to compare only to ClientHello inputs.  Abbreviated handshake
    -- uses the same server_name than full handshake so the same
    -- credentials (and thus ciphers) are available.
    | Version
TLS12 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< SessionData -> Version
sessionVersion SessionData
sd = Maybe SessionData -> IO (Maybe SessionData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
forall a. Maybe a
Nothing -- fixme
    | Word16 -> CipherId
CipherId (SessionData -> Word16
sessionCipher SessionData
sd) CipherId -> [CipherId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CipherId]
ciphers =
        TLSError -> IO (Maybe SessionData)
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO (Maybe SessionData))
-> TLSError -> IO (Maybe SessionData)
forall a b. (a -> b) -> a -> b
$
            HostName -> AlertDescription -> TLSError
Error_Protocol HostName
"new cipher is diffrent from the old one" AlertDescription
IllegalParameter
    | Maybe HostName -> Bool
forall a. Maybe a -> Bool
isJust Maybe HostName
sni Bool -> Bool -> Bool
&& SessionData -> Maybe HostName
sessionClientSNI SessionData
sd Maybe HostName -> Maybe HostName -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe HostName
sni = do
        Context -> TLSSt () -> IO ()
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt ()
clearClientSNI
        Maybe SessionData -> IO (Maybe SessionData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
forall a. Maybe a
Nothing
    | Bool
ems Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
emsSession = Maybe SessionData -> IO (Maybe SessionData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
forall a. Maybe a
Nothing
    | Bool -> Bool
not Bool
ems Bool -> Bool -> Bool
&& Bool
emsSession =
        let err :: HostName
err = HostName
"client resumes an EMS session without EMS"
         in TLSError -> IO (Maybe SessionData)
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO (Maybe SessionData))
-> TLSError -> IO (Maybe SessionData)
forall a b. (a -> b) -> a -> b
$ HostName -> AlertDescription -> TLSError
Error_Protocol HostName
err AlertDescription
HandshakeFailure
    | Bool
otherwise = Maybe SessionData -> IO (Maybe SessionData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
m
  where
    emsSession :: Bool
emsSession = SessionFlag
SessionEMS SessionFlag -> [SessionFlag] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SessionData -> [SessionFlag]
sessionFlags SessionData
sd

sendServerFirstFlight
    :: ServerParams
    -> Context
    -> Cipher
    -> Maybe Credential
    -> [ExtensionRaw]
    -> IO ([Handshake] -> [Handshake])
sendServerFirstFlight :: ServerParams
-> Context
-> Cipher
-> Maybe Credential
-> [ExtensionRaw]
-> IO ([Handshake] -> [Handshake])
sendServerFirstFlight ServerParams{Bool
Int
[(CompressionID, ByteString)]
[SignedCertificate]
Maybe DHParams
ServerHooks
Shared
Supported
DebugParams
serverWantClientCert :: Bool
serverCACertificates :: [SignedCertificate]
serverDHEParams :: Maybe DHParams
serverHooks :: ServerHooks
serverShared :: Shared
serverSupported :: Supported
serverDebug :: DebugParams
serverEarlyDataSize :: Int
serverTicketLifetime :: Int
serverECHKey :: [(CompressionID, ByteString)]
serverWantClientCert :: ServerParams -> Bool
serverCACertificates :: ServerParams -> [SignedCertificate]
serverDHEParams :: ServerParams -> Maybe DHParams
serverHooks :: ServerParams -> ServerHooks
serverShared :: ServerParams -> Shared
serverSupported :: ServerParams -> Supported
serverDebug :: ServerParams -> DebugParams
serverEarlyDataSize :: ServerParams -> Int
serverTicketLifetime :: ServerParams -> Int
serverECHKey :: ServerParams -> [(CompressionID, ByteString)]
..} Context
ctx Cipher
usedCipher Maybe Credential
mcred [ExtensionRaw]
chExts = do
    let b0 :: a -> a
b0 = a -> a
forall a. a -> a
id
    let cc :: CertificateChain
cc = case Maybe Credential
mcred of
            Just (CertificateChain
srvCerts, PrivKey
_) -> CertificateChain
srvCerts
            Maybe Credential
_ -> [SignedCertificate] -> CertificateChain
CertificateChain []
    let b1 :: [Handshake] -> [Handshake]
b1 = [Handshake] -> [Handshake]
forall a. a -> a
b0 ([Handshake] -> [Handshake])
-> ([Handshake] -> [Handshake]) -> [Handshake] -> [Handshake]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertificateChain_ -> Handshake
Certificate (CertificateChain -> CertificateChain_
CertificateChain_ CertificateChain
cc) Handshake -> [Handshake] -> [Handshake]
forall a. a -> [a] -> [a]
:)
    Context -> TLSSt () -> IO ()
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
forall a b. (a -> b) -> a -> b
$ CertificateChain -> TLSSt ()
setServerCertificateChain CertificateChain
cc

    -- send server key exchange if needed
    Maybe ServerKeyXchgAlgorithmData
skx <- case Cipher -> CipherKeyExchangeType
cipherKeyExchange Cipher
usedCipher of
        CipherKeyExchangeType
CipherKeyExchange_DH_Anon -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
forall a. a -> Maybe a
Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
-> IO ServerKeyXchgAlgorithmData
-> IO (Maybe ServerKeyXchgAlgorithmData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ServerKeyXchgAlgorithmData
generateSKX_DH_Anon
        CipherKeyExchangeType
CipherKeyExchange_DHE_RSA -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
forall a. a -> Maybe a
Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
-> IO ServerKeyXchgAlgorithmData
-> IO (Maybe ServerKeyXchgAlgorithmData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
generateSKX_DHE KeyExchangeSignatureAlg
KX_RSA
        CipherKeyExchangeType
CipherKeyExchange_DHE_DSA -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
forall a. a -> Maybe a
Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
-> IO ServerKeyXchgAlgorithmData
-> IO (Maybe ServerKeyXchgAlgorithmData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
generateSKX_DHE KeyExchangeSignatureAlg
KX_DSA
        CipherKeyExchangeType
CipherKeyExchange_ECDHE_RSA -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
forall a. a -> Maybe a
Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
-> IO ServerKeyXchgAlgorithmData
-> IO (Maybe ServerKeyXchgAlgorithmData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
generateSKX_ECDHE KeyExchangeSignatureAlg
KX_RSA
        CipherKeyExchangeType
CipherKeyExchange_ECDHE_ECDSA -> ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData
forall a. a -> Maybe a
Just (ServerKeyXchgAlgorithmData -> Maybe ServerKeyXchgAlgorithmData)
-> IO ServerKeyXchgAlgorithmData
-> IO (Maybe ServerKeyXchgAlgorithmData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
generateSKX_ECDHE KeyExchangeSignatureAlg
KX_ECDSA
        CipherKeyExchangeType
_ -> Maybe ServerKeyXchgAlgorithmData
-> IO (Maybe ServerKeyXchgAlgorithmData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ServerKeyXchgAlgorithmData
forall a. Maybe a
Nothing
    let b2 :: [Handshake] -> [Handshake]
b2 = case Maybe ServerKeyXchgAlgorithmData
skx of
            Maybe ServerKeyXchgAlgorithmData
Nothing -> [Handshake] -> [Handshake]
b1
            Just ServerKeyXchgAlgorithmData
kx -> [Handshake] -> [Handshake]
b1 ([Handshake] -> [Handshake])
-> ([Handshake] -> [Handshake]) -> [Handshake] -> [Handshake]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerKeyXchgAlgorithmData -> Handshake
ServerKeyXchg ServerKeyXchgAlgorithmData
kx Handshake -> [Handshake] -> [Handshake]
forall a. a -> [a] -> [a]
:)

    -- FIXME we don't do this on a Anonymous server

    -- When configured, send a certificate request with the DNs of all
    -- configured CA certificates.
    --
    -- Client certificates MUST NOT be accepted if not requested.
    --
    if Bool
serverWantClientCert
        then do
            let ([CertificateType]
certTypes, [HashAndSignatureAlgorithm]
hashSigs) =
                    let as :: [HashAndSignatureAlgorithm]
as = Supported -> [HashAndSignatureAlgorithm]
supportedHashSignatures Supported
serverSupported
                     in ([CertificateType] -> [CertificateType]
forall a. Eq a => [a] -> [a]
nub ([CertificateType] -> [CertificateType])
-> [CertificateType] -> [CertificateType]
forall a b. (a -> b) -> a -> b
$ (HashAndSignatureAlgorithm -> Maybe CertificateType)
-> [HashAndSignatureAlgorithm] -> [CertificateType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe HashAndSignatureAlgorithm -> Maybe CertificateType
hashSigToCertType [HashAndSignatureAlgorithm]
as, [HashAndSignatureAlgorithm]
as)
                creq :: Handshake
creq =
                    [CertificateType]
-> [HashAndSignatureAlgorithm] -> [DistinguishedName] -> Handshake
CertRequest
                        [CertificateType]
certTypes
                        [HashAndSignatureAlgorithm]
hashSigs
                        ((SignedCertificate -> DistinguishedName)
-> [SignedCertificate] -> [DistinguishedName]
forall a b. (a -> b) -> [a] -> [b]
map SignedCertificate -> DistinguishedName
extractCAname [SignedCertificate]
serverCACertificates)
            Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> HandshakeM ()
setCertReqSent Bool
True
            ([Handshake] -> [Handshake]) -> IO ([Handshake] -> [Handshake])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([Handshake] -> [Handshake]) -> IO ([Handshake] -> [Handshake]))
-> ([Handshake] -> [Handshake]) -> IO ([Handshake] -> [Handshake])
forall a b. (a -> b) -> a -> b
$ [Handshake] -> [Handshake]
b2 ([Handshake] -> [Handshake])
-> ([Handshake] -> [Handshake]) -> [Handshake] -> [Handshake]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handshake
creq Handshake -> [Handshake] -> [Handshake]
forall a. a -> [a] -> [a]
:)
        else ([Handshake] -> [Handshake]) -> IO ([Handshake] -> [Handshake])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Handshake] -> [Handshake]
b2
  where
    commonGroups :: [Group]
commonGroups = [Group] -> [ExtensionRaw] -> [Group]
negotiatedGroupsInCommon (Supported -> [Group]
supportedGroups Supported
serverSupported) [ExtensionRaw]
chExts
    commonHashSigs :: [HashAndSignatureAlgorithm]
commonHashSigs = [HashAndSignatureAlgorithm]
-> [ExtensionRaw] -> [HashAndSignatureAlgorithm]
hashAndSignaturesInCommon (Supported -> [HashAndSignatureAlgorithm]
supportedHashSignatures Supported
serverSupported) [ExtensionRaw]
chExts
    setup_DHE :: IO ServerDHParams
setup_DHE = do
        let possibleFFGroups :: [Group]
possibleFFGroups = [Group]
commonGroups [Group] -> [Group] -> [Group]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Group]
availableFFGroups
        (DHParams
dhparams, DHPrivate
priv, DHPublic
pub) <-
            case [Group]
possibleFFGroups of
                [] ->
                    let dhparams :: DHParams
dhparams = Maybe DHParams -> DHParams
forall a. HasCallStack => Maybe a -> a
fromJust Maybe DHParams
serverDHEParams
                     in case DHParams -> Maybe Group
findFiniteFieldGroup DHParams
dhparams of
                            Just Group
g -> do
                                Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Group -> HandshakeM ()
setSupportedGroup Group
g
                                Context -> Group -> IO (DHParams, DHPrivate, DHPublic)
generateFFDHE Context
ctx Group
g
                            Maybe Group
Nothing -> do
                                (DHPrivate
priv, DHPublic
pub) <- Context -> DHParams -> IO (DHPrivate, DHPublic)
generateDHE Context
ctx DHParams
dhparams
                                (DHParams, DHPrivate, DHPublic)
-> IO (DHParams, DHPrivate, DHPublic)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DHParams
dhparams, DHPrivate
priv, DHPublic
pub)
                Group
g : [Group]
_ -> do
                    Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Group -> HandshakeM ()
setSupportedGroup Group
g
                    Context -> Group -> IO (DHParams, DHPrivate, DHPublic)
generateFFDHE Context
ctx Group
g

        let serverParams :: ServerDHParams
serverParams = DHParams -> DHPublic -> ServerDHParams
serverDHParamsFrom DHParams
dhparams DHPublic
pub

        Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> HandshakeM ()
setServerDHParams ServerDHParams
serverParams
        Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ DHPrivate -> HandshakeM ()
setDHPrivate DHPrivate
priv
        ServerDHParams -> IO ServerDHParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ServerDHParams
serverParams

    -- Choosing a hash algorithm to sign (EC)DHE parameters
    -- in ServerKeyExchange. Hash algorithm is not suggested by
    -- the chosen cipher suite. So, it should be selected based on
    -- the "signature_algorithms" extension in a client hello.
    -- If RSA is also used for key exchange, this function is
    -- not called.
    decideHashSig :: PubKey -> m HashAndSignatureAlgorithm
decideHashSig PubKey
pubKey = do
        case (HashAndSignatureAlgorithm -> Bool)
-> [HashAndSignatureAlgorithm] -> [HashAndSignatureAlgorithm]
forall a. (a -> Bool) -> [a] -> [a]
filter (PubKey
pubKey PubKey -> HashAndSignatureAlgorithm -> Bool
`signatureCompatible`) [HashAndSignatureAlgorithm]
commonHashSigs of
            [] -> HostName -> m HashAndSignatureAlgorithm
forall a. HasCallStack => HostName -> a
error (HostName
"no hash signature for " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ PubKey -> HostName
pubkeyType PubKey
pubKey)
            HashAndSignatureAlgorithm
x : [HashAndSignatureAlgorithm]
_ -> HashAndSignatureAlgorithm -> m HashAndSignatureAlgorithm
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return HashAndSignatureAlgorithm
x

    generateSKX_DHE :: KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
generateSKX_DHE KeyExchangeSignatureAlg
kxsAlg = do
        ServerDHParams
serverParams <- IO ServerDHParams
setup_DHE
        PubKey
pubKey <- Context -> IO PubKey
forall (m :: * -> *). MonadIO m => Context -> m PubKey
getLocalPublicKey Context
ctx
        HashAndSignatureAlgorithm
mhashSig <- PubKey -> IO HashAndSignatureAlgorithm
forall {m :: * -> *}.
Monad m =>
PubKey -> m HashAndSignatureAlgorithm
decideHashSig PubKey
pubKey
        DigitallySigned
signed <- Context
-> ServerDHParams
-> PubKey
-> HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignDHParams Context
ctx ServerDHParams
serverParams PubKey
pubKey HashAndSignatureAlgorithm
mhashSig
        case KeyExchangeSignatureAlg
kxsAlg of
            KeyExchangeSignatureAlg
KX_RSA -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_DHE_RSA ServerDHParams
serverParams DigitallySigned
signed
            KeyExchangeSignatureAlg
KX_DSA -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_DHE_DSA ServerDHParams
serverParams DigitallySigned
signed
            KeyExchangeSignatureAlg
_ ->
                HostName -> IO ServerKeyXchgAlgorithmData
forall a. HasCallStack => HostName -> a
error (HostName
"generate skx_dhe unsupported key exchange signature: " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ KeyExchangeSignatureAlg -> HostName
forall a. Show a => a -> HostName
show KeyExchangeSignatureAlg
kxsAlg)

    generateSKX_DH_Anon :: IO ServerKeyXchgAlgorithmData
generateSKX_DH_Anon = ServerDHParams -> ServerKeyXchgAlgorithmData
SKX_DH_Anon (ServerDHParams -> ServerKeyXchgAlgorithmData)
-> IO ServerDHParams -> IO ServerKeyXchgAlgorithmData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ServerDHParams
setup_DHE

    setup_ECDHE :: Group -> IO ServerECDHParams
setup_ECDHE Group
grp = do
        Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Group -> HandshakeM ()
setSupportedGroup Group
grp
        (GroupPrivate
srvpri, GroupPublic
srvpub) <- Context -> Group -> IO (GroupPrivate, GroupPublic)
generateECDHE Context
ctx Group
grp
        let serverParams :: ServerECDHParams
serverParams = Group -> GroupPublic -> ServerECDHParams
ServerECDHParams Group
grp GroupPublic
srvpub
        Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> HandshakeM ()
setServerECDHParams ServerECDHParams
serverParams
        Context -> HandshakeM () -> IO ()
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM () -> IO ()) -> HandshakeM () -> IO ()
forall a b. (a -> b) -> a -> b
$ GroupPrivate -> HandshakeM ()
setGroupPrivate GroupPrivate
srvpri
        ServerECDHParams -> IO ServerECDHParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ServerECDHParams
serverParams

    generateSKX_ECDHE :: KeyExchangeSignatureAlg -> IO ServerKeyXchgAlgorithmData
generateSKX_ECDHE KeyExchangeSignatureAlg
kxsAlg = do
        let possibleECGroups :: [Group]
possibleECGroups = [Group]
commonGroups [Group] -> [Group] -> [Group]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Group]
availableECGroups
        Group
grp <- case [Group]
possibleECGroups of
            [] -> TLSError -> IO Group
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO Group) -> TLSError -> IO Group
forall a b. (a -> b) -> a -> b
$ HostName -> AlertDescription -> TLSError
Error_Protocol HostName
"no common group" AlertDescription
HandshakeFailure
            Group
g : [Group]
_ -> Group -> IO Group
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Group
g
        ServerECDHParams
serverParams <- Group -> IO ServerECDHParams
setup_ECDHE Group
grp
        PubKey
pubKey <- Context -> IO PubKey
forall (m :: * -> *). MonadIO m => Context -> m PubKey
getLocalPublicKey Context
ctx
        HashAndSignatureAlgorithm
mhashSig <- PubKey -> IO HashAndSignatureAlgorithm
forall {m :: * -> *}.
Monad m =>
PubKey -> m HashAndSignatureAlgorithm
decideHashSig PubKey
pubKey
        DigitallySigned
signed <- Context
-> ServerECDHParams
-> PubKey
-> HashAndSignatureAlgorithm
-> IO DigitallySigned
digitallySignECDHParams Context
ctx ServerECDHParams
serverParams PubKey
pubKey HashAndSignatureAlgorithm
mhashSig
        case KeyExchangeSignatureAlg
kxsAlg of
            KeyExchangeSignatureAlg
KX_RSA -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_ECDHE_RSA ServerECDHParams
serverParams DigitallySigned
signed
            KeyExchangeSignatureAlg
KX_ECDSA -> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> IO ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_ECDHE_ECDSA ServerECDHParams
serverParams DigitallySigned
signed
            KeyExchangeSignatureAlg
_ ->
                HostName -> IO ServerKeyXchgAlgorithmData
forall a. HasCallStack => HostName -> a
error (HostName
"generate skx_ecdhe unsupported key exchange signature: " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ KeyExchangeSignatureAlg -> HostName
forall a. Show a => a -> HostName
show KeyExchangeSignatureAlg
kxsAlg)

---
-- When the client sends a certificate, check whether
-- it is acceptable for the application.
--
---
makeServerHello
    :: ServerParams
    -> Context
    -> Cipher
    -> Maybe Credential
    -> [ExtensionRaw]
    -> Session
    -> IO ServerHello
makeServerHello :: ServerParams
-> Context
-> Cipher
-> Maybe Credential
-> [ExtensionRaw]
-> Session
-> IO ServerHello
makeServerHello ServerParams
sparams Context
ctx Cipher
usedCipher Maybe Credential
mcred [ExtensionRaw]
chExts Session
session = do
    Bool
resuming <- Context -> TLSSt Bool -> IO Bool
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Bool
getTLS12SessionResuming
    case Maybe Credential
mcred of
        Just Credential
cred -> Context -> Credential -> IO ()
forall (m :: * -> *). MonadIO m => Context -> Credential -> m ()
storePrivInfoServer Context
ctx Credential
cred
        Maybe Credential
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- return a sensible error
    Maybe ExtensionRaw
sniExt <- do
        if Bool
resuming
            then Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing
            else do
                Maybe HostName
msni <- Context -> TLSSt (Maybe HostName) -> IO (Maybe HostName)
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt (Maybe HostName)
getClientSNI
                case Maybe HostName
msni of
                    -- RFC6066: In this event, the server SHALL include
                    -- an extension of type "server_name" in the
                    -- (extended) server hello. The "extension_data"
                    -- field of this extension SHALL be empty.
                    Just HostName
_ -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ ServerName -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (ServerName -> ExtensionRaw) -> ServerName -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [ServerNameType] -> ServerName
ServerName []
                    Maybe HostName
Nothing -> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    let ecPointExt :: Maybe ExtensionRaw
ecPointExt = case ExtensionID -> [ExtensionRaw] -> Maybe ByteString
extensionLookup ExtensionID
EID_EcPointFormats [ExtensionRaw]
chExts of
            Maybe ByteString
Nothing -> Maybe ExtensionRaw
forall a. Maybe a
Nothing
            Just ByteString
_ -> ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ EcPointFormatsSupported -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (EcPointFormatsSupported -> ExtensionRaw)
-> EcPointFormatsSupported -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ [EcPointFormat] -> EcPointFormatsSupported
EcPointFormatsSupported [EcPointFormat
EcPointFormat_Uncompressed]

    Maybe ExtensionRaw
alpnExt <- Context
-> [ExtensionRaw] -> ServerParams -> IO (Maybe ExtensionRaw)
applicationProtocol Context
ctx [ExtensionRaw]
chExts ServerParams
sparams

    Bool
ems <- Context -> HandshakeM Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx HandshakeM Bool
getExtendedMainSecret
    let emsExt :: Maybe ExtensionRaw
emsExt
            | Bool
ems = ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ ExtendedMainSecret -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw ExtendedMainSecret
ExtendedMainSecret
            | Bool
otherwise = Maybe ExtensionRaw
forall a. Maybe a
Nothing

    let useTicket :: Bool
useTicket = SessionManager -> Bool
sessionUseTicket (SessionManager -> Bool) -> SessionManager -> Bool
forall a b. (a -> b) -> a -> b
$ Shared -> SessionManager
sharedSessionManager (Shared -> SessionManager) -> Shared -> SessionManager
forall a b. (a -> b) -> a -> b
$ ServerParams -> Shared
serverShared ServerParams
sparams
        sessionTicketExt :: Maybe ExtensionRaw
sessionTicketExt
            | Bool -> Bool
not Bool
resuming Bool -> Bool -> Bool
&& Bool
useTicket = ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ SessionTicket -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw (SessionTicket -> ExtensionRaw) -> SessionTicket -> ExtensionRaw
forall a b. (a -> b) -> a -> b
$ ByteString -> SessionTicket
SessionTicket ByteString
""
            | Bool
otherwise = Maybe ExtensionRaw
forall a. Maybe a
Nothing

    -- in TLS12, we need to check as well the certificates we are sending if they have in the extension
    -- the necessary bits set.
    Bool
secReneg <- Context -> TLSSt Bool -> IO Bool
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Bool
getSecureRenegotiation
    Maybe ExtensionRaw
secureRenegExt <-
        if Bool
secReneg
            then do
                SecureRenegotiation
vd <- Context -> TLSSt SecureRenegotiation -> IO SecureRenegotiation
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt SecureRenegotiation -> IO SecureRenegotiation)
-> TLSSt SecureRenegotiation -> IO SecureRenegotiation
forall a b. (a -> b) -> a -> b
$ do
                    VerifyData ByteString
cvd <- Role -> TLSSt VerifyData
getVerifyData Role
ClientRole
                    VerifyData ByteString
svd <- Role -> TLSSt VerifyData
getVerifyData Role
ServerRole
                    SecureRenegotiation -> TLSSt SecureRenegotiation
forall a. a -> TLSSt a
forall (m :: * -> *) a. Monad m => a -> m a
return (SecureRenegotiation -> TLSSt SecureRenegotiation)
-> SecureRenegotiation -> TLSSt SecureRenegotiation
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> SecureRenegotiation
SecureRenegotiation ByteString
cvd ByteString
svd
                Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExtensionRaw -> IO (Maybe ExtensionRaw))
-> Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a b. (a -> b) -> a -> b
$ ExtensionRaw -> Maybe ExtensionRaw
forall a. a -> Maybe a
Just (ExtensionRaw -> Maybe ExtensionRaw)
-> ExtensionRaw -> Maybe ExtensionRaw
forall a b. (a -> b) -> a -> b
$ SecureRenegotiation -> ExtensionRaw
forall e. Extension e => e -> ExtensionRaw
toExtensionRaw SecureRenegotiation
vd
            else Maybe ExtensionRaw -> IO (Maybe ExtensionRaw)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionRaw
forall a. Maybe a
Nothing

    Maybe ExtensionRaw
recodeSizeLimitExt <- Context -> [ExtensionRaw] -> Bool -> IO (Maybe ExtensionRaw)
processRecordSizeLimit Context
ctx [ExtensionRaw]
chExts Bool
False

    ServerRandom
srand <-
        Context -> Version -> [Version] -> IO ServerRandom
serverRandom Context
ctx Version
TLS12 ([Version] -> IO ServerRandom) -> [Version] -> IO ServerRandom
forall a b. (a -> b) -> a -> b
$ Supported -> [Version]
supportedVersions (Supported -> [Version]) -> Supported -> [Version]
forall a b. (a -> b) -> a -> b
$ ServerParams -> Supported
serverSupported ServerParams
sparams

    let shExts :: [ExtensionRaw]
shExts =
            Shared -> [ExtensionRaw]
sharedHelloExtensions (ServerParams -> Shared
serverShared ServerParams
sparams)
                [ExtensionRaw] -> [ExtensionRaw] -> [ExtensionRaw]
forall a. [a] -> [a] -> [a]
++ [Maybe ExtensionRaw] -> [ExtensionRaw]
forall a. [Maybe a] -> [a]
catMaybes
                    [ {- 0x00 -} Maybe ExtensionRaw
sniExt
                    , {- 0x0b -} Maybe ExtensionRaw
ecPointExt
                    , {- 0x10 -} Maybe ExtensionRaw
alpnExt
                    , {- 0x17 -} Maybe ExtensionRaw
emsExt
                    , {- 0x1c -} Maybe ExtensionRaw
recodeSizeLimitExt
                    , {- 0x23 -} Maybe ExtensionRaw
sessionTicketExt
                    , {- 0xff01 -} Maybe ExtensionRaw
secureRenegExt
                    ]
    Context -> TLSSt () -> IO ()
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt () -> IO ()) -> TLSSt () -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> TLSSt ()
setVersion Version
TLS12
    Context
-> Version -> ServerRandom -> Cipher -> Compression -> IO ()
setServerHelloParameters12 Context
ctx Version
TLS12 ServerRandom
srand Cipher
usedCipher Compression
nullCompression
    ServerHello -> IO ServerHello
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerHello -> IO ServerHello) -> ServerHello -> IO ServerHello
forall a b. (a -> b) -> a -> b
$
        SH
            { shVersion :: Version
shVersion = Version
TLS12
            , shRandom :: ServerRandom
shRandom = ServerRandom
srand
            , shSession :: Session
shSession = Session
session
            , shCipher :: CipherId
shCipher = Word16 -> CipherId
CipherId (Cipher -> Word16
cipherID Cipher
usedCipher)
            , shComp :: CompressionID
shComp = CompressionID
0
            , shExtensions :: [ExtensionRaw]
shExtensions = [ExtensionRaw]
shExts
            }

negotiatedGroupsInCommon :: [Group] -> [ExtensionRaw] -> [Group]
negotiatedGroupsInCommon :: [Group] -> [ExtensionRaw] -> [Group]
negotiatedGroupsInCommon [Group]
serverGroups [ExtensionRaw]
chExts =
    ExtensionID
-> MessageType
-> [ExtensionRaw]
-> [Group]
-> (SupportedGroups -> [Group])
-> [Group]
forall e a.
Extension e =>
ExtensionID -> MessageType -> [ExtensionRaw] -> a -> (e -> a) -> a
lookupAndDecode
        ExtensionID
EID_SupportedGroups
        MessageType
MsgTClientHello
        [ExtensionRaw]
chExts
        []
        SupportedGroups -> [Group]
common
  where
    common :: SupportedGroups -> [Group]
common (SupportedGroups [Group]
clientGroups) = [Group]
serverGroups [Group] -> [Group] -> [Group]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Group]
clientGroups