{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.TLS.Handshake.Common
( handshakeFailed
, handleException
, unexpected
, newSession
, handshakeTerminate
, sendChangeCipherAndFinish
, recvChangeCipherAndFinish
, RecvState(..)
, runRecvState
, recvPacketHandshake
, onRecvStateHandshake
, ensureRecvComplete
, processExtendedMasterSec
, extensionLookup
, getSessionData
, storePrivInfo
, isSupportedGroup
, checkSupportedGroup
, errorToAlert
, errorToAlertMessage
) where
import qualified Data.ByteString as B
import Control.Concurrent.MVar
import Network.TLS.Parameters
import Network.TLS.Compression
import Network.TLS.Context.Internal
import Network.TLS.Extension
import Network.TLS.Session
import Network.TLS.Struct
import Network.TLS.Struct13
import Network.TLS.IO
import Network.TLS.State
import Network.TLS.Handshake.Key
import Network.TLS.Handshake.Process
import Network.TLS.Handshake.State
import Network.TLS.Record.State
import Network.TLS.Measurement
import Network.TLS.Types
import Network.TLS.Cipher
import Network.TLS.Crypto
import Network.TLS.Util
import Network.TLS.X509
import Network.TLS.Imports
import Control.Monad.State.Strict
import Control.Exception (IOException, handle, fromException, throwIO)
import Data.IORef (writeIORef)
handshakeFailed :: TLSError -> IO ()
handshakeFailed :: TLSError -> IO ()
handshakeFailed TLSError
err = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ TLSError -> TLSException
HandshakeFailed TLSError
err
handleException :: Context -> IO () -> IO ()
handleException :: Context -> IO () -> IO ()
handleException Context
ctx IO ()
f = forall a. IO a -> (SomeException -> IO a) -> IO a
catchException IO ()
f forall a b. (a -> b) -> a -> b
$ \SomeException
exception -> do
let tlserror :: TLSError
tlserror = forall a. a -> Maybe a -> a
fromMaybe (String -> TLSError
Error_Misc forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show SomeException
exception) forall a b. (a -> b) -> a -> b
$ forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exception
Context -> Established -> IO ()
setEstablished Context
ctx Established
NotEstablished
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle IOException -> IO ()
ignoreIOErr forall a b. (a -> b) -> a -> b
$ do
Bool
tls13 <- forall (m :: * -> *). MonadIO m => Context -> m Bool
tls13orLater Context
ctx
if Bool
tls13 then
Context -> Packet13 -> IO ()
sendPacket13 Context
ctx forall a b. (a -> b) -> a -> b
$ [(AlertLevel, AlertDescription)] -> Packet13
Alert13 [TLSError -> (AlertLevel, AlertDescription)
errorToAlert TLSError
tlserror]
else
Context -> Packet -> IO ()
sendPacket Context
ctx forall a b. (a -> b) -> a -> b
$ [(AlertLevel, AlertDescription)] -> Packet
Alert [TLSError -> (AlertLevel, AlertDescription)
errorToAlert TLSError
tlserror]
TLSError -> IO ()
handshakeFailed TLSError
tlserror
where
ignoreIOErr :: IOException -> IO ()
ignoreIOErr :: IOException -> IO ()
ignoreIOErr IOException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
errorToAlert :: TLSError -> (AlertLevel, AlertDescription)
errorToAlert :: TLSError -> (AlertLevel, AlertDescription)
errorToAlert (Error_Protocol (String
_, Bool
b, AlertDescription
ad)) = let lvl :: AlertLevel
lvl = if Bool
b then AlertLevel
AlertLevel_Fatal else AlertLevel
AlertLevel_Warning
in (AlertLevel
lvl, AlertDescription
ad)
errorToAlert (Error_Packet_unexpected String
_ String
_) = (AlertLevel
AlertLevel_Fatal, AlertDescription
UnexpectedMessage)
errorToAlert (Error_Packet_Parsing String
msg)
| String
"invalid version" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
msg = (AlertLevel
AlertLevel_Fatal, AlertDescription
ProtocolVersion)
| String
"request_update" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
msg = (AlertLevel
AlertLevel_Fatal, AlertDescription
IllegalParameter)
| Bool
otherwise = (AlertLevel
AlertLevel_Fatal, AlertDescription
DecodeError)
errorToAlert TLSError
_ = (AlertLevel
AlertLevel_Fatal, AlertDescription
InternalError)
errorToAlertMessage :: TLSError -> String
errorToAlertMessage :: TLSError -> String
errorToAlertMessage (Error_Protocol (String
msg, Bool
_, AlertDescription
_)) = String
msg
errorToAlertMessage (Error_Packet_unexpected String
msg String
_) = String
msg
errorToAlertMessage (Error_Packet_Parsing String
msg) = String
msg
errorToAlertMessage TLSError
e = forall a. Show a => a -> String
show TLSError
e
unexpected :: MonadIO m => String -> Maybe String -> m a
unexpected :: forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
unexpected String
msg Maybe String
expected = forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore forall a b. (a -> b) -> a -> b
$ String -> String -> TLSError
Error_Packet_unexpected String
msg (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
" expected: " forall a. [a] -> [a] -> [a]
++) Maybe String
expected)
newSession :: Context -> IO Session
newSession :: Context -> IO Session
newSession Context
ctx
| Supported -> Bool
supportedSession forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx = Maybe SessionID -> Session
Session 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
<$> Context -> Int -> IO SessionID
getStateRNG Context
ctx Int
32
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe SessionID -> Session
Session forall a. Maybe a
Nothing
handshakeTerminate :: Context -> IO ()
handshakeTerminate :: Context -> IO ()
handshakeTerminate Context
ctx = do
Session
session <- forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Session
getSession
case Session
session of
Session (Just SessionID
sessionId) -> do
Maybe SessionData
sessionData <- Context -> IO (Maybe SessionData)
getSessionData Context
ctx
let !sessionId' :: SessionID
sessionId' = SessionID -> SessionID
B.copy SessionID
sessionId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ SessionManager -> SessionID -> SessionData -> IO ()
sessionEstablish (Shared -> SessionManager
sharedSessionManager forall a b. (a -> b) -> a -> b
$ Context -> Shared
ctxShared Context
ctx) SessionID
sessionId' (forall a. String -> Maybe a -> a
fromJust String
"session-data" Maybe SessionData
sessionData)
Session
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Context -> MVar (Maybe HandshakeState)
ctxHandshake Context
ctx) forall a b. (a -> b) -> a -> b
$ \ Maybe HandshakeState
mhshake ->
case Maybe HandshakeState
mhshake of
Maybe HandshakeState
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just HandshakeState
hshake ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Version -> ClientRandom -> HandshakeState
newEmptyHandshake (HandshakeState -> Version
hstClientVersion HandshakeState
hshake) (HandshakeState -> ClientRandom
hstClientRandom HandshakeState
hshake))
{ hstServerRandom :: Maybe ServerRandom
hstServerRandom = HandshakeState -> Maybe ServerRandom
hstServerRandom HandshakeState
hshake
, hstMasterSecret :: Maybe SessionID
hstMasterSecret = HandshakeState -> Maybe SessionID
hstMasterSecret HandshakeState
hshake
, hstExtendedMasterSec :: Bool
hstExtendedMasterSec = HandshakeState -> Bool
hstExtendedMasterSec HandshakeState
hshake
, hstNegotiatedGroup :: Maybe Group
hstNegotiatedGroup = HandshakeState -> Maybe Group
hstNegotiatedGroup HandshakeState
hshake
}
Context -> (Measurement -> Measurement) -> IO ()
updateMeasure Context
ctx Measurement -> Measurement
resetBytesCounters
Context -> Established -> IO ()
setEstablished Context
ctx Established
Established
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendChangeCipherAndFinish :: Context
-> Role
-> IO ()
sendChangeCipherAndFinish :: Context -> Role -> IO ()
sendChangeCipherAndFinish Context
ctx Role
role = do
Context -> Packet -> IO ()
sendPacket Context
ctx Packet
ChangeCipherSpec
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Context -> IO ()
contextFlush Context
ctx
SessionID
cf <- forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Version
getVersion forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Version
ver -> forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx forall a b. (a -> b) -> a -> b
$ Version -> Role -> HandshakeM SessionID
getHandshakeDigest Version
ver Role
role
Context -> Packet -> IO ()
sendPacket Context
ctx ([Handshake] -> Packet
Handshake [SessionID -> Handshake
Finished SessionID
cf])
forall a. IORef a -> a -> IO ()
writeIORef (Context -> IORef (Maybe SessionID)
ctxFinished Context
ctx) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SessionID
cf
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Context -> IO ()
contextFlush Context
ctx
recvChangeCipherAndFinish :: Context -> IO ()
recvChangeCipherAndFinish :: Context -> IO ()
recvChangeCipherAndFinish Context
ctx = Context -> RecvState IO -> IO ()
runRecvState Context
ctx (forall (m :: * -> *). (Packet -> m (RecvState m)) -> RecvState m
RecvStateNext forall {m :: * -> *} {m :: * -> *}.
(MonadIO m, MonadIO m) =>
Packet -> m (RecvState m)
expectChangeCipher)
where expectChangeCipher :: Packet -> m (RecvState m)
expectChangeCipher Packet
ChangeCipherSpec = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (Handshake -> m (RecvState m)) -> RecvState m
RecvStateHandshake forall {m :: * -> *} {m :: * -> *}.
MonadIO m =>
Handshake -> m (RecvState m)
expectFinish
expectChangeCipher Packet
p = forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
unexpected (forall a. Show a => a -> String
show Packet
p) (forall a. a -> Maybe a
Just String
"change cipher")
expectFinish :: Handshake -> m (RecvState m)
expectFinish (Finished SessionID
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *). RecvState m
RecvStateDone
expectFinish Handshake
p = forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
unexpected (forall a. Show a => a -> String
show Handshake
p) (forall a. a -> Maybe a
Just String
"Handshake Finished")
data RecvState m =
RecvStateNext (Packet -> m (RecvState m))
| RecvStateHandshake (Handshake -> m (RecvState m))
| RecvStateDone
recvPacketHandshake :: Context -> IO [Handshake]
recvPacketHandshake :: Context -> IO [Handshake]
recvPacketHandshake Context
ctx = do
Either TLSError Packet
pkts <- Context -> IO (Either TLSError Packet)
recvPacket Context
ctx
case Either TLSError Packet
pkts of
Right (Handshake [Handshake]
l) -> forall (m :: * -> *) a. Monad m => a -> m a
return [Handshake]
l
Right x :: Packet
x@(AppData SessionID
_) -> do
Established
established <- Context -> IO Established
ctxEstablished Context
ctx
case Established
established of
EarlyDataNotAllowed Int
n
| Int
n forall a. Ord a => a -> a -> Bool
> Int
0 -> do Context -> Established -> IO ()
setEstablished Context
ctx forall a b. (a -> b) -> a -> b
$ Int -> Established
EarlyDataNotAllowed (Int
n forall a. Num a => a -> a -> a
- Int
1)
Context -> IO [Handshake]
recvPacketHandshake Context
ctx
Established
_ -> forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
unexpected (forall a. Show a => a -> String
show Packet
x) (forall a. a -> Maybe a
Just String
"handshake")
Right Packet
x -> forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
unexpected (forall a. Show a => a -> String
show Packet
x) (forall a. a -> Maybe a
Just String
"handshake")
Left TLSError
err -> forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore TLSError
err
onRecvStateHandshake :: Context -> RecvState IO -> [Handshake] -> IO (RecvState IO)
onRecvStateHandshake :: Context -> RecvState IO -> [Handshake] -> IO (RecvState IO)
onRecvStateHandshake Context
_ RecvState IO
recvState [] = forall (m :: * -> *) a. Monad m => a -> m a
return RecvState IO
recvState
onRecvStateHandshake Context
_ (RecvStateNext Packet -> IO (RecvState IO)
f) [Handshake]
hms = Packet -> IO (RecvState IO)
f ([Handshake] -> Packet
Handshake [Handshake]
hms)
onRecvStateHandshake Context
ctx (RecvStateHandshake Handshake -> IO (RecvState IO)
f) (Handshake
x:[Handshake]
xs) = do
RecvState IO
nstate <- Handshake -> IO (RecvState IO)
f Handshake
x
Context -> Handshake -> IO ()
processHandshake Context
ctx Handshake
x
Context -> RecvState IO -> [Handshake] -> IO (RecvState IO)
onRecvStateHandshake Context
ctx RecvState IO
nstate [Handshake]
xs
onRecvStateHandshake Context
_ RecvState IO
_ [Handshake]
_ = forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
unexpected String
"spurious handshake" forall a. Maybe a
Nothing
runRecvState :: Context -> RecvState IO -> IO ()
runRecvState :: Context -> RecvState IO -> IO ()
runRecvState Context
_ RecvState IO
RecvStateDone = forall (m :: * -> *) a. Monad m => a -> m a
return ()
runRecvState Context
ctx (RecvStateNext Packet -> IO (RecvState IO)
f) = Context -> IO (Either TLSError Packet)
recvPacket Context
ctx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore Packet -> IO (RecvState IO)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> RecvState IO -> IO ()
runRecvState Context
ctx
runRecvState Context
ctx RecvState IO
iniState = Context -> IO [Handshake]
recvPacketHandshake Context
ctx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> RecvState IO -> [Handshake] -> IO (RecvState IO)
onRecvStateHandshake Context
ctx RecvState IO
iniState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> RecvState IO -> IO ()
runRecvState Context
ctx
ensureRecvComplete :: MonadIO m => Context -> m ()
ensureRecvComplete :: forall (m :: * -> *). MonadIO m => Context -> m ()
ensureRecvComplete Context
ctx = do
Bool
complete <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Context -> IO Bool
isRecvComplete Context
ctx
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
complete forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore forall a b. (a -> b) -> a -> b
$ (String, Bool, AlertDescription) -> TLSError
Error_Protocol (String
"received incomplete message at key change", Bool
True, AlertDescription
UnexpectedMessage)
processExtendedMasterSec :: MonadIO m => Context -> Version -> MessageType -> [ExtensionRaw] -> m Bool
processExtendedMasterSec :: forall (m :: * -> *).
MonadIO m =>
Context -> Version -> MessageType -> [ExtensionRaw] -> m Bool
processExtendedMasterSec Context
ctx Version
ver MessageType
msgt [ExtensionRaw]
exts
| Version
ver forall a. Ord a => a -> a -> Bool
< Version
TLS10 = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Version
ver forall a. Ord a => a -> a -> Bool
> Version
TLS12 = forall a. HasCallStack => String -> a
error String
"EMS processing is not compatible with TLS 1.3"
| EMSMode
ems forall a. Eq a => a -> a -> Bool
== EMSMode
NoEMS = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Bool
otherwise =
case ExtensionID -> [ExtensionRaw] -> Maybe SessionID
extensionLookup ExtensionID
extensionID_ExtendedMasterSecret [ExtensionRaw]
exts forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Extension a => MessageType -> SessionID -> Maybe a
extensionDecode MessageType
msgt of
Just ExtendedMasterSecret
ExtendedMasterSecret -> forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (Bool -> HandshakeM ()
setExtendedMasterSec Bool
True) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe ExtendedMasterSecret
Nothing | EMSMode
ems forall a. Eq a => a -> a -> Bool
== EMSMode
RequireEMS -> forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore forall a b. (a -> b) -> a -> b
$ (String, Bool, AlertDescription) -> TLSError
Error_Protocol (String
err, Bool
True, AlertDescription
HandshakeFailure)
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
where ems :: EMSMode
ems = Supported -> EMSMode
supportedExtendedMasterSec (Context -> Supported
ctxSupported Context
ctx)
err :: String
err = String
"peer does not support Extended Master Secret"
getSessionData :: Context -> IO (Maybe SessionData)
getSessionData :: Context -> IO (Maybe SessionData)
getSessionData Context
ctx = do
Version
ver <- forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Version
getVersion
Maybe String
sni <- forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt (Maybe String)
getClientSNI
Maybe SessionID
mms <- forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx (forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe SessionID
hstMasterSecret)
!Bool
ems <- forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx HandshakeM Bool
getExtendedMasterSec
RecordState
tx <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar (Context -> MVar RecordState
ctxTxState Context
ctx)
Maybe SessionID
alpn <- forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt (Maybe SessionID)
getNegotiatedProtocol
let !cipher :: ExtensionID
cipher = Cipher -> ExtensionID
cipherID forall a b. (a -> b) -> a -> b
$ forall a. String -> Maybe a -> a
fromJust String
"cipher" forall a b. (a -> b) -> a -> b
$ RecordState -> Maybe Cipher
stCipher RecordState
tx
!compression :: CompressionID
compression = Compression -> CompressionID
compressionID forall a b. (a -> b) -> a -> b
$ RecordState -> Compression
stCompression RecordState
tx
flags :: [SessionFlag]
flags = [SessionFlag
SessionEMS | Bool
ems]
case Maybe SessionID
mms of
Maybe SessionID
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just SessionID
ms -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SessionData
{ sessionVersion :: Version
sessionVersion = Version
ver
, sessionCipher :: ExtensionID
sessionCipher = ExtensionID
cipher
, sessionCompression :: CompressionID
sessionCompression = CompressionID
compression
, sessionClientSNI :: Maybe String
sessionClientSNI = Maybe String
sni
, sessionSecret :: SessionID
sessionSecret = SessionID
ms
, sessionGroup :: Maybe Group
sessionGroup = forall a. Maybe a
Nothing
, sessionTicketInfo :: Maybe TLS13TicketInfo
sessionTicketInfo = forall a. Maybe a
Nothing
, sessionALPN :: Maybe SessionID
sessionALPN = Maybe SessionID
alpn
, sessionMaxEarlyDataSize :: Int
sessionMaxEarlyDataSize = Int
0
, sessionFlags :: [SessionFlag]
sessionFlags = [SessionFlag]
flags
}
extensionLookup :: ExtensionID -> [ExtensionRaw] -> Maybe ByteString
extensionLookup :: ExtensionID -> [ExtensionRaw] -> Maybe SessionID
extensionLookup ExtensionID
toFind = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ExtensionRaw ExtensionID
_ SessionID
content) -> SessionID
content)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(ExtensionRaw ExtensionID
eid SessionID
_) -> ExtensionID
eid forall a. Eq a => a -> a -> Bool
== ExtensionID
toFind)
storePrivInfo :: MonadIO m
=> Context
-> CertificateChain
-> PrivKey
-> m PubKey
storePrivInfo :: forall (m :: * -> *).
MonadIO m =>
Context -> CertificateChain -> PrivKey -> m PubKey
storePrivInfo Context
ctx CertificateChain
cc PrivKey
privkey = do
let CertificateChain (SignedExact Certificate
c:[SignedExact Certificate]
_) = CertificateChain
cc
pubkey :: PubKey
pubkey = Certificate -> PubKey
certPubKey forall a b. (a -> b) -> a -> b
$ SignedExact Certificate -> Certificate
getCertificate SignedExact Certificate
c
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((PubKey, PrivKey) -> Bool
isDigitalSignaturePair (PubKey
pubkey, PrivKey
privkey)) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore forall a b. (a -> b) -> a -> b
$ (String, Bool, AlertDescription) -> TLSError
Error_Protocol
( String
"mismatched or unsupported private key pair"
, Bool
True
, AlertDescription
InternalError )
forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx forall a b. (a -> b) -> a -> b
$ (PubKey, PrivKey) -> HandshakeM ()
setPublicPrivateKeys (PubKey
pubkey, PrivKey
privkey)
forall (m :: * -> *) a. Monad m => a -> m a
return PubKey
pubkey
checkSupportedGroup :: Context -> Group -> IO ()
checkSupportedGroup :: Context -> Group -> IO ()
checkSupportedGroup Context
ctx Group
grp =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Context -> Group -> Bool
isSupportedGroup Context
ctx Group
grp) forall a b. (a -> b) -> a -> b
$
let msg :: String
msg = String
"unsupported (EC)DHE group: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Group
grp
in forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore forall a b. (a -> b) -> a -> b
$ (String, Bool, AlertDescription) -> TLSError
Error_Protocol (String
msg, Bool
True, AlertDescription
IllegalParameter)
isSupportedGroup :: Context -> Group -> Bool
isSupportedGroup :: Context -> Group -> Bool
isSupportedGroup Context
ctx Group
grp = Group
grp forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Supported -> [Group]
supportedGroups (Context -> Supported
ctxSupported Context
ctx)