{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP2.TLS.Client (
run,
runH2C,
Client,
HostName,
Authority,
PortNumber,
runTLS,
ClientConfig,
defaultClientConfig,
defaultAuthority,
runWithConfig,
runH2CWithConfig,
runTLSWithConfig,
Settings,
defaultSettings,
settingsKeyLogger,
settingsValidateCert,
settingsCAStore,
settingsAddrInfoFlags,
settingsCacheLimit,
settingsConcurrentStreams,
settingsConnectionWindowSize,
settingsStreamWindowSize,
settingsServerNameOverride,
settingsSessionManager,
settingsWantSessionResume,
settingsWantSessionResumeList,
settingsOpenClientSocket,
settingsUseEarlyData,
settingsOnServerFinished,
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.Validation (validateDefault)
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 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
run :: Settings -> HostName -> PortNumber -> Client a -> IO a
run :: forall a. Settings -> HostName -> PortNumber -> Client a -> IO a
run Settings
settings HostName
serverName PortNumber
port Client a
client =
ClientConfig
-> Settings -> HostName -> PortNumber -> Client a -> IO a
forall a.
ClientConfig
-> Settings -> HostName -> PortNumber -> Client a -> IO a
runWithConfig
(Settings -> HostName -> ClientConfig
defaultClientConfig Settings
settings (HostName -> ClientConfig) -> HostName -> ClientConfig
forall a b. (a -> b) -> a -> b
$ HostName -> HostName
defaultAuthority HostName
serverName)
Settings
settings
HostName
serverName
PortNumber
port
Client a
client
runTLS
:: Settings
-> HostName
-> PortNumber
-> ByteString
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLS :: forall a.
Settings
-> HostName
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLS Settings
settings HostName
serverName PortNumber
port Scheme
alpn Context -> SockAddr -> SockAddr -> IO a
action =
ClientConfig
-> Settings
-> HostName
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
forall a.
ClientConfig
-> Settings
-> HostName
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLSWithConfig
(Settings -> HostName -> ClientConfig
defaultClientConfig Settings
settings (HostName -> ClientConfig) -> HostName -> ClientConfig
forall a b. (a -> b) -> a -> b
$ HostName -> HostName
defaultAuthority HostName
serverName)
Settings
settings
HostName
serverName
PortNumber
port
Scheme
alpn
Context -> SockAddr -> SockAddr -> IO a
action
runH2C :: Settings -> HostName -> PortNumber -> Client a -> IO a
runH2C :: forall a. Settings -> HostName -> PortNumber -> Client a -> IO a
runH2C Settings
settings HostName
serverName PortNumber
port Client a
client =
ClientConfig
-> Settings -> HostName -> PortNumber -> Client a -> IO a
forall a.
ClientConfig
-> Settings -> HostName -> PortNumber -> Client a -> IO a
runH2CWithConfig
(Settings -> HostName -> ClientConfig
defaultClientConfig Settings
settings (HostName -> ClientConfig) -> HostName -> ClientConfig
forall a b. (a -> b) -> a -> b
$ HostName -> HostName
defaultAuthority HostName
serverName)
Settings
settings
HostName
serverName
PortNumber
port
Client a
client
runTLSWithConfig
:: ClientConfig
-> Settings
-> HostName
-> PortNumber
-> ByteString
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLSWithConfig :: forall a.
ClientConfig
-> Settings
-> HostName
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLSWithConfig ClientConfig
cliconf settings :: Settings
settings@Settings{Bool
Int
[(Scheme, SessionData)]
[AddrInfoFlag]
Maybe HostName
Maybe (Scheme, SessionData)
CertificateStore
SessionManager
HostName -> IO ()
AddrInfo -> IO Socket
Information -> IO ()
settingsKeyLogger :: Settings -> HostName -> IO ()
settingsValidateCert :: Settings -> Bool
settingsCAStore :: Settings -> CertificateStore
settingsAddrInfoFlags :: Settings -> [AddrInfoFlag]
settingsCacheLimit :: Settings -> Int
settingsConcurrentStreams :: Settings -> Int
settingsConnectionWindowSize :: Settings -> Int
settingsStreamWindowSize :: Settings -> Int
settingsServerNameOverride :: Settings -> Maybe HostName
settingsSessionManager :: Settings -> SessionManager
settingsWantSessionResume :: Settings -> Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: Settings -> [(Scheme, SessionData)]
settingsOpenClientSocket :: Settings -> AddrInfo -> IO Socket
settingsUseEarlyData :: Settings -> Bool
settingsOnServerFinished :: Settings -> Information -> IO ()
settingsPingRateLimit :: Settings -> Int
settingsEmptyFrameRateLimit :: Settings -> Int
settingsSettingsRateLimit :: Settings -> Int
settingsRstRateLimit :: Settings -> Int
settingsKeyLogger :: HostName -> IO ()
settingsValidateCert :: Bool
settingsCAStore :: CertificateStore
settingsServerNameOverride :: Maybe HostName
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
..} HostName
serverName PortNumber
port Scheme
alpn Context -> SockAddr -> SockAddr -> IO a
action =
Settings -> HostName -> HostName -> (Socket -> IO a) -> IO a
forall a.
Settings -> HostName -> HostName -> (Socket -> IO a) -> IO a
runTCPClientWithSettings Settings
tcpSettings HostName
serverName (PortNumber -> HostName
forall a. Show a => a -> HostName
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
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
params :: ClientParams
params :: ClientParams
params =
Settings -> HostName -> PortNumber -> Scheme -> ClientParams
getClientParams
Settings
settings
(HostName -> Maybe HostName -> HostName
forall a. a -> Maybe a -> a
fromMaybe (ClientConfig -> HostName
H2Client.authority ClientConfig
cliconf) (Maybe HostName -> HostName) -> Maybe HostName -> HostName
forall a b. (a -> b) -> a -> b
$ Maybe HostName
settingsServerNameOverride)
PortNumber
port
Scheme
alpn
tcpSettings :: Settings
tcpSettings =
Settings
TCP.defaultSettings
{ TCP.settingsOpenClientSocket = settingsOpenClientSocket
}
runWithConfig
:: ClientConfig -> Settings -> HostName -> PortNumber -> Client a -> IO a
runWithConfig :: forall a.
ClientConfig
-> Settings -> HostName -> PortNumber -> Client a -> IO a
runWithConfig ClientConfig
cliconf Settings
settings HostName
serverName PortNumber
port Client a
client =
ClientConfig
-> Settings
-> HostName
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
forall a.
ClientConfig
-> Settings
-> HostName
-> PortNumber
-> Scheme
-> (Context -> SockAddr -> SockAddr -> IO a)
-> IO a
runTLSWithConfig ClientConfig
cliconf Settings
settings HostName
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 ->
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) (Context -> IO Scheme
recvTLS Context
ctx) SockAddr
mysa SockAddr
peersa Client a
client
where
cliconf' :: ClientConfig
cliconf' :: ClientConfig
cliconf' = ClientConfig
cliconf{H2Client.scheme = "https"}
runH2CWithConfig
:: ClientConfig -> Settings -> HostName -> PortNumber -> Client a -> IO a
runH2CWithConfig :: forall a.
ClientConfig
-> Settings -> HostName -> PortNumber -> Client a -> IO a
runH2CWithConfig ClientConfig
cliconf Settings{Bool
Int
[(Scheme, SessionData)]
[AddrInfoFlag]
Maybe HostName
Maybe (Scheme, SessionData)
CertificateStore
SessionManager
HostName -> IO ()
AddrInfo -> IO Socket
Information -> IO ()
settingsKeyLogger :: Settings -> HostName -> IO ()
settingsValidateCert :: Settings -> Bool
settingsCAStore :: Settings -> CertificateStore
settingsAddrInfoFlags :: Settings -> [AddrInfoFlag]
settingsCacheLimit :: Settings -> Int
settingsConcurrentStreams :: Settings -> Int
settingsConnectionWindowSize :: Settings -> Int
settingsStreamWindowSize :: Settings -> Int
settingsServerNameOverride :: Settings -> Maybe HostName
settingsSessionManager :: Settings -> SessionManager
settingsWantSessionResume :: Settings -> Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: Settings -> [(Scheme, SessionData)]
settingsOpenClientSocket :: Settings -> AddrInfo -> IO Socket
settingsUseEarlyData :: Settings -> Bool
settingsOnServerFinished :: Settings -> Information -> IO ()
settingsPingRateLimit :: Settings -> Int
settingsEmptyFrameRateLimit :: Settings -> Int
settingsSettingsRateLimit :: Settings -> Int
settingsRstRateLimit :: Settings -> Int
settingsKeyLogger :: HostName -> IO ()
settingsValidateCert :: Bool
settingsCAStore :: CertificateStore
settingsServerNameOverride :: Maybe HostName
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
..} HostName
serverName PortNumber
port Client a
client =
Settings -> HostName -> HostName -> (Socket -> IO a) -> IO a
forall a.
Settings -> HostName -> HostName -> (Socket -> IO a) -> IO a
runTCPClientWithSettings Settings
tcpSettings HostName
serverName (PortNumber -> HostName
forall a. Show a => a -> HostName
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
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 -> HostName -> ClientConfig
defaultClientConfig Settings{Bool
Int
[(Scheme, SessionData)]
[AddrInfoFlag]
Maybe HostName
Maybe (Scheme, SessionData)
CertificateStore
SessionManager
HostName -> IO ()
AddrInfo -> IO Socket
Information -> IO ()
settingsKeyLogger :: Settings -> HostName -> IO ()
settingsValidateCert :: Settings -> Bool
settingsCAStore :: Settings -> CertificateStore
settingsAddrInfoFlags :: Settings -> [AddrInfoFlag]
settingsCacheLimit :: Settings -> Int
settingsConcurrentStreams :: Settings -> Int
settingsConnectionWindowSize :: Settings -> Int
settingsStreamWindowSize :: Settings -> Int
settingsServerNameOverride :: Settings -> Maybe HostName
settingsSessionManager :: Settings -> SessionManager
settingsWantSessionResume :: Settings -> Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: Settings -> [(Scheme, SessionData)]
settingsOpenClientSocket :: Settings -> AddrInfo -> IO Socket
settingsUseEarlyData :: Settings -> Bool
settingsOnServerFinished :: Settings -> Information -> IO ()
settingsPingRateLimit :: Settings -> Int
settingsEmptyFrameRateLimit :: Settings -> Int
settingsSettingsRateLimit :: Settings -> Int
settingsRstRateLimit :: Settings -> Int
settingsKeyLogger :: HostName -> IO ()
settingsValidateCert :: Bool
settingsCAStore :: CertificateStore
settingsServerNameOverride :: Maybe HostName
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
..} HostName
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
}
}
defaultAuthority :: HostName -> Authority
defaultAuthority :: HostName -> HostName
defaultAuthority = HostName -> HostName
forall a. a -> a
id
getClientParams
:: Settings
-> HostName
-> PortNumber
-> ByteString
-> ClientParams
getClientParams :: Settings -> HostName -> PortNumber -> Scheme -> ClientParams
getClientParams Settings{Bool
Int
[(Scheme, SessionData)]
[AddrInfoFlag]
Maybe HostName
Maybe (Scheme, SessionData)
CertificateStore
SessionManager
HostName -> IO ()
AddrInfo -> IO Socket
Information -> IO ()
settingsKeyLogger :: Settings -> HostName -> IO ()
settingsValidateCert :: Settings -> Bool
settingsCAStore :: Settings -> CertificateStore
settingsAddrInfoFlags :: Settings -> [AddrInfoFlag]
settingsCacheLimit :: Settings -> Int
settingsConcurrentStreams :: Settings -> Int
settingsConnectionWindowSize :: Settings -> Int
settingsStreamWindowSize :: Settings -> Int
settingsServerNameOverride :: Settings -> Maybe HostName
settingsSessionManager :: Settings -> SessionManager
settingsWantSessionResume :: Settings -> Maybe (Scheme, SessionData)
settingsWantSessionResumeList :: Settings -> [(Scheme, SessionData)]
settingsOpenClientSocket :: Settings -> AddrInfo -> IO Socket
settingsUseEarlyData :: Settings -> Bool
settingsOnServerFinished :: Settings -> Information -> IO ()
settingsPingRateLimit :: Settings -> Int
settingsEmptyFrameRateLimit :: Settings -> Int
settingsSettingsRateLimit :: Settings -> Int
settingsRstRateLimit :: Settings -> Int
settingsKeyLogger :: HostName -> IO ()
settingsValidateCert :: Bool
settingsCAStore :: CertificateStore
settingsServerNameOverride :: Maybe HostName
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
..} HostName
serverName PortNumber
port Scheme
alpn =
(HostName -> Scheme -> ClientParams
defaultParamsClient HostName
serverName (HostName -> Scheme
BS.C8.pack (HostName -> Scheme) -> HostName -> Scheme
forall a b. (a -> b) -> a -> b
$ PortNumber -> HostName
forall a. Show a => a -> HostName
show PortNumber
port))
{ clientSupported = supported
, clientWantSessionResume = settingsWantSessionResume
, clientWantSessionResumeList = settingsWantSessionResumeList
, clientUseServerNameIndication = True
, clientShared = shared
, clientHooks = hooks
, clientDebug = debug
, clientUseEarlyData = settingsUseEarlyData
}
where
shared :: Shared
shared =
Shared
defaultShared
{ sharedValidationCache = validateCache
, sharedCAStore = settingsCAStore
, sharedSessionManager = settingsSessionManager
}
supported :: Supported
supported = Supported
strongSupported
hooks :: ClientHooks
hooks =
ClientHooks
defaultClientHooks
{ onSuggestALPN = return $ Just [alpn]
, onServerCertificate = validateCert
, onServerFinished = settingsOnServerFinished
}
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 ())
validateCert :: CertificateStore
-> ValidationCache
-> ServiceID
-> CertificateChain
-> IO [FailedReason]
validateCert
| Bool
settingsValidateCert = CertificateStore
-> ValidationCache
-> ServiceID
-> CertificateChain
-> IO [FailedReason]
validateDefault
| Bool
otherwise = \CertificateStore
_ ValidationCache
_ ServiceID
_ CertificateChain
_ -> [FailedReason] -> IO [FailedReason]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
debug :: DebugParams
debug =
DebugParams
defaultDebugParams
{ debugKeyLogger = settingsKeyLogger
}