-- |
-- Module      : Network.TLS.PostHandshake
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.PostHandshake
    ( requestCertificate
    , requestCertificateServer
    , postHandshakeAuthWith
    , postHandshakeAuthClientWith
    , postHandshakeAuthServerWith
    ) where

import Network.TLS.Context.Internal
import Network.TLS.IO
import Network.TLS.Struct13

import Network.TLS.Handshake.Common
import Network.TLS.Handshake.Client
import Network.TLS.Handshake.Server

import Control.Monad.State.Strict

-- | Post-handshake certificate request with TLS 1.3.  Returns 'True' if the
-- request was possible, i.e. if TLS 1.3 is used and the remote client supports
-- post-handshake authentication.
requestCertificate :: MonadIO m => Context -> m Bool
requestCertificate :: Context -> m Bool
requestCertificate Context
ctx =
    IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Context -> IO Bool -> IO Bool
forall a. Context -> IO a -> IO a
withWriteLock Context
ctx (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
        Context -> IO ()
checkValid Context
ctx IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Context -> Context -> IO Bool
ctxDoRequestCertificate Context
ctx Context
ctx

-- Handle a post-handshake authentication flight with TLS 1.3.  This is called
-- automatically by 'recvData', in a context where the read lock is already
-- taken.
postHandshakeAuthWith :: MonadIO m => Context -> Handshake13 -> m ()
postHandshakeAuthWith :: Context -> Handshake13 -> m ()
postHandshakeAuthWith Context
ctx Handshake13
hs =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> IO () -> IO ()
forall a. Context -> IO a -> IO a
withWriteLock Context
ctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> IO () -> IO ()
handleException Context
ctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> Context -> Handshake13 -> IO ()
ctxDoPostHandshakeAuthWith Context
ctx Context
ctx Handshake13
hs