diff --git a/Network/HTTP2/TLS/Client.hs b/Network/HTTP2/TLS/Client.hs --- a/Network/HTTP2/TLS/Client.hs +++ b/Network/HTTP2/TLS/Client.hs @@ -26,6 +26,7 @@ defaultSettings, settingsKeyLogger, settingsValidateCert, + settingsOnServerCertificate, settingsCAStore, settingsAddrInfoFlags, settingsCacheLimit, @@ -33,6 +34,7 @@ settingsConnectionWindowSize, settingsStreamWindowSize, settingsServerNameOverride, + settingsUseServerNameIndication, settingsSessionManager, settingsWantSessionResume, settingsWantSessionResumeList, @@ -51,13 +53,13 @@ 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 System.X509 (getSystemCertificateStore) import Network.HTTP2.TLS.Client.Settings import Network.HTTP2.TLS.Config @@ -120,20 +122,14 @@ runTCPClientWithSettings tcpSettings serverName (show port) $ \sock -> do mysa <- getSocketName sock peersa <- getPeerName sock + params <- getClientParams settings sni port alpn ctx <- contextNew sock params handshake ctx r <- action ctx mysa peersa bye ctx return r where - -- TLS client parameters - params :: ClientParams - params = - getClientParams - settings - (fromMaybe (H2Client.authority cliconf) $ settingsServerNameOverride) - port - alpn + sni = fromMaybe (H2Client.authority cliconf) $ settingsServerNameOverride tcpSettings = TCP.defaultSettings { TCP.settingsOpenClientSocket = settingsOpenClientSocket @@ -229,33 +225,38 @@ -- [ServiceID](https://hackage.haskell.org/package/x509-validation-1.6.12/docs/Data-X509-Validation.html#t:ServiceID). -> ByteString -- ^ ALPN - -> ClientParams -getClientParams Settings{..} serverName port alpn = + -> IO ClientParams +getClientParams Settings{..} sni port alpn = do + caStore <- + if settingsValidateCert + then getSystemCertificateStore + else return mempty + let shared = + defaultShared + { sharedValidationCache = validateCache + , sharedCAStore = caStore + , sharedSessionManager = settingsSessionManager + } -- RFC 4366 mandates UTF-8 for SNI -- - (defaultParamsClient serverName (BS.C8.pack $ show port)) - { clientSupported = supported - , clientWantSessionResume = settingsWantSessionResume - , clientWantSessionResumeList = settingsWantSessionResumeList - , clientUseServerNameIndication = True - , clientShared = shared - , clientHooks = hooks - , clientDebug = debug - , clientUseEarlyData = settingsUseEarlyData - } - where - shared = - defaultShared - { sharedValidationCache = validateCache - , sharedCAStore = settingsCAStore - , sharedSessionManager = settingsSessionManager + return + (defaultParamsClient sni (BS.C8.pack $ show port)) + { clientSupported = supported + , clientWantSessionResume = settingsWantSessionResume + , clientWantSessionResumeList = settingsWantSessionResumeList + , clientUseServerNameIndication = settingsUseServerNameIndication + , clientShared = shared + , clientHooks = hooks + , clientDebug = debug + , clientUseEarlyData = settingsUseEarlyData } + where supported = strongSupported hooks = defaultClientHooks { onSuggestALPN = return $ Just [alpn] - , onServerCertificate = validateCert , onServerFinished = settingsOnServerFinished + , onServerCertificate = settingsOnServerCertificate } validateCache | settingsValidateCert = defaultValidationCache @@ -263,9 +264,6 @@ ValidationCache (\_ _ _ -> return ValidationCachePass) (\_ _ _ -> return ()) - validateCert - | settingsValidateCert = validateDefault - | otherwise = \_ _ _ _ -> return [] debug = defaultDebugParams { debugKeyLogger = settingsKeyLogger diff --git a/Network/HTTP2/TLS/Client/Settings.hs b/Network/HTTP2/TLS/Client/Settings.hs --- a/Network/HTTP2/TLS/Client/Settings.hs +++ b/Network/HTTP2/TLS/Client/Settings.hs @@ -1,6 +1,7 @@ module Network.HTTP2.TLS.Client.Settings where import Data.X509.CertificateStore (CertificateStore) +import Data.X509.Validation (validateDefault) import Network.Socket import Network.Control @@ -11,6 +12,7 @@ import Network.Run.TCP (openClientSocket) import Network.TLS ( Information, + OnServerCertificate, SessionData, SessionID, SessionManager, @@ -31,8 +33,12 @@ -- -- >>> settingsValidateCert defaultSettings -- True + , settingsOnServerCertificate :: OnServerCertificate + -- ^ How to validate server certificates. + -- + -- Default: 'validateDefault' , settingsCAStore :: CertificateStore - -- ^ Certificate store used for validation. (TLS and H2) + -- ^ Obsoleted. -- -- Default: 'mempty'. , settingsServerNameOverride :: Maybe HostName @@ -44,6 +50,10 @@ -- be different (for example in the case of domain fronting); -- 'settingsServerNameOverride' can be used to give SNI a different value -- than @:authority@. + , settingsUseServerNameIndication :: Bool + -- ^ If 'True', SNI is used. Otherwise, the SNI extension is not sent. + -- + -- Default: 'True' , settingsAddrInfoFlags :: [AddrInfoFlag] -- ^ Obsoleted. , settingsCacheLimit :: Int @@ -121,8 +131,10 @@ Settings { settingsKeyLogger = defaultKeyLogger , settingsValidateCert = True + , settingsOnServerCertificate = validateDefault , settingsCAStore = mempty , settingsServerNameOverride = Nothing + , settingsUseServerNameIndication = True , settingsAddrInfoFlags = [] , settingsCacheLimit = cacheLimit defaultClientConfig , settingsConcurrentStreams = defaultMaxStreams diff --git a/http2-tls.cabal b/http2-tls.cabal --- a/http2-tls.cabal +++ b/http2-tls.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: http2-tls -version: 0.4.6 +version: 0.4.7 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto @@ -39,6 +39,7 @@ base >=4.9 && <5, bytestring >=0.10, crypton-x509-store >=1.6 && <1.7, + crypton-x509-system >=1.6 && <1.7, crypton-x509-validation >=1.6 && <1.7, http2 >=5.3.9 && <5.4, network >=3.1.4,