From 38d838e0eb9e4892266c2b5751fdd70ad846045d Mon Sep 17 00:00:00 2001 From: Ben Franksen Date: Wed, 15 May 2024 16:14:49 +0200 Subject: [PATCH] add support for overriding the TLS clientSupported member in TLSSettingsSimple This is so we can manipulate these TLS settings even when using a connection manager like the http-client package does. See https://github.com/kazu-yamamoto/crypton-connection/issues/2 for details. --- Network/Connection.hs | 5 ++++- Network/Connection/Types.hs | 5 ++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/Network/Connection.hs b/Network/Connection.hs index 800c6d1..57cff77 100644 --- a/Network/Connection.hs +++ b/Network/Connection.hs @@ -123,7 +123,10 @@ initConnectionContext = ConnectionContext <$> getSystemCertificateStore makeTLSParams :: ConnectionContext -> ConnectionID -> TLSSettings -> TLS.ClientParams makeTLSParams cg cid ts@(TLSSettingsSimple {}) = (TLS.defaultParamsClient (fst cid) portString) - { TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_default } + { TLS.clientSupported = + case settingClientSupported ts of + Nothing -> def { TLS.supportedCiphers = TLS.ciphersuite_default } + Just cs -> cs , TLS.clientShared = def { TLS.sharedCAStore = globalCertificateStore cg , TLS.sharedValidationCache = validationCache diff --git a/Network/Connection/Types.hs b/Network/Connection/Types.hs index f8fc725..0f21282 100644 --- a/Network/Connection/Types.hs +++ b/Network/Connection/Types.hs @@ -75,12 +75,15 @@ data TLSSettings -- will always re-established their context. -- Not Implemented Yet. , settingUseServerName :: Bool -- ^ Use server name extension. Not Implemented Yet. + , settingClientSupported :: Maybe TLS.Supported + -- ^ Override defaults for the 'TLS.clientSupported' + -- member of 'TLS.ClientParams'. } -- ^ Simple TLS settings. recommended to use. | TLSSettings TLS.ClientParams -- ^ full blown TLS Settings directly using TLS.Params. for power users. deriving (Show) instance Default TLSSettings where - def = TLSSettingsSimple False False False + def = TLSSettingsSimple False False False Nothing type ConnectionID = (HostName, PortNumber)