{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.QUIC.TLS (
    clientHandshaker
  , serverHandshaker
  ) where

import Data.Default.Class
import Network.TLS hiding (Version)
import Network.TLS.QUIC

import Network.QUIC.Config
import Network.QUIC.Parameters
import Network.QUIC.Types

sessionManager :: SessionEstablish -> SessionManager
sessionManager :: SessionEstablish -> SessionManager
sessionManager SessionEstablish
establish = SessionManager :: (SessionID -> IO (Maybe SessionData))
-> (SessionID -> IO (Maybe SessionData))
-> SessionEstablish
-> (SessionID -> IO ())
-> SessionManager
SessionManager {
    sessionEstablish :: SessionEstablish
sessionEstablish      = SessionEstablish
establish
  , sessionResume :: SessionID -> IO (Maybe SessionData)
sessionResume         = \SessionID
_ -> Maybe SessionData -> IO (Maybe SessionData)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
forall a. Maybe a
Nothing
  , sessionResumeOnlyOnce :: SessionID -> IO (Maybe SessionData)
sessionResumeOnlyOnce = \SessionID
_ -> Maybe SessionData -> IO (Maybe SessionData)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionData
forall a. Maybe a
Nothing
  , sessionInvalidate :: SessionID -> IO ()
sessionInvalidate     = \SessionID
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  }

clientHandshaker :: QUICCallbacks
                 -> ClientConfig
                 -> Version
                 -> AuthCIDs
                 -> SessionEstablish
                 -> Bool
                 -> IO ()
clientHandshaker :: QUICCallbacks
-> ClientConfig
-> Version
-> AuthCIDs
-> SessionEstablish
-> Bool
-> IO ()
clientHandshaker QUICCallbacks
callbacks ClientConfig{Bool
ServiceName
[Cipher]
[Group]
[Version]
Maybe Int
Maybe ServiceName
Credentials
ResumptionInfo
Parameters
Hooks
ServiceName -> IO ()
Version -> IO (Maybe [SessionID])
ccAutoMigration :: ClientConfig -> Bool
ccDebugLog :: ClientConfig -> Bool
ccPacketSize :: ClientConfig -> Maybe Int
ccResumption :: ClientConfig -> ResumptionInfo
ccValidate :: ClientConfig -> Bool
ccALPN :: ClientConfig -> Version -> IO (Maybe [SessionID])
ccPortName :: ClientConfig -> ServiceName
ccServerName :: ClientConfig -> ServiceName
ccUse0RTT :: ClientConfig -> Bool
ccHooks :: ClientConfig -> Hooks
ccCredentials :: ClientConfig -> Credentials
ccQLog :: ClientConfig -> Maybe ServiceName
ccKeyLog :: ClientConfig -> ServiceName -> IO ()
ccParameters :: ClientConfig -> Parameters
ccGroups :: ClientConfig -> [Group]
ccCiphers :: ClientConfig -> [Cipher]
ccVersions :: ClientConfig -> [Version]
ccAutoMigration :: Bool
ccDebugLog :: Bool
ccPacketSize :: Maybe Int
ccResumption :: ResumptionInfo
ccValidate :: Bool
ccALPN :: Version -> IO (Maybe [SessionID])
ccPortName :: ServiceName
ccServerName :: ServiceName
ccUse0RTT :: Bool
ccHooks :: Hooks
ccCredentials :: Credentials
ccQLog :: Maybe ServiceName
ccKeyLog :: ServiceName -> IO ()
ccParameters :: Parameters
ccGroups :: [Group]
ccCiphers :: [Cipher]
ccVersions :: [Version]
..} Version
ver AuthCIDs
myAuthCIDs SessionEstablish
establish Bool
use0RTT =
    ClientParams -> QUICCallbacks -> IO ()
tlsQUICClient ClientParams
cparams QUICCallbacks
callbacks
  where
    cparams :: ClientParams
cparams = (ServiceName -> SessionID -> ClientParams
defaultParamsClient ServiceName
ccServerName SessionID
"") {
        clientShared :: Shared
clientShared            = Shared
cshared
      , clientHooks :: ClientHooks
clientHooks             = ClientHooks
hook
      , clientSupported :: Supported
clientSupported         = Supported
supported
      , clientDebug :: DebugParams
clientDebug             = DebugParams
debug
      , clientWantSessionResume :: Maybe (SessionID, SessionData)
clientWantSessionResume = ResumptionInfo -> Maybe (SessionID, SessionData)
resumptionSession ResumptionInfo
ccResumption
      , clientEarlyData :: Maybe SessionID
clientEarlyData         = if Bool
use0RTT then SessionID -> Maybe SessionID
forall a. a -> Maybe a
Just SessionID
"" else Maybe SessionID
forall a. Maybe a
Nothing
      }
    convTP :: Parameters -> Parameters
convTP = Hooks -> Parameters -> Parameters
onTransportParametersCreated Hooks
ccHooks
    convExt :: [ExtensionRaw] -> [ExtensionRaw]
convExt = Hooks -> [ExtensionRaw] -> [ExtensionRaw]
onTLSExtensionCreated Hooks
ccHooks
    qparams :: Parameters
qparams = Parameters -> Parameters
convTP (Parameters -> Parameters) -> Parameters -> Parameters
forall a b. (a -> b) -> a -> b
$ AuthCIDs -> Parameters -> Parameters
setCIDsToParameters AuthCIDs
myAuthCIDs Parameters
ccParameters
    eQparams :: SessionID
eQparams = Parameters -> SessionID
encodeParameters Parameters
qparams
    tpId :: ExtensionID
tpId | Version
ver Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
Version1 = ExtensionID
extensionID_QuicTransportParameters
         | Bool
otherwise       = ExtensionID
0xffa5
    cshared :: Shared
cshared = Shared
forall a. Default a => a
def {
        sharedValidationCache :: ValidationCache
sharedValidationCache = if Bool
ccValidate then
                                  ValidationCache
forall a. Default a => a
def
                                else
                                  ValidationCacheQueryCallback
-> ValidationCacheAddCallback -> ValidationCache
ValidationCache (\ServiceID
_ Fingerprint
_ Certificate
_ -> ValidationCacheResult -> IO ValidationCacheResult
forall (m :: * -> *) a. Monad m => a -> m a
return ValidationCacheResult
ValidationCachePass) (\ServiceID
_ Fingerprint
_ Certificate
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      , sharedHelloExtensions :: [ExtensionRaw]
sharedHelloExtensions = [ExtensionRaw] -> [ExtensionRaw]
convExt [ExtensionID -> SessionID -> ExtensionRaw
ExtensionRaw ExtensionID
tpId SessionID
eQparams]
      , sharedSessionManager :: SessionManager
sharedSessionManager = SessionEstablish -> SessionManager
sessionManager SessionEstablish
establish
      }
    hook :: ClientHooks
hook = ClientHooks
forall a. Default a => a
def {
        onSuggestALPN :: IO (Maybe [SessionID])
onSuggestALPN = Version -> IO (Maybe [SessionID])
ccALPN Version
ver
      }
    supported :: Supported
supported = Supported
defaultSupported {
        supportedCiphers :: [Cipher]
supportedCiphers  = [Cipher]
ccCiphers
      , supportedGroups :: [Group]
supportedGroups   = [Group]
ccGroups
      }
    debug :: DebugParams
debug = DebugParams
forall a. Default a => a
def {
        debugKeyLogger :: ServiceName -> IO ()
debugKeyLogger = ServiceName -> IO ()
ccKeyLog
      }

serverHandshaker :: QUICCallbacks
                 -> ServerConfig
                 -> Version
                 -> AuthCIDs
                 -> IO ()
serverHandshaker :: QUICCallbacks -> ServerConfig -> Version -> AuthCIDs -> IO ()
serverHandshaker QUICCallbacks
callbacks ServerConfig{Bool
[(IP, PortNumber)]
[Cipher]
[Group]
[Version]
Maybe ServiceName
Maybe (Version -> [SessionID] -> IO SessionID)
Credentials
SessionManager
Parameters
Hooks
ServiceName -> IO ()
scDebugLog :: ServerConfig -> Maybe ServiceName
scSessionManager :: ServerConfig -> SessionManager
scRequireRetry :: ServerConfig -> Bool
scALPN :: ServerConfig -> Maybe (Version -> [SessionID] -> IO SessionID)
scAddresses :: ServerConfig -> [(IP, PortNumber)]
scUse0RTT :: ServerConfig -> Bool
scHooks :: ServerConfig -> Hooks
scCredentials :: ServerConfig -> Credentials
scQLog :: ServerConfig -> Maybe ServiceName
scKeyLog :: ServerConfig -> ServiceName -> IO ()
scParameters :: ServerConfig -> Parameters
scGroups :: ServerConfig -> [Group]
scCiphers :: ServerConfig -> [Cipher]
scVersions :: ServerConfig -> [Version]
scDebugLog :: Maybe ServiceName
scSessionManager :: SessionManager
scRequireRetry :: Bool
scALPN :: Maybe (Version -> [SessionID] -> IO SessionID)
scAddresses :: [(IP, PortNumber)]
scUse0RTT :: Bool
scHooks :: Hooks
scCredentials :: Credentials
scQLog :: Maybe ServiceName
scKeyLog :: ServiceName -> IO ()
scParameters :: Parameters
scGroups :: [Group]
scCiphers :: [Cipher]
scVersions :: [Version]
..} Version
ver AuthCIDs
myAuthCIDs =
    ServerParams -> QUICCallbacks -> IO ()
tlsQUICServer ServerParams
sparams QUICCallbacks
callbacks
  where
    sparams :: ServerParams
sparams = ServerParams
forall a. Default a => a
def {
        serverShared :: Shared
serverShared    = Shared
sshared
      , serverHooks :: ServerHooks
serverHooks     = ServerHooks
hook
      , serverSupported :: Supported
serverSupported = Supported
supported
      , serverDebug :: DebugParams
serverDebug     = DebugParams
debug
      , serverEarlyDataSize :: Int
serverEarlyDataSize = if Bool
scUse0RTT then Int
quicMaxEarlyDataSize else Int
0
      }
    convTP :: Parameters -> Parameters
convTP = Hooks -> Parameters -> Parameters
onTransportParametersCreated Hooks
scHooks
    convExt :: [ExtensionRaw] -> [ExtensionRaw]
convExt = Hooks -> [ExtensionRaw] -> [ExtensionRaw]
onTLSExtensionCreated Hooks
scHooks
    qparams :: Parameters
qparams = Parameters -> Parameters
convTP (Parameters -> Parameters) -> Parameters -> Parameters
forall a b. (a -> b) -> a -> b
$ AuthCIDs -> Parameters -> Parameters
setCIDsToParameters AuthCIDs
myAuthCIDs Parameters
scParameters
    eQparams :: SessionID
eQparams = Parameters -> SessionID
encodeParameters Parameters
qparams
    tpId :: ExtensionID
tpId | Version
ver Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
Version1 = ExtensionID
extensionID_QuicTransportParameters
         | Bool
otherwise       = ExtensionID
0xffa5
    sshared :: Shared
sshared = Shared
forall a. Default a => a
def {
            sharedCredentials :: Credentials
sharedCredentials     = Credentials
scCredentials
          , sharedHelloExtensions :: [ExtensionRaw]
sharedHelloExtensions = [ExtensionRaw] -> [ExtensionRaw]
convExt [ExtensionID -> SessionID -> ExtensionRaw
ExtensionRaw ExtensionID
tpId SessionID
eQparams]
          , sharedSessionManager :: SessionManager
sharedSessionManager  = SessionManager
scSessionManager
          }
    hook :: ServerHooks
hook = ServerHooks
forall a. Default a => a
def {
        onALPNClientSuggest :: Maybe ([SessionID] -> IO SessionID)
onALPNClientSuggest = case Maybe (Version -> [SessionID] -> IO SessionID)
scALPN of
          Maybe (Version -> [SessionID] -> IO SessionID)
Nothing -> Maybe ([SessionID] -> IO SessionID)
forall a. Maybe a
Nothing
          Just Version -> [SessionID] -> IO SessionID
io -> ([SessionID] -> IO SessionID)
-> Maybe ([SessionID] -> IO SessionID)
forall a. a -> Maybe a
Just (([SessionID] -> IO SessionID)
 -> Maybe ([SessionID] -> IO SessionID))
-> ([SessionID] -> IO SessionID)
-> Maybe ([SessionID] -> IO SessionID)
forall a b. (a -> b) -> a -> b
$ Version -> [SessionID] -> IO SessionID
io Version
ver
      }
    supported :: Supported
supported = Supported
forall a. Default a => a
def {
        supportedVersions :: [Version]
supportedVersions = [Version
TLS13]
      , supportedCiphers :: [Cipher]
supportedCiphers  = [Cipher]
scCiphers
      , supportedGroups :: [Group]
supportedGroups   = [Group]
scGroups
      }
    debug :: DebugParams
debug = DebugParams
forall a. Default a => a
def {
        debugKeyLogger :: ServiceName -> IO ()
debugKeyLogger = ServiceName -> IO ()
scKeyLog
      }