{-# 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 :: ServerParams -> Context -> IO ()
handshakeServer ServerParams
sparams Context
ctx = IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    hss <- Context -> IO [Handshake]
recvPacketHandshake Context
ctx
    case hss of
        [Handshake
ch] -> ServerParams -> Context -> Handshake -> IO ()
handshake ServerParams
sparams Context
ctx Handshake
ch
        [Handshake]
_ -> String -> Maybe String -> IO ()
forall (m :: * -> *) a. MonadIO m => String -> Maybe String -> m a
unexpected ([Handshake] -> String
forall a. Show a => a -> String
show [Handshake]
hss) (String -> Maybe String
forall a. a -> Maybe a
Just String
"client hello")

handshakeServerWith :: ServerParams -> Context -> Handshake -> IO ()
handshakeServerWith :: ServerParams -> Context -> Handshake -> IO ()
handshakeServerWith = ServerParams -> Context -> Handshake -> IO ()
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 :: ServerParams -> Context -> Handshake -> IO ()
handshake ServerParams
sparams Context
ctx (ClientHello ClientHello
ch) = do
    (chosenVersion, chI, mcrnd) <- ServerParams
-> Context
-> ClientHello
-> IO (Version, ClientHello, Maybe ClientRandom)
processClientHello ServerParams
sparams Context
ctx ClientHello
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
                Maybe KeyShareEntry
Nothing -> do
                    Context -> (Cipher, Hash, Bool) -> ClientHello -> Bool -> IO ()
forall c.
Context -> (Cipher, Hash, c) -> ClientHello -> Bool -> IO ()
sendHRR Context
ctx (Cipher, Hash, Bool)
r0 ClientHello
chI (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe ClientRandom -> Bool
forall a. Maybe a -> Bool
isJust Maybe ClientRandom
mcrnd
                    -- Don't reset ctxEstablished since 0-RTT data
                    -- would be comming, which should be ignored.
                    ServerParams -> Context -> IO ()
handshakeServer ServerParams
sparams Context
ctx
                Just KeyShareEntry
cliKeyShare -> do
                    r2 <-
                        ServerParams
-> Context
-> KeyShareEntry
-> (Cipher, Hash, Bool)
-> (SecretPair EarlySecret, [ExtensionRaw], Bool, Bool)
-> ClientHello
-> Maybe ClientRandom
-> IO
     (SecretTriple ApplicationSecret,
      ClientTrafficSecret HandshakeSecret, Bool, Bool)
sendServerHello13 ServerParams
sparams Context
ctx KeyShareEntry
cliKeyShare (Cipher, Hash, Bool)
r0 (SecretPair EarlySecret, [ExtensionRaw], Bool, Bool)
r1 ClientHello
chI Maybe ClientRandom
mcrnd
                    recvClientSecondFlight13 sparams ctx r2 chI
        else do
            r <-
                processClientHello12 sparams ctx chI
            resumeSessionData <-
                sendServerHello12 sparams ctx r chI
            recvClientSecondFlight12 sparams ctx resumeSessionData
handshake ServerParams
_ Context
_ Handshake
_ = TLSError -> IO ()
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore (TLSError -> IO ()) -> TLSError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> AlertDescription -> TLSError
Error_Protocol String
"client Hello is expected" AlertDescription
HandshakeFailure