{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.TLS.Handshake.Client.TLS12 (
recvServerFirstFlight12,
sendClientSecondFlight12,
recvServerSecondFlight12,
) where
import Control.Monad.State.Strict
import qualified Data.ByteString as B
import Network.TLS.Cipher
import Network.TLS.Context.Internal
import Network.TLS.Crypto
import Network.TLS.Handshake.Client.Common
import Network.TLS.Handshake.Common
import Network.TLS.Handshake.Key
import Network.TLS.Handshake.Signature
import Network.TLS.Handshake.State
import Network.TLS.IO
import Network.TLS.Imports
import Network.TLS.Packet hiding (getExtensions, getSession)
import Network.TLS.Parameters
import Network.TLS.Session
import Network.TLS.State
import Network.TLS.Struct
import Network.TLS.Types
import Network.TLS.Util (catchException)
import Network.TLS.Wire
import Network.TLS.X509 hiding (Certificate)
recvServerFirstFlight12 :: ClientParams -> Context -> [Handshake] -> IO ()
recvServerFirstFlight12 :: ClientParams -> Context -> [Handshake] -> IO ()
recvServerFirstFlight12 ClientParams
cparams Context
ctx [Handshake]
hs = do
resuming <- Context -> TLSSt Bool -> IO Bool
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Bool
getTLS12SessionResuming
if resuming
then recvNSTandCCSandFinished ctx
else do
let st = (Handshake -> IO (RecvState IO)) -> RecvState IO
forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
RecvStateHandshake (ClientParams -> Context -> Handshake -> IO (RecvState IO)
expectCertificate ClientParams
cparams Context
ctx)
runRecvStateHS ctx st hs
expectCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO)
expectCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO)
expectCertificate ClientParams
cparams Context
ctx (Certificate (TLSCertificateChain CertificateChain
certs)) = 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
$ CertificateChain -> TLSSt ()
setServerCertificateChain CertificateChain
certs
ClientParams -> Context -> CertificateChain -> IO ()
doCertificate ClientParams
cparams Context
ctx CertificateChain
certs
Context -> Role -> CertificateChain -> IO ()
processCertificate Context
ctx Role
ClientRole CertificateChain
certs
RecvState IO -> IO (RecvState IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecvState IO -> IO (RecvState IO))
-> RecvState IO -> IO (RecvState IO)
forall a b. (a -> b) -> a -> b
$ (Handshake -> IO (RecvState IO)) -> RecvState IO
forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
RecvStateHandshake (Context -> Handshake -> IO (RecvState IO)
expectServerKeyExchange Context
ctx)
expectCertificate ClientParams
_ Context
ctx Handshake
p = Context -> Handshake -> IO (RecvState IO)
expectServerKeyExchange Context
ctx Handshake
p
expectServerKeyExchange :: Context -> Handshake -> IO (RecvState IO)
expectServerKeyExchange :: Context -> Handshake -> IO (RecvState IO)
expectServerKeyExchange Context
ctx (ServerKeyXchg ServerKeyXchgAlgorithmData
origSkx) = do
Context -> ServerKeyXchgAlgorithmData -> IO ()
doServerKeyExchange Context
ctx ServerKeyXchgAlgorithmData
origSkx
RecvState IO -> IO (RecvState IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecvState IO -> IO (RecvState IO))
-> RecvState IO -> IO (RecvState IO)
forall a b. (a -> b) -> a -> b
$ (Handshake -> IO (RecvState IO)) -> RecvState IO
forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
RecvStateHandshake (Context -> Handshake -> IO (RecvState IO)
expectCertificateRequest Context
ctx)
expectServerKeyExchange Context
ctx Handshake
p = Context -> Handshake -> IO (RecvState IO)
expectCertificateRequest Context
ctx Handshake
p
expectCertificateRequest :: Context -> Handshake -> IO (RecvState IO)
expectCertificateRequest :: Context -> Handshake -> IO (RecvState IO)
expectCertificateRequest Context
ctx (CertRequest [CertificateType]
cTypesSent [HashAndSignatureAlgorithm]
sigAlgs [DistinguishedName]
dNames) = do
let cTypes :: [CertificateType]
cTypes = (CertificateType -> Bool) -> [CertificateType] -> [CertificateType]
forall a. (a -> Bool) -> [a] -> [a]
filter (CertificateType -> CertificateType -> Bool
forall a. Ord a => a -> a -> Bool
<= CertificateType
lastSupportedCertificateType) [CertificateType]
cTypesSent
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
$ Maybe CertReqCBdata -> HandshakeM ()
setCertReqCBdata (Maybe CertReqCBdata -> HandshakeM ())
-> Maybe CertReqCBdata -> HandshakeM ()
forall a b. (a -> b) -> a -> b
$ CertReqCBdata -> Maybe CertReqCBdata
forall a. a -> Maybe a
Just ([CertificateType]
cTypes, [HashAndSignatureAlgorithm] -> Maybe [HashAndSignatureAlgorithm]
forall a. a -> Maybe a
Just [HashAndSignatureAlgorithm]
sigAlgs, [DistinguishedName]
dNames)
RecvState IO -> IO (RecvState IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecvState IO -> IO (RecvState IO))
-> RecvState IO -> IO (RecvState IO)
forall a b. (a -> b) -> a -> b
$ (Handshake -> IO (RecvState IO)) -> RecvState IO
forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
RecvStateHandshake (Context -> Handshake -> IO (RecvState IO)
forall (m :: * -> *). Context -> Handshake -> IO (RecvState m)
expectServerHelloDone Context
ctx)
expectCertificateRequest Context
ctx Handshake
p = 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
$ Maybe CertReqCBdata -> HandshakeM ()
setCertReqCBdata Maybe CertReqCBdata
forall a. Maybe a
Nothing
Context -> Handshake -> IO (RecvState IO)
forall (m :: * -> *). Context -> Handshake -> IO (RecvState m)
expectServerHelloDone Context
ctx Handshake
p
expectServerHelloDone :: Context -> Handshake -> IO (RecvState m)
expectServerHelloDone :: forall (m :: * -> *). Context -> Handshake -> IO (RecvState m)
expectServerHelloDone Context
_ Handshake
ServerHelloDone = RecvState m -> IO (RecvState m)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecvState m
forall (m :: * -> *). RecvState m
RecvStateDone
expectServerHelloDone Context
_ Handshake
p = [Char] -> Maybe [Char] -> IO (RecvState m)
forall (m :: * -> *) a. MonadIO m => [Char] -> Maybe [Char] -> m a
unexpected (Handshake -> [Char]
forall a. Show a => a -> [Char]
show Handshake
p) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"server hello data")
sendClientSecondFlight12 :: ClientParams -> Context -> IO ()
sendClientSecondFlight12 :: ClientParams -> Context -> IO ()
sendClientSecondFlight12 ClientParams
cparams Context
ctx = do
sessionResuming <- Context -> TLSSt Bool -> IO Bool
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Bool
getTLS12SessionResuming
if sessionResuming
then sendCCSandFinished ctx ClientRole
else do
sendClientCCC cparams ctx
sendCCSandFinished ctx ClientRole
recvServerSecondFlight12 :: ClientParams -> Context -> IO ()
recvServerSecondFlight12 :: ClientParams -> Context -> IO ()
recvServerSecondFlight12 ClientParams
cparams Context
ctx = do
sessionResuming <- Context -> TLSSt Bool -> IO Bool
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Bool
getTLS12SessionResuming
unless sessionResuming $ recvNSTandCCSandFinished ctx
mticket <- usingState_ ctx getTLS12SessionTicket
session <- usingState_ ctx getSession
let midentity = Maybe Ticket -> Session -> Maybe Ticket
ticketOrSessionID12 Maybe Ticket
mticket Session
session
case midentity of
Maybe Ticket
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Ticket
identity -> do
sessionData <- Context -> IO (Maybe SessionData)
getSessionData Context
ctx
void $
sessionEstablish
(sharedSessionManager $ ctxShared ctx)
identity
(fromJust sessionData)
handshakeDone12 ctx
liftIO $ do
minfo <- contextGetInformation ctx
case minfo of
Maybe Information
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Information
info -> ClientHooks -> Information -> IO ()
onServerFinished (ClientParams -> ClientHooks
clientHooks ClientParams
cparams) Information
info
recvNSTandCCSandFinished :: Context -> IO ()
recvNSTandCCSandFinished :: Context -> IO ()
recvNSTandCCSandFinished Context
ctx = do
st <- Maybe Ticket -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Ticket -> Bool) -> IO (Maybe Ticket) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> TLSSt (Maybe Ticket) -> IO (Maybe Ticket)
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt (Maybe Ticket)
getTLS12SessionTicket
if st
then runRecvState ctx $ RecvStateHandshake expectNewSessionTicket
else do runRecvState ctx $ RecvStatePacket expectChangeCipher
where
expectNewSessionTicket :: Handshake -> IO (RecvState IO)
expectNewSessionTicket (NewSessionTicket Second
_ Ticket
ticket) = 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
$ Ticket -> TLSSt ()
setTLS12SessionTicket Ticket
ticket
RecvState IO -> IO (RecvState IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecvState IO -> IO (RecvState IO))
-> RecvState IO -> IO (RecvState IO)
forall a b. (a -> b) -> a -> b
$ (Packet -> IO (RecvState IO)) -> RecvState IO
forall (m :: * -> *). (Packet -> m (RecvState m)) -> RecvState m
RecvStatePacket Packet -> IO (RecvState IO)
forall {m :: * -> *}. MonadIO m => Packet -> m (RecvState IO)
expectChangeCipher
expectNewSessionTicket Handshake
p = [Char] -> Maybe [Char] -> IO (RecvState IO)
forall (m :: * -> *) a. MonadIO m => [Char] -> Maybe [Char] -> m a
unexpected (Handshake -> [Char]
forall a. Show a => a -> [Char]
show Handshake
p) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"Handshake Finished")
expectChangeCipher :: Packet -> m (RecvState IO)
expectChangeCipher Packet
ChangeCipherSpec = do
RecvState IO -> m (RecvState IO)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecvState IO -> m (RecvState IO))
-> RecvState IO -> m (RecvState IO)
forall a b. (a -> b) -> a -> b
$ (Handshake -> IO (RecvState IO)) -> RecvState IO
forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
RecvStateHandshake ((Handshake -> IO (RecvState IO)) -> RecvState IO)
-> (Handshake -> IO (RecvState IO)) -> RecvState IO
forall a b. (a -> b) -> a -> b
$ Context -> Handshake -> IO (RecvState IO)
expectFinished Context
ctx
expectChangeCipher Packet
p = [Char] -> Maybe [Char] -> m (RecvState IO)
forall (m :: * -> *) a. MonadIO m => [Char] -> Maybe [Char] -> m a
unexpected (Packet -> [Char]
forall a. Show a => a -> [Char]
show Packet
p) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"change cipher")
sendClientCCC :: ClientParams -> Context -> IO ()
sendClientCCC :: ClientParams -> Context -> IO ()
sendClientCCC ClientParams
cparams Context
ctx = do
ClientParams -> Context -> IO ()
sendCertificate ClientParams
cparams Context
ctx
ClientParams -> Context -> IO ()
sendClientKeyXchg ClientParams
cparams Context
ctx
Context -> IO ()
sendCertificateVerify Context
ctx
sendCertificate :: ClientParams -> Context -> IO ()
sendCertificate :: ClientParams -> Context -> IO ()
sendCertificate ClientParams
cparams Context
ctx = 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
$ Bool -> HandshakeM ()
setClientCertSent Bool
False
ClientParams -> Context -> IO (Maybe CertificateChain)
clientChain ClientParams
cparams Context
ctx IO (Maybe CertificateChain)
-> (Maybe CertificateChain -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe CertificateChain
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just cc :: CertificateChain
cc@(CertificateChain [SignedExact Certificate]
certs) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SignedExact Certificate] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignedExact Certificate]
certs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
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 ()
setClientCertSent Bool
True
Context -> Packet -> IO ()
sendPacket12 Context
ctx (Packet -> IO ()) -> Packet -> IO ()
forall a b. (a -> b) -> a -> b
$ [Handshake] -> Packet
Handshake [TLSCertificateChain -> Handshake
Certificate (CertificateChain -> TLSCertificateChain
TLSCertificateChain CertificateChain
cc)]
sendClientKeyXchg :: ClientParams -> Context -> IO ()
sendClientKeyXchg :: ClientParams -> Context -> IO ()
sendClientKeyXchg ClientParams
cparams Context
ctx = do
cipher <- Context -> HandshakeM Cipher -> IO Cipher
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx HandshakeM Cipher
getPendingCipher
(ckx, setMainSec) <- case cipherKeyExchange cipher of
CipherKeyExchangeType
CipherKeyExchange_RSA -> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
getCKX_RSA Context
ctx
CipherKeyExchangeType
CipherKeyExchange_DHE_RSA -> ClientParams
-> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
getCKX_DHE ClientParams
cparams Context
ctx
CipherKeyExchangeType
CipherKeyExchange_DHE_DSA -> ClientParams
-> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
getCKX_DHE ClientParams
cparams Context
ctx
CipherKeyExchangeType
CipherKeyExchange_ECDHE_RSA -> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
getCKX_ECDHE Context
ctx
CipherKeyExchangeType
CipherKeyExchange_ECDHE_ECDSA -> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
getCKX_ECDHE Context
ctx
CipherKeyExchangeType
_ ->
TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket))
-> TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
forall a b. (a -> b) -> a -> b
$
[Char] -> AlertDescription -> TLSError
Error_Protocol [Char]
"client key exchange unsupported type" AlertDescription
HandshakeFailure
sendPacket12 ctx $ Handshake [ClientKeyXchg ckx]
mainSecret <- usingHState ctx setMainSec
logKey ctx (MainSecret mainSecret)
getCKX_RSA
:: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
getCKX_RSA :: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
getCKX_RSA Context
ctx = do
clientVersion <- Context -> HandshakeM Version -> IO Version
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (HandshakeM Version -> IO Version)
-> HandshakeM Version -> IO Version
forall a b. (a -> b) -> a -> b
$ (HandshakeState -> Version) -> HandshakeM Version
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Version
hstClientVersion
(xver, prerand) <- usingState_ ctx $ (,) <$> getVersion <*> genRandom 46
let preMain = Version -> Ticket -> Ticket
encodePreMainSecret Version
clientVersion Ticket
prerand
setMainSec = Version -> Role -> Ticket -> HandshakeM Ticket
forall preMain.
ByteArrayAccess preMain =>
Version -> Role -> preMain -> HandshakeM Ticket
setMainSecretFromPre Version
xver Role
ClientRole Ticket
preMain
encryptedPreMain <- do
e <- encryptRSA ctx preMain
let extra = Word16 -> Ticket
encodeWord16 (Word16 -> Ticket) -> Word16 -> Ticket
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Ticket -> Int
B.length Ticket
e
return $ extra `B.append` e
return (CKX_RSA encryptedPreMain, setMainSec)
getCKX_DHE
:: ClientParams
-> Context
-> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
getCKX_DHE :: ClientParams
-> Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
getCKX_DHE ClientParams
cparams Context
ctx = do
xver <- Context -> TLSSt Version -> IO Version
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Version
getVersion
serverParams <- usingHState ctx getServerDHParams
let params = ServerDHParams -> DHParams
serverDHParamsToParams ServerDHParams
serverParams
ffGroup = DHParams -> Maybe Group
findFiniteFieldGroup DHParams
params
srvpub = ServerDHParams -> DHPublic
serverDHParamsToPublic ServerDHParams
serverParams
unless (maybe False (isSupportedGroup ctx) ffGroup) $ do
groupUsage <-
onCustomFFDHEGroup (clientHooks cparams) params srvpub
`catchException` throwMiscErrorOnException "custom group callback failed"
case groupUsage of
GroupUsage
GroupUsageInsecure ->
TLSError -> IO ()
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO ()) -> TLSError -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> AlertDescription -> TLSError
Error_Protocol [Char]
"FFDHE group is not secure enough" AlertDescription
InsufficientSecurity
GroupUsageUnsupported [Char]
reason ->
TLSError -> IO ()
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO ()) -> TLSError -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> AlertDescription -> TLSError
Error_Protocol ([Char]
"unsupported FFDHE group: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
reason) AlertDescription
HandshakeFailure
GroupUsage
GroupUsageInvalidPublic -> TLSError -> IO ()
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO ()) -> TLSError -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> AlertDescription -> TLSError
Error_Protocol [Char]
"invalid server public key" AlertDescription
IllegalParameter
GroupUsage
GroupUsageValid -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(clientDHPub, preMain) <-
case ffGroup of
Maybe Group
Nothing -> do
(clientDHPriv, clientDHPub) <- Context -> DHParams -> IO (DHPrivate, DHPublic)
generateDHE Context
ctx DHParams
params
let preMain = DHParams -> DHPrivate -> DHPublic -> DHKey
dhGetShared DHParams
params DHPrivate
clientDHPriv DHPublic
srvpub
return (clientDHPub, preMain)
Just 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
dhePair <- Context -> Group -> DHPublic -> IO (Maybe (DHPublic, DHKey))
generateFFDHEShared Context
ctx Group
grp DHPublic
srvpub
case dhePair of
Maybe (DHPublic, DHKey)
Nothing ->
TLSError -> IO (DHPublic, DHKey)
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO (DHPublic, DHKey))
-> TLSError -> IO (DHPublic, DHKey)
forall a b. (a -> b) -> a -> b
$
[Char] -> AlertDescription -> TLSError
Error_Protocol ([Char]
"invalid server " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Group -> [Char]
forall a. Show a => a -> [Char]
show Group
grp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" public key") AlertDescription
IllegalParameter
Just (DHPublic, DHKey)
pair -> (DHPublic, DHKey) -> IO (DHPublic, DHKey)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DHPublic, DHKey)
pair
let setMainSec = Version -> Role -> DHKey -> HandshakeM Ticket
forall preMain.
ByteArrayAccess preMain =>
Version -> Role -> preMain -> HandshakeM Ticket
setMainSecretFromPre Version
xver Role
ClientRole DHKey
preMain
return (CKX_DH clientDHPub, setMainSec)
getCKX_ECDHE
:: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM ByteString)
getCKX_ECDHE :: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
getCKX_ECDHE Context
ctx = do
ServerECDHParams grp srvpub <- Context -> HandshakeM ServerECDHParams -> IO ServerECDHParams
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx HandshakeM ServerECDHParams
getServerECDHParams
checkSupportedGroup ctx grp
usingHState ctx $ setSupportedGroup grp
ecdhePair <- generateECDHEShared ctx srvpub
case ecdhePair of
Maybe (GroupPublic, GroupKey)
Nothing ->
TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket))
-> TLSError -> IO (ClientKeyXchgAlgorithmData, HandshakeM Ticket)
forall a b. (a -> b) -> a -> b
$
[Char] -> AlertDescription -> TLSError
Error_Protocol ([Char]
"invalid server " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Group -> [Char]
forall a. Show a => a -> [Char]
show Group
grp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" public key") AlertDescription
IllegalParameter
Just (GroupPublic
clipub, GroupKey
preMain) -> do
xver <- Context -> TLSSt Version -> IO Version
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Version
getVersion
let setMainSec = Version -> Role -> GroupKey -> HandshakeM Ticket
forall preMain.
ByteArrayAccess preMain =>
Version -> Role -> preMain -> HandshakeM Ticket
setMainSecretFromPre Version
xver Role
ClientRole GroupKey
preMain
return (CKX_ECDH $ encodeGroupPublic clipub, setMainSec)
sendCertificateVerify :: Context -> IO ()
sendCertificateVerify :: Context -> IO ()
sendCertificateVerify Context
ctx = do
ver <- Context -> TLSSt Version -> IO Version
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Version
getVersion
certSent <- usingHState ctx getClientCertSent
when certSent $ do
pubKey <- getLocalPublicKey ctx
mhashSig <-
let cHashSigs = Supported -> [HashAndSignatureAlgorithm]
supportedHashSignatures (Supported -> [HashAndSignatureAlgorithm])
-> Supported -> [HashAndSignatureAlgorithm]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx
in getLocalHashSigAlg ctx signatureCompatible cHashSigs pubKey
msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
sigDig <- createCertificateVerify ctx ver pubKey mhashSig msgs
sendPacket12 ctx $ Handshake [CertVerify sigDig]