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

-- | Running an HTTP\/2 client over TLS.
module Network.HTTP2.TLS.Client (
    -- * Runners
    run,
    runH2C,
    Client,
    HostName,
    Authority,
    PortNumber,
    runTLS,

    -- ** Generalized API
    ClientConfig,
    defaultClientConfig,
    defaultAuthority,
    runWithConfig,
    runH2CWithConfig,
    runTLSWithConfig,

    -- * Settings
    Settings,
    defaultSettings,
    settingsKeyLogger,
    settingsValidateCert,
    settingsOnServerCertificate,
    settingsCAStore,
    settingsAddrInfoFlags,
    settingsCacheLimit,
    settingsConcurrentStreams,
    settingsConnectionWindowSize,
    settingsStreamWindowSize,
    settingsServerNameOverride,
    settingsUseServerNameIndication,
    settingsSessionManager,
    settingsWantSessionResume,
    settingsWantSessionResumeList,
    settingsOpenClientSocket,
    settingsUseEarlyData,
    settingsOnServerFinished,
    settingsTimeout,

    -- ** Rate limits
    settingsPingRateLimit,
    settingsEmptyFrameRateLimit,
    settingsSettingsRateLimit,
    settingsRstRateLimit,
) where

import qualified Control.Exception as E
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS.C8
import Data.Maybe (fromMaybe)
import Data.X509.CertificateStore (isEmptyCertificateStore)
import Network.HTTP2.Client (Authority, Client, ClientConfig)
import qualified Network.HTTP2.Client as H2Client
import Network.Run.TCP (runTCPClientWithSettings)
import qualified Network.Run.TCP as TCP
import Network.Socket
import Network.TLS hiding (HostName)
import System.Timeout (timeout)
import System.X509 (getSystemCertificateStore)

import Network.HTTP2.TLS.Client.Settings
import Network.HTTP2.TLS.Config
import Network.HTTP2.TLS.IO
import qualified Network.HTTP2.TLS.Server.Settings as Server
import Network.HTTP2.TLS.Supported

data H2TlsTimeout = H2TlsTimeout deriving (H2TlsTimeout -> H2TlsTimeout -> Bool
(H2TlsTimeout -> H2TlsTimeout -> Bool)
-> (H2TlsTimeout -> H2TlsTimeout -> Bool) -> Eq H2TlsTimeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: H2TlsTimeout -> H2TlsTimeout -> Bool
== :: H2TlsTimeout -> H2TlsTimeout -> Bool
$c/= :: H2TlsTimeout -> H2TlsTimeout -> Bool
/= :: H2TlsTimeout -> H2TlsTimeout -> Bool
Eq, Int -> H2TlsTimeout -> ShowS
[H2TlsTimeout] -> ShowS
H2TlsTimeout -> String
(Int -> H2TlsTimeout -> ShowS)
-> (H2TlsTimeout -> String)
-> ([H2TlsTimeout] -> ShowS)
-> Show H2TlsTimeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H2TlsTimeout -> ShowS
showsPrec :: Int -> H2TlsTimeout -> ShowS
$cshow :: H2TlsTimeout -> String
show :: H2TlsTimeout -> String
$cshowList :: [H2TlsTimeout] -> ShowS
showList :: [H2TlsTimeout] -> ShowS
Show)
instance E.Exception H2TlsTimeout

----------------------------------------------------------------
-- Default API

run :: Settings -> HostName -> PortNumber -> Client a -> IO a
run :: forall a. Settings -> String -> PortNumber -> Client a -> IO a
run Settings
settings String
serverName PortNumber
port Client a
client =
    ClientConfig
-> Settings -> String -> PortNumber -> Client a -> IO a
forall a.
ClientConfig
-> Settings -> String -> PortNumber -> Client a -> IO a
runWithConfig
        (Settings -> String -> ClientConfig
defaultClientConfig Settings
settings (String -> ClientConfig) -> String -> ClientConfig
forall a b. (a -> b) -> a -> b
$ ShowS
defaultAuthority String
serverName)
        Settings
settings
        String
serverName
        PortNumber
port
        Client a
client

runTLS
    :: Settings
    -> HostName
    -> PortNumber
    -> ByteString
    -- ^ ALPN
    -> (Context -> SockAddr -> SockAddr -> IO a)
    -> IO a
runTLS :: forall a.
Settings
-> String
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLS Settings
settings String
serverName PortNumber
port Scheme
alpn Context -> SockAddr -> SockAddr -> IO a
action =
    ClientConfig
-> Settings
-> String
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
forall a.
ClientConfig
-> Settings
-> String
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLSWithConfig
        (Settings -> String -> ClientConfig
defaultClientConfig Settings
settings (String -> ClientConfig) -> String -> ClientConfig
forall a b. (a -> b) -> a -> b
$ ShowS
defaultAuthority String
serverName)
        Settings
settings
        String
serverName
        PortNumber
port
        Scheme
alpn
        Context -> SockAddr -> SockAddr -> IO a
action

runH2C :: Settings -> HostName -> PortNumber -> Client a -> IO a
runH2C :: forall a. Settings -> String -> PortNumber -> Client a -> IO a
runH2C Settings
settings String
serverName PortNumber
port Client a
client =
    ClientConfig
-> Settings -> String -> PortNumber -> Client a -> IO a
forall a.
ClientConfig
-> Settings -> String -> PortNumber -> Client a -> IO a
runH2CWithConfig
        (Settings -> String -> ClientConfig
defaultClientConfig Settings
settings (String -> ClientConfig) -> String -> ClientConfig
forall a b. (a -> b) -> a -> b
$ ShowS
defaultAuthority String
serverName)
        Settings
settings
        String
serverName
        PortNumber
port
        Client a
client

----------------------------------------------------------------
-- Generalized API

-- | Running a TLS client.
runTLSWithConfig
    :: ClientConfig
    -> Settings
    -> HostName
    -> PortNumber
    -> ByteString
    -- ^ ALPN
    -> (Context -> SockAddr -> SockAddr -> IO a)
    -> IO a
runTLSWithConfig :: forall a.
ClientConfig
-> Settings
-> String
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLSWithConfig ClientConfig
cliconf settings :: Settings
settings@Settings{Bool
Int
[(Scheme, SessionData)]
[AddrInfoFlag]
Maybe String
Maybe (Scheme, SessionData)
CertificateStore
SessionManager
String -> IO ()
OnServerCertificate
AddrInfo -> IO Socket
Information -> IO ()
settingsKeyLogger :: Settings -> String -> IO ()
settingsValidateCert :: Settings -> Bool
settingsOnServerCertificate :: Settings -> OnServerCertificate
settingsCAStore :: Settings -> CertificateStore
settingsAddrInfoFlags :: Settings -> [AddrInfoFlag]
settingsCacheLimit :: Settings -> Int
settingsConcurrentStreams :: Settings -> Int
settingsConnectionWindowSize :: Settings -> Int
settingsStreamWindowSize :: Settings -> Int
settingsServerNameOverride :: Settings -> Maybe String
settingsUseServerNameIndication :: Settings -> Bool
settingsSessionManager :: Settings -> SessionManager
settingsWantSessionResume :: Settings -> Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: Settings -> [(Scheme, SessionData)]
settingsOpenClientSocket :: Settings -> AddrInfo -> IO Socket
settingsUseEarlyData :: Settings -> Bool
settingsOnServerFinished :: Settings -> Information -> IO ()
settingsTimeout :: Settings -> Int
settingsPingRateLimit :: Settings -> Int
settingsEmptyFrameRateLimit :: Settings -> Int
settingsSettingsRateLimit :: Settings -> Int
settingsRstRateLimit :: Settings -> Int
settingsKeyLogger :: String -> IO ()
settingsValidateCert :: Bool
settingsOnServerCertificate :: OnServerCertificate
settingsCAStore :: CertificateStore
settingsServerNameOverride :: Maybe String
settingsUseServerNameIndication :: Bool
settingsAddrInfoFlags :: [AddrInfoFlag]
settingsCacheLimit :: Int
settingsConcurrentStreams :: Int
settingsStreamWindowSize :: Int
settingsConnectionWindowSize :: Int
settingsSessionManager :: SessionManager
settingsWantSessionResume :: Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: [(Scheme, SessionData)]
settingsUseEarlyData :: Bool
settingsOpenClientSocket :: AddrInfo -> IO Socket
settingsOnServerFinished :: Information -> IO ()
settingsPingRateLimit :: Int
settingsEmptyFrameRateLimit :: Int
settingsSettingsRateLimit :: Int
settingsRstRateLimit :: Int
settingsTimeout :: Int
..} String
serverName PortNumber
port Scheme
alpn Context -> SockAddr -> SockAddr -> IO a
action =
    Settings -> String -> String -> (Socket -> IO a) -> IO a
forall a. Settings -> String -> String -> (Socket -> IO a) -> IO a
runTCPClientWithSettings Settings
tcpSettings String
serverName (PortNumber -> String
forall a. Show a => a -> String
show PortNumber
port) ((Socket -> IO a) -> IO a) -> (Socket -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
        SockAddr
mysa <- Socket -> IO SockAddr
getSocketName Socket
sock
        SockAddr
peersa <- Socket -> IO SockAddr
getPeerName Socket
sock
        ClientParams
params <- Settings -> String -> PortNumber -> Scheme -> IO ClientParams
getClientParams Settings
settings String
sni PortNumber
port Scheme
alpn
        Context
ctx <- Socket -> ClientParams -> IO Context
forall (m :: * -> *) backend params.
(MonadIO m, HasBackend backend, TLSParams params) =>
backend -> params -> m Context
contextNew Socket
sock ClientParams
params
        Context -> IO ()
forall (m :: * -> *). MonadIO m => Context -> m ()
handshake Context
ctx
        a
r <- Context -> SockAddr -> SockAddr -> IO a
action Context
ctx SockAddr
mysa SockAddr
peersa
        Context -> IO ()
forall (m :: * -> *). MonadIO m => Context -> m ()
bye Context
ctx
        a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
  where
    sni :: String
sni = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (ClientConfig -> String
H2Client.authority ClientConfig
cliconf) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Maybe String
settingsServerNameOverride
    tcpSettings :: Settings
tcpSettings =
        Settings
TCP.defaultSettings
            { TCP.settingsOpenClientSocket = settingsOpenClientSocket
            }

-- | Running an HTTP\/2 client over TLS (over TCP).
runWithConfig
    :: ClientConfig -> Settings -> HostName -> PortNumber -> Client a -> IO a
runWithConfig :: forall a.
ClientConfig
-> Settings -> String -> PortNumber -> Client a -> IO a
runWithConfig ClientConfig
cliconf Settings
settings String
serverName PortNumber
port Client a
client =
    ClientConfig
-> Settings
-> String
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
forall a.
ClientConfig
-> Settings
-> String
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLSWithConfig ClientConfig
cliconf Settings
settings String
serverName PortNumber
port Scheme
"h2" ((Context -> SockAddr -> SockAddr -> IO a) -> IO a)
-> (Context -> SockAddr -> SockAddr -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Context
ctx SockAddr
mysa SockAddr
peersa -> do
        let tout :: Int
tout = Settings -> Int
settingsTimeout Settings
settings
            recv :: IO Scheme
recv
                | Int
tout Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
                    Maybe Scheme
mx <- Int -> IO Scheme -> IO (Maybe Scheme)
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int
tout Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000) (IO Scheme -> IO (Maybe Scheme)) -> IO Scheme -> IO (Maybe Scheme)
forall a b. (a -> b) -> a -> b
$ Context -> IO Scheme
recvTLS Context
ctx
                    case Maybe Scheme
mx of
                        Maybe Scheme
Nothing -> H2TlsTimeout -> IO Scheme
forall e a. Exception e => e -> IO a
E.throwIO H2TlsTimeout
H2TlsTimeout
                        Just Scheme
x -> Scheme -> IO Scheme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Scheme
x
                | Bool
otherwise = Context -> IO Scheme
recvTLS Context
ctx
        ClientConfig
-> (Scheme -> IO ())
-> IO Scheme
-> SockAddr
-> SockAddr
-> Client a
-> IO a
forall a.
ClientConfig
-> (Scheme -> IO ())
-> IO Scheme
-> SockAddr
-> SockAddr
-> Client a
-> IO a
run' ClientConfig
cliconf' (Context -> Scheme -> IO ()
sendTLS Context
ctx) IO Scheme
recv SockAddr
mysa SockAddr
peersa Client a
client
  where
    cliconf' :: ClientConfig
    cliconf' :: ClientConfig
cliconf' = ClientConfig
cliconf{H2Client.scheme = "https"}

-- | Running an HTTP\/2 client over TCP.
runH2CWithConfig
    :: ClientConfig -> Settings -> HostName -> PortNumber -> Client a -> IO a
runH2CWithConfig :: forall a.
ClientConfig
-> Settings -> String -> PortNumber -> Client a -> IO a
runH2CWithConfig ClientConfig
cliconf Settings{Bool
Int
[(Scheme, SessionData)]
[AddrInfoFlag]
Maybe String
Maybe (Scheme, SessionData)
CertificateStore
SessionManager
String -> IO ()
OnServerCertificate
AddrInfo -> IO Socket
Information -> IO ()
settingsKeyLogger :: Settings -> String -> IO ()
settingsValidateCert :: Settings -> Bool
settingsOnServerCertificate :: Settings -> OnServerCertificate
settingsCAStore :: Settings -> CertificateStore
settingsAddrInfoFlags :: Settings -> [AddrInfoFlag]
settingsCacheLimit :: Settings -> Int
settingsConcurrentStreams :: Settings -> Int
settingsConnectionWindowSize :: Settings -> Int
settingsStreamWindowSize :: Settings -> Int
settingsServerNameOverride :: Settings -> Maybe String
settingsUseServerNameIndication :: Settings -> Bool
settingsSessionManager :: Settings -> SessionManager
settingsWantSessionResume :: Settings -> Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: Settings -> [(Scheme, SessionData)]
settingsOpenClientSocket :: Settings -> AddrInfo -> IO Socket
settingsUseEarlyData :: Settings -> Bool
settingsOnServerFinished :: Settings -> Information -> IO ()
settingsTimeout :: Settings -> Int
settingsPingRateLimit :: Settings -> Int
settingsEmptyFrameRateLimit :: Settings -> Int
settingsSettingsRateLimit :: Settings -> Int
settingsRstRateLimit :: Settings -> Int
settingsKeyLogger :: String -> IO ()
settingsValidateCert :: Bool
settingsOnServerCertificate :: OnServerCertificate
settingsCAStore :: CertificateStore
settingsServerNameOverride :: Maybe String
settingsUseServerNameIndication :: Bool
settingsAddrInfoFlags :: [AddrInfoFlag]
settingsCacheLimit :: Int
settingsConcurrentStreams :: Int
settingsStreamWindowSize :: Int
settingsConnectionWindowSize :: Int
settingsSessionManager :: SessionManager
settingsWantSessionResume :: Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: [(Scheme, SessionData)]
settingsUseEarlyData :: Bool
settingsOpenClientSocket :: AddrInfo -> IO Socket
settingsOnServerFinished :: Information -> IO ()
settingsPingRateLimit :: Int
settingsEmptyFrameRateLimit :: Int
settingsSettingsRateLimit :: Int
settingsRstRateLimit :: Int
settingsTimeout :: Int
..} String
serverName PortNumber
port Client a
client =
    Settings -> String -> String -> (Socket -> IO a) -> IO a
forall a. Settings -> String -> String -> (Socket -> IO a) -> IO a
runTCPClientWithSettings Settings
tcpSettings String
serverName (PortNumber -> String
forall a. Show a => a -> String
show PortNumber
port) ((Socket -> IO a) -> IO a) -> (Socket -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
        SockAddr
mysa <- Socket -> IO SockAddr
getSocketName Socket
sock
        SockAddr
peersa <- Socket -> IO SockAddr
getPeerName Socket
sock
        IO Scheme
recv <- Settings -> Socket -> IO (IO Scheme)
mkRecvTCP Settings
Server.defaultSettings Socket
sock
        let tout :: Int
tout = Int
settingsTimeout
            recv' :: IO Scheme
recv'
                | Int
tout Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
                    Maybe Scheme
mx <- Int -> IO Scheme -> IO (Maybe Scheme)
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int
tout Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000) IO Scheme
recv
                    case Maybe Scheme
mx of
                        Maybe Scheme
Nothing -> H2TlsTimeout -> IO Scheme
forall e a. Exception e => e -> IO a
E.throwIO H2TlsTimeout
H2TlsTimeout
                        Just Scheme
x -> Scheme -> IO Scheme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Scheme
x
                | Bool
otherwise = IO Scheme
recv
        ClientConfig
-> (Scheme -> IO ())
-> IO Scheme
-> SockAddr
-> SockAddr
-> Client a
-> IO a
forall a.
ClientConfig
-> (Scheme -> IO ())
-> IO Scheme
-> SockAddr
-> SockAddr
-> Client a
-> IO a
run' ClientConfig
cliconf' (Socket -> Scheme -> IO ()
sendTCP Socket
sock) IO Scheme
recv' SockAddr
mysa SockAddr
peersa Client a
client
  where
    cliconf' :: ClientConfig
    cliconf' :: ClientConfig
cliconf' = ClientConfig
cliconf{H2Client.scheme = "http"}
    tcpSettings :: Settings
tcpSettings =
        Settings
TCP.defaultSettings
            { TCP.settingsOpenClientSocket = settingsOpenClientSocket
            }

run'
    :: ClientConfig
    -> (ByteString -> IO ())
    -> IO ByteString
    -> SockAddr
    -> SockAddr
    -> Client a
    -> IO a
run' :: forall a.
ClientConfig
-> (Scheme -> IO ())
-> IO Scheme
-> SockAddr
-> SockAddr
-> Client a
-> IO a
run' ClientConfig
cliconf Scheme -> IO ()
send IO Scheme
recv SockAddr
mysa SockAddr
peersa Client a
client =
    IO Config -> (Config -> IO ()) -> (Config -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
        ((Scheme -> IO ()) -> IO Scheme -> SockAddr -> SockAddr -> IO Config
allocConfigForClient Scheme -> IO ()
send IO Scheme
recv SockAddr
mysa SockAddr
peersa)
        Config -> IO ()
freeConfigForClient
        (\Config
conf -> ClientConfig -> Config -> Client a -> IO a
forall a. ClientConfig -> Config -> Client a -> IO a
H2Client.run ClientConfig
cliconf Config
conf Client a
client)

defaultClientConfig
    :: Settings
    -> Authority
    -> ClientConfig
defaultClientConfig :: Settings -> String -> ClientConfig
defaultClientConfig Settings{Bool
Int
[(Scheme, SessionData)]
[AddrInfoFlag]
Maybe String
Maybe (Scheme, SessionData)
CertificateStore
SessionManager
String -> IO ()
OnServerCertificate
AddrInfo -> IO Socket
Information -> IO ()
settingsKeyLogger :: Settings -> String -> IO ()
settingsValidateCert :: Settings -> Bool
settingsOnServerCertificate :: Settings -> OnServerCertificate
settingsCAStore :: Settings -> CertificateStore
settingsAddrInfoFlags :: Settings -> [AddrInfoFlag]
settingsCacheLimit :: Settings -> Int
settingsConcurrentStreams :: Settings -> Int
settingsConnectionWindowSize :: Settings -> Int
settingsStreamWindowSize :: Settings -> Int
settingsServerNameOverride :: Settings -> Maybe String
settingsUseServerNameIndication :: Settings -> Bool
settingsSessionManager :: Settings -> SessionManager
settingsWantSessionResume :: Settings -> Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: Settings -> [(Scheme, SessionData)]
settingsOpenClientSocket :: Settings -> AddrInfo -> IO Socket
settingsUseEarlyData :: Settings -> Bool
settingsOnServerFinished :: Settings -> Information -> IO ()
settingsTimeout :: Settings -> Int
settingsPingRateLimit :: Settings -> Int
settingsEmptyFrameRateLimit :: Settings -> Int
settingsSettingsRateLimit :: Settings -> Int
settingsRstRateLimit :: Settings -> Int
settingsKeyLogger :: String -> IO ()
settingsValidateCert :: Bool
settingsOnServerCertificate :: OnServerCertificate
settingsCAStore :: CertificateStore
settingsServerNameOverride :: Maybe String
settingsUseServerNameIndication :: Bool
settingsAddrInfoFlags :: [AddrInfoFlag]
settingsCacheLimit :: Int
settingsConcurrentStreams :: Int
settingsStreamWindowSize :: Int
settingsConnectionWindowSize :: Int
settingsSessionManager :: SessionManager
settingsWantSessionResume :: Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: [(Scheme, SessionData)]
settingsUseEarlyData :: Bool
settingsOpenClientSocket :: AddrInfo -> IO Socket
settingsOnServerFinished :: Information -> IO ()
settingsPingRateLimit :: Int
settingsEmptyFrameRateLimit :: Int
settingsSettingsRateLimit :: Int
settingsRstRateLimit :: Int
settingsTimeout :: Int
..} String
auth =
    ClientConfig
H2Client.defaultClientConfig
        { H2Client.scheme = "https"
        , H2Client.authority = auth
        , H2Client.cacheLimit = settingsCacheLimit
        , H2Client.connectionWindowSize = settingsConnectionWindowSize
        , H2Client.settings =
            (H2Client.settings $ H2Client.defaultClientConfig)
                { H2Client.initialWindowSize = settingsStreamWindowSize
                , H2Client.maxConcurrentStreams = Just settingsConcurrentStreams
                , H2Client.pingRateLimit = settingsPingRateLimit
                , H2Client.emptyFrameRateLimit = settingsEmptyFrameRateLimit
                , H2Client.settingsRateLimit = settingsSettingsRateLimit
                , H2Client.rstRateLimit = settingsRstRateLimit
                }
        }

-- | Default authority
--
-- When we connect to a server, we can distinguish between three names, all of
-- which may be different:
--
-- 1. The 'HostName', used for the DNS lookup to get the server's IP
-- 2. The HTTP2 @:authority@ pseudo-header
-- 3. The TLS SNI (Server Name Indicator).
--    This is different from (2) only in exceptional circumstances, see
--    'settingsServerNameOverride'.
--
-- In /most/ cases, however, all three names are identical, and so the default
-- 'Authority' is simply equal to the 'ServerName'.
defaultAuthority :: HostName -> Authority
defaultAuthority :: ShowS
defaultAuthority = ShowS
forall a. a -> a
id

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

getClientParams
    :: Settings
    -> HostName
    -- ^ Server name (for TLS SNI)
    -> PortNumber
    -- ^ Port number
    -- This is not used for validation, but improves caching; see documentation of
    -- [ServiceID](https://hackage.haskell.org/package/x509-validation-1.6.12/docs/Data-X509-Validation.html#t:ServiceID).
    -> ByteString
    -- ^ ALPN
    -> IO ClientParams
getClientParams :: Settings -> String -> PortNumber -> Scheme -> IO ClientParams
getClientParams Settings{Bool
Int
[(Scheme, SessionData)]
[AddrInfoFlag]
Maybe String
Maybe (Scheme, SessionData)
CertificateStore
SessionManager
String -> IO ()
OnServerCertificate
AddrInfo -> IO Socket
Information -> IO ()
settingsKeyLogger :: Settings -> String -> IO ()
settingsValidateCert :: Settings -> Bool
settingsOnServerCertificate :: Settings -> OnServerCertificate
settingsCAStore :: Settings -> CertificateStore
settingsAddrInfoFlags :: Settings -> [AddrInfoFlag]
settingsCacheLimit :: Settings -> Int
settingsConcurrentStreams :: Settings -> Int
settingsConnectionWindowSize :: Settings -> Int
settingsStreamWindowSize :: Settings -> Int
settingsServerNameOverride :: Settings -> Maybe String
settingsUseServerNameIndication :: Settings -> Bool
settingsSessionManager :: Settings -> SessionManager
settingsWantSessionResume :: Settings -> Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: Settings -> [(Scheme, SessionData)]
settingsOpenClientSocket :: Settings -> AddrInfo -> IO Socket
settingsUseEarlyData :: Settings -> Bool
settingsOnServerFinished :: Settings -> Information -> IO ()
settingsTimeout :: Settings -> Int
settingsPingRateLimit :: Settings -> Int
settingsEmptyFrameRateLimit :: Settings -> Int
settingsSettingsRateLimit :: Settings -> Int
settingsRstRateLimit :: Settings -> Int
settingsKeyLogger :: String -> IO ()
settingsValidateCert :: Bool
settingsOnServerCertificate :: OnServerCertificate
settingsCAStore :: CertificateStore
settingsServerNameOverride :: Maybe String
settingsUseServerNameIndication :: Bool
settingsAddrInfoFlags :: [AddrInfoFlag]
settingsCacheLimit :: Int
settingsConcurrentStreams :: Int
settingsStreamWindowSize :: Int
settingsConnectionWindowSize :: Int
settingsSessionManager :: SessionManager
settingsWantSessionResume :: Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: [(Scheme, SessionData)]
settingsUseEarlyData :: Bool
settingsOpenClientSocket :: AddrInfo -> IO Socket
settingsOnServerFinished :: Information -> IO ()
settingsPingRateLimit :: Int
settingsEmptyFrameRateLimit :: Int
settingsSettingsRateLimit :: Int
settingsRstRateLimit :: Int
settingsTimeout :: Int
..} String
sni PortNumber
port Scheme
alpn = do
    CertificateStore
caStore <-
        if Bool
settingsValidateCert
            then
                if CertificateStore -> Bool
isEmptyCertificateStore CertificateStore
settingsCAStore
                    then IO CertificateStore
getSystemCertificateStore
                    else CertificateStore -> IO CertificateStore
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CertificateStore
settingsCAStore
            else CertificateStore -> IO CertificateStore
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CertificateStore
forall a. Monoid a => a
mempty
    let shared :: Shared
shared =
            Shared
defaultShared
                { sharedValidationCache = validateCache
                , sharedCAStore = caStore
                , sharedSessionManager = settingsSessionManager
                }
    -- RFC 4366 mandates UTF-8 for SNI
    -- <https://datatracker.ietf.org/doc/html/rfc4366#section-3.1>
    ClientParams -> IO ClientParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (String -> Scheme -> ClientParams
defaultParamsClient String
sni (String -> Scheme
BS.C8.pack (String -> Scheme) -> String -> Scheme
forall a b. (a -> b) -> a -> b
$ PortNumber -> String
forall a. Show a => a -> String
show PortNumber
port))
            { clientSupported = supported
            , clientWantSessionResume = settingsWantSessionResume
            , clientWantSessionResumeList = settingsWantSessionResumeList
            , clientUseServerNameIndication = settingsUseServerNameIndication
            , clientShared = shared
            , clientHooks = hooks
            , clientDebug = debug
            , clientUseEarlyData = settingsUseEarlyData
            }
  where
    supported :: Supported
supported = Supported
strongSupported
    hooks :: ClientHooks
hooks =
        ClientHooks
defaultClientHooks
            { onSuggestALPN = return $ Just [alpn]
            , onServerFinished = settingsOnServerFinished
            , onServerCertificate = settingsOnServerCertificate
            }
    validateCache :: ValidationCache
validateCache
        | Bool
settingsValidateCert = ValidationCache
defaultValidationCache
        | Bool
otherwise =
            ValidationCacheQueryCallback
-> ValidationCacheAddCallback -> ValidationCache
ValidationCache
                (\ServiceID
_ Fingerprint
_ Certificate
_ -> ValidationCacheResult -> IO ValidationCacheResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ValidationCacheResult
ValidationCachePass)
                (\ServiceID
_ Fingerprint
_ Certificate
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    debug :: DebugParams
debug =
        DebugParams
defaultDebugParams
            { debugKeyLogger = settingsKeyLogger
            }