{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module Network.QUIC.Config where

import Data.Default.Class
import Data.IP
import Network.Socket
import Network.TLS hiding (Hooks, HostName, Version)
import Network.TLS.QUIC

import Network.QUIC.Imports
import Network.QUIC.Parameters
import Network.QUIC.Stream
import Network.QUIC.Types

----------------------------------------------------------------

-- | Hooks.
data Hooks = Hooks
    { Hooks -> IO ()
onCloseCompleted :: IO ()
    , Hooks -> EncryptionLevel -> Plain -> Plain
onPlainCreated :: EncryptionLevel -> Plain -> Plain
    , Hooks -> Parameters -> Parameters
onTransportParametersCreated :: Parameters -> Parameters
    , Hooks -> [ExtensionRaw] -> [ExtensionRaw]
onTLSExtensionCreated :: [ExtensionRaw] -> [ExtensionRaw]
    , Hooks
-> [(EncryptionLevel, CryptoData)]
-> ([(EncryptionLevel, CryptoData)], Bool)
onTLSHandshakeCreated
        :: [(EncryptionLevel, CryptoData)]
        -> ([(EncryptionLevel, CryptoData)], Bool)
    , Hooks -> Stream -> ApplicationProtocolError -> IO ()
onResetStreamReceived :: Stream -> ApplicationProtocolError -> IO ()
    , Hooks -> IO ()
onServerReady :: IO ()
    }

-- | Default hooks.
defaultHooks :: Hooks
defaultHooks :: Hooks
defaultHooks =
    Hooks
        { onCloseCompleted :: IO ()
onCloseCompleted = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , onPlainCreated :: EncryptionLevel -> Plain -> Plain
onPlainCreated = \EncryptionLevel
_l Plain
p -> Plain
p
        , onTransportParametersCreated :: Parameters -> Parameters
onTransportParametersCreated = Parameters -> Parameters
forall a. a -> a
id
        , onTLSExtensionCreated :: [ExtensionRaw] -> [ExtensionRaw]
onTLSExtensionCreated = [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> a
id
        , onTLSHandshakeCreated :: [(EncryptionLevel, CryptoData)]
-> ([(EncryptionLevel, CryptoData)], Bool)
onTLSHandshakeCreated = (,Bool
False)
        , onResetStreamReceived :: Stream -> ApplicationProtocolError -> IO ()
onResetStreamReceived = \Stream
_ ApplicationProtocolError
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , onServerReady :: IO ()
onServerReady = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        }

----------------------------------------------------------------

-- | Client configuration.
data ClientConfig = ClientConfig
    { ClientConfig -> Version
ccVersion :: Version
    -- ^ The version to start with.
    , ClientConfig -> [Version]
ccVersions :: [Version]
    -- ^ Compatible versions with 'ccVersion' in the preferred order.
    , ClientConfig -> [Cipher]
ccCiphers :: [Cipher]
    -- ^ Cipher candidates defined in TLS 1.3.
    , ClientConfig -> [Group]
ccGroups :: [Group]
    -- ^ Key exchange group candidates defined in TLS 1.3.
    , ClientConfig -> Parameters
ccParameters :: Parameters
    , ClientConfig -> String -> IO ()
ccKeyLog :: String -> IO ()
    , ClientConfig -> Maybe String
ccQLog :: Maybe FilePath
    , ClientConfig -> Credentials
ccCredentials :: Credentials
    -- ^ TLS credentials.
    , ClientConfig -> Hooks
ccHooks :: Hooks
    , ClientConfig -> ClientHooks
ccTlsHooks :: ClientHooks
    , ClientConfig -> Bool
ccUse0RTT :: Bool
    -- ^ Use 0-RTT on the 2nd connection if possible.
    -- client original
    , ClientConfig -> String
ccServerName :: HostName
    -- ^ Used to create a socket and SNI for TLS.
    , ClientConfig -> String
ccPortName :: ServiceName
    -- ^ Used to create a socket.
    , ClientConfig -> Version -> IO (Maybe [CryptoData])
ccALPN :: Version -> IO (Maybe [ByteString])
    -- ^ An ALPN provider.
    , ClientConfig -> Bool
ccValidate :: Bool
    -- ^ Authenticating a server based on its certificate.
    , ClientConfig -> ResumptionInfo
ccResumption :: ResumptionInfo
    -- ^ Use resumption on the 2nd connection if possible.
    , ClientConfig -> Maybe Int
ccPacketSize :: Maybe Int
    -- ^ QUIC packet size (UDP payload size)
    , ClientConfig -> Bool
ccDebugLog :: Bool
    , ClientConfig -> Bool
ccAutoMigration :: Bool
    -- ^ If 'True', use a unconnected socket for auto migration. Otherwise, use a connected socket.
    }

-- | The default value for client configuration.
defaultClientConfig :: ClientConfig
defaultClientConfig :: ClientConfig
defaultClientConfig =
    ClientConfig
        { ccVersion :: Version
ccVersion = Version
Version1
        , ccVersions :: [Version]
ccVersions = [Version
Version2, Version
Version1]
        , ccCiphers :: [Cipher]
ccCiphers = Supported -> [Cipher]
supportedCiphers Supported
defaultSupported
        , ccGroups :: [Group]
ccGroups = Supported -> [Group]
supportedGroups Supported
defaultSupported
        , ccParameters :: Parameters
ccParameters = Parameters
defaultParameters
        , ccKeyLog :: String -> IO ()
ccKeyLog = \String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , ccQLog :: Maybe String
ccQLog = Maybe String
forall a. Maybe a
Nothing
        , ccCredentials :: Credentials
ccCredentials = Credentials
forall a. Monoid a => a
mempty
        , ccHooks :: Hooks
ccHooks = Hooks
defaultHooks
        , ccTlsHooks :: ClientHooks
ccTlsHooks = ClientHooks
forall a. Default a => a
def
        , ccUse0RTT :: Bool
ccUse0RTT = Bool
False
        , -- client original
          ccServerName :: String
ccServerName = String
"127.0.0.1"
        , ccPortName :: String
ccPortName = String
"4433"
        , ccALPN :: Version -> IO (Maybe [CryptoData])
ccALPN = \Version
_ -> Maybe [CryptoData] -> IO (Maybe [CryptoData])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [CryptoData]
forall a. Maybe a
Nothing
        , ccValidate :: Bool
ccValidate = Bool
True
        , ccResumption :: ResumptionInfo
ccResumption = ResumptionInfo
defaultResumptionInfo
        , ccPacketSize :: Maybe Int
ccPacketSize = Maybe Int
forall a. Maybe a
Nothing
        , ccDebugLog :: Bool
ccDebugLog = Bool
False
        , ccAutoMigration :: Bool
ccAutoMigration = Bool
True
        }

----------------------------------------------------------------

-- | Server configuration.
data ServerConfig = ServerConfig
    { ServerConfig -> [Version]
scVersions :: [Version]
    -- ^ Fully-Deployed Versions in the preferred order.
    , ServerConfig -> [Cipher]
scCiphers :: [Cipher]
    -- ^ Cipher candidates defined in TLS 1.3.
    , ServerConfig -> [Group]
scGroups :: [Group]
    -- ^ Key exchange group candidates defined in TLS 1.3.
    , ServerConfig -> Parameters
scParameters :: Parameters
    , ServerConfig -> String -> IO ()
scKeyLog :: String -> IO ()
    , ServerConfig -> Maybe String
scQLog :: Maybe FilePath
    , ServerConfig -> Credentials
scCredentials :: Credentials
    -- ^ Server certificate information.
    , ServerConfig -> Hooks
scHooks :: Hooks
    , ServerConfig -> ServerHooks
scTlsHooks :: ServerHooks
    , ServerConfig -> Bool
scUse0RTT :: Bool
    -- ^ Use 0-RTT on the 2nd connection if possible.
    -- server original
    , ServerConfig -> [(IP, PortNumber)]
scAddresses :: [(IP, PortNumber)]
    -- ^ Server addresses assigned to used network interfaces.
    , ServerConfig -> Maybe (Version -> [CryptoData] -> IO CryptoData)
scALPN :: Maybe (Version -> [ByteString] -> IO ByteString)
    -- ^ ALPN handler.
    , ServerConfig -> Bool
scRequireRetry :: Bool
    -- ^ Requiring QUIC retry.
    , ServerConfig -> SessionManager
scSessionManager :: SessionManager
    -- ^ A session manager of TLS 1.3.
    , ServerConfig -> Maybe String
scDebugLog :: Maybe FilePath
    , ServerConfig -> Int
scTicketLifetime :: Int
    -- ^ A lifetime (in seconds) for TLS session ticket and QUIC token.
    }

-- | The default value for server configuration.
defaultServerConfig :: ServerConfig
defaultServerConfig :: ServerConfig
defaultServerConfig =
    ServerConfig
        { scVersions :: [Version]
scVersions = [Version
Version2, Version
Version1]
        , scCiphers :: [Cipher]
scCiphers = Supported -> [Cipher]
supportedCiphers Supported
defaultSupported
        , scGroups :: [Group]
scGroups = Supported -> [Group]
supportedGroups Supported
defaultSupported
        , scParameters :: Parameters
scParameters = Parameters
defaultParameters
        , scKeyLog :: String -> IO ()
scKeyLog = \String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , scQLog :: Maybe String
scQLog = Maybe String
forall a. Maybe a
Nothing
        , scCredentials :: Credentials
scCredentials = Credentials
forall a. Monoid a => a
mempty
        , scHooks :: Hooks
scHooks = Hooks
defaultHooks
        , scTlsHooks :: ServerHooks
scTlsHooks = ServerHooks
forall a. Default a => a
def
        , scUse0RTT :: Bool
scUse0RTT = Bool
False
        , -- server original
          scAddresses :: [(IP, PortNumber)]
scAddresses = [(IP
"0.0.0.0", PortNumber
4433), (IP
"::", PortNumber
4433)]
        , scALPN :: Maybe (Version -> [CryptoData] -> IO CryptoData)
scALPN = Maybe (Version -> [CryptoData] -> IO CryptoData)
forall a. Maybe a
Nothing
        , scRequireRetry :: Bool
scRequireRetry = Bool
False
        , scSessionManager :: SessionManager
scSessionManager = SessionManager
noSessionManager
        , scDebugLog :: Maybe String
scDebugLog = Maybe String
forall a. Maybe a
Nothing
        , scTicketLifetime :: Int
scTicketLifetime = Int
7200
        }