{-# LANGUAGE OverloadedStrings #-} module Network.TLS.Handshake.Server ( handshakeServer, handshakeServerWith, requestCertificateServer, keyUpdate, updateKey, KeyUpdateRequest (..), ) where import Control.Monad.State.Strict import Data.Maybe import Network.TLS.Context.Internal import Network.TLS.Handshake.Common import Network.TLS.Handshake.Server.ClientHello import Network.TLS.Handshake.Server.ClientHello12 import Network.TLS.Handshake.Server.ClientHello13 import Network.TLS.Handshake.Server.ServerHello12 import Network.TLS.Handshake.Server.ServerHello13 import Network.TLS.Handshake.Server.TLS12 import Network.TLS.Handshake.Server.TLS13 import Network.TLS.Struct -- Put the server context in handshake mode. -- -- Expect to receive as first packet a client hello handshake message -- -- This is just a helper to pop the next message from the recv layer, -- and call handshakeServerWith. handshakeServer :: ServerParams -> Context -> IO () handshakeServer sparams ctx = liftIO $ do hss <- recvPacketHandshake ctx case hss of [ch] -> handshake sparams ctx ch _ -> unexpected (show hss) (Just "client hello") handshakeServerWith :: ServerParams -> Context -> Handshake -> IO () handshakeServerWith = handshake -- | Put the server context in handshake mode. -- -- Expect a client hello message as parameter. -- This is useful when the client hello has been already poped from the recv layer to inspect the packet. -- -- When the function returns, a new handshake has been succesfully negociated. -- On any error, a HandshakeFailed exception is raised. handshake :: ServerParams -> Context -> Handshake -> IO () handshake sparams ctx (ClientHello ch) = do (chosenVersion, chI, mcrnd) <- processClientHello sparams ctx ch if chosenVersion == TLS13 then do -- fixme: we should check if the client random is the same as -- that in the first client hello in the case of hello retry. (mClientKeyShare, r0, r1) <- processClientHello13 sparams ctx chI case mClientKeyShare of Nothing -> do sendHRR ctx r0 chI $ isJust mcrnd -- Don't reset ctxEstablished since 0-RTT data -- would be comming, which should be ignored. handshakeServer sparams ctx Just cliKeyShare -> do r2 <- sendServerHello13 sparams ctx cliKeyShare r0 r1 chI mcrnd recvClientSecondFlight13 sparams ctx r2 chI else do r <- processClientHello12 sparams ctx chI resumeSessionData <- sendServerHello12 sparams ctx r chI recvClientSecondFlight12 sparams ctx resumeSessionData handshake _ _ _ = throwCore $ Error_Protocol "client Hello is expected" HandshakeFailure