diff --git a/changelog.d/5-internal/reuse-manager b/changelog.d/5-internal/reuse-manager deleted file mode 100644 index 7ef933fd20..0000000000 --- a/changelog.d/5-internal/reuse-manager +++ /dev/null @@ -1,4 +0,0 @@ -- reuse the http manager wherever possible -- don't reuse the http manager in legalhold scenarios -- don't concurrently modify the ssl context in such ways that - it can create race conditions diff --git a/integration/integration.cabal b/integration/integration.cabal index eac2272713..c95eb9ecd7 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -24,7 +24,6 @@ common common-all ghc-options: -Wall -Wpartial-fields -fwarn-tabs -Wno-incomplete-uni-patterns - -- NoImportQualifiedPost is required default-extensions: AllowAmbiguousTypes BangPatterns diff --git a/libs/bilge/src/Bilge/IO.hs b/libs/bilge/src/Bilge/IO.hs index f9ec36060e..f1fa331ea0 100644 --- a/libs/bilge/src/Bilge/IO.hs +++ b/libs/bilge/src/Bilge/IO.hs @@ -162,7 +162,7 @@ instance MonadIO m => MonadHttp (SessionT m) where Wai.requestHeaderReferer = lookupHeader "REFERER" req, Wai.requestHeaderUserAgent = lookupHeader "USER-AGENT" req } - toBilgeResponse :: BodyReader -> WaiTest.SResponse -> Request -> Response BodyReader + toBilgeResponse :: BodyReader -> WaiTest.SResponse -> Client.Request -> Response BodyReader toBilgeResponse bodyReader WaiTest.SResponse {WaiTest.simpleStatus, WaiTest.simpleHeaders} originalReq = Client.Response { responseStatus = simpleStatus, @@ -171,6 +171,7 @@ instance MonadIO m => MonadHttp (SessionT m) where responseHeaders = simpleHeaders, responseBody = bodyReader, responseOriginalRequest = originalReq, + responseEarlyHints = [], Client.responseCookieJar = mempty, Client.responseClose' = Client.ResponseClose $ pure () } diff --git a/libs/ssl-util/default.nix b/libs/ssl-util/default.nix index 7c3753ef17..1ec717b7f7 100644 --- a/libs/ssl-util/default.nix +++ b/libs/ssl-util/default.nix @@ -8,10 +8,10 @@ , bytestring , gitignoreSource , HsOpenSSL +, http-client , imports , lib , time -, types-common }: mkDerivation { pname = "ssl-util"; @@ -22,9 +22,9 @@ mkDerivation { byteable bytestring HsOpenSSL + http-client imports time - types-common ]; description = "SSL-related utilities"; license = lib.licenses.agpl3Only; diff --git a/libs/ssl-util/src/Ssl/Util.hs b/libs/ssl-util/src/Ssl/Util.hs index 1598c100bf..9f9d8ece4e 100644 --- a/libs/ssl-util/src/Ssl/Util.hs +++ b/libs/ssl-util/src/Ssl/Util.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeApplications #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -26,27 +28,25 @@ module Ssl.Util -- * Cipher suites rsaCiphers, - -- * to be used when initializing SSL Contexts to obtain SSL enabled - - -- 'Network.HTTP.Client.ManagerSettings' - extEnvCallback, + -- * Network + withVerifiedSslConnection, ) where import Control.Exception import Data.ByteString.Builder import Data.Byteable (constEqBytes) -import Data.Misc (Fingerprint (fingerprintBytes), Rsa) +import Data.Dynamic (fromDynamic) import Data.Time.Clock (getCurrentTime) import Imports +import Network.HTTP.Client.Internal import OpenSSL.BN (integerToMPI) -import OpenSSL.EVP.Digest (Digest, digestLBS, getDigestByName) +import OpenSSL.EVP.Digest (Digest, digestLBS) import OpenSSL.EVP.PKey (SomePublicKey, toPublicKey) import OpenSSL.EVP.Verify (VerifyStatus (..)) import OpenSSL.RSA import OpenSSL.Session as SSL import OpenSSL.X509 as X509 -import OpenSSL.X509.Store (X509StoreCtx, getStoreCtxCert) -- Cipher Suites ------------------------------------------------------------ @@ -180,29 +180,34 @@ verifyRsaFingerprint d = verifyFingerprint $ \pk -> -- [1] https://wiki.openssl.org/index.php/Hostname_validation -- [2] https://www.cs.utexas.edu/~shmat/shmat_ccs12.pdf --- | this is used as a 'OpenSSL.Session.vpCallback' in 'Brig.App.initExtGetManager' --- and 'Galley.Env.initExtEnv' -extEnvCallback :: IORef [Fingerprint Rsa] -> X509StoreCtx -> IO Bool -extEnvCallback fingerprints store = do - Just sha <- getDigestByName "SHA256" - cert <- getStoreCtxCert store - pk <- getPublicKey cert - fprs <- readIORef fingerprints - case toPublicKey @RSAPubKey pk of - Nothing -> pure False - Just k -> do - fp <- rsaFingerprint sha k - -- find at least one matching fingerprint to continue - if not (any (constEqBytes fp . fingerprintBytes) fprs) - then pure False - else do - -- Check if the certificate is self-signed. - self <- verifyX509 cert pk - if (self /= VerifySuccess) - then pure False - else do - -- For completeness, perform a date check as well. - now <- getCurrentTime - notBefore <- getNotBefore cert - notAfter <- getNotAfter cert - pure (now >= notBefore && now <= notAfter) +-- Utilities ----------------------------------------------------------------- + +-- | Get an SSL connection that has definitely had its fingerprints checked +-- (internally it just grabs a connection from a pool and does verification +-- if it's a fresh one). +-- +-- Throws an error for other types of connections. +withVerifiedSslConnection :: + -- | A function to verify fingerprints given an SSL connection + (SSL -> IO ()) -> + Manager -> + -- | Request builder + (Request -> Request) -> + -- | This callback will be passed a modified + -- request that always uses the verified + -- connection + (Request -> IO a) -> + IO a +withVerifiedSslConnection verify man reqBuilder act = + withConnection' req man Reuse $ \mConn -> do + -- If we see this connection for the first time, verify fingerprints + let conn = managedResource mConn + seen = managedReused mConn + unless seen $ case fromDynamic @SSL (connectionRaw conn) of + Nothing -> error ("withVerifiedSslConnection: only SSL allowed: " <> show req) + Just ssl -> verify ssl + -- Make a request using this connection and return it back to the + -- pool (that's what 'Reuse' is for) + act req {connectionOverride = Just mConn} + where + req = reqBuilder defaultRequest diff --git a/libs/ssl-util/ssl-util.cabal b/libs/ssl-util/ssl-util.cabal index 34deab65ed..9c306e564e 100644 --- a/libs/ssl-util/ssl-util.cabal +++ b/libs/ssl-util/ssl-util.cabal @@ -63,12 +63,12 @@ library -Wredundant-constraints -Wunused-packages build-depends: - base >=4.7 && <5 - , byteable >=0.1 - , bytestring >=0.10 - , HsOpenSSL >=0.11 + base >=4.7 && <5 + , byteable >=0.1 + , bytestring >=0.10 + , HsOpenSSL >=0.11 + , http-client >=0.7 , imports - , time >=1.5 - , types-common + , time >=1.5 default-language: GHC2021 diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index 587fce7e9a..88be5c9094 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -116,6 +116,21 @@ let }; }; + # Our fork because we need to a few special things + http-client = { + src = fetchgit { + url = "https://github.com/wireapp/http-client"; + rev = "37494bb9a89dd52f97a8dc582746c6ff52943934"; + sha256 = "sha256-z47GlT+tHsSlRX4ApSGQIpOpaZiBeqr72/tWuvzw8tc="; + }; + packages = { + "http-client" = "http-client"; + "http-client-tls" = "http-client-tls"; + "http-client-openssl" = "http-client-openssl"; + "http-conduit" = "http-conduit"; + }; + }; + # PR: https://github.com/hspec/hspec-wai/pull/49 hspec-wai = { src = fetchgit { diff --git a/nix/manual-overrides.nix b/nix/manual-overrides.nix index b8d22ef366..90db54af1d 100644 --- a/nix/manual-overrides.nix +++ b/nix/manual-overrides.nix @@ -48,7 +48,6 @@ hself: hsuper: { # (these are fine but will probably need to be adjusted in a future nixpkgs update) # ----------------- hpack = hsuper.hpack_0_36_0; - http-client-tls = hsuper.http-client-tls_0_3_6_3; linear-generics = hsuper.linear-generics_0_2_2; network-conduit-tls = hsuper.network-conduit-tls_1_4_0; optparse-generic = hsuper.optparse-generic_1_5_2; diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 2af5345890..0d0487355e 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -464,7 +464,7 @@ executable brig-integration , HsOpenSSL , http-api-data , http-client - , http-client-tls >=0.3.6.3 + , http-client-tls >=0.3 , http-media , http-reverse-proxy , http-types diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 8555db5fec..8ead8601f9 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -46,7 +46,6 @@ module Brig.App httpManager, http2Manager, extGetManager, - initExtGetManager, nexmoCreds, twilioCreds, settings, @@ -73,7 +72,7 @@ module Brig.App -- * Crutches that should be removed once Brig has been completely - -- transitioned to Polysemy + -- * transitioned to Polysemy wrapClient, wrapClientE, wrapClientM, @@ -114,7 +113,8 @@ import Control.Error import Control.Lens hiding (index, (.=)) import Control.Monad.Catch import Control.Monad.Trans.Resource -import Data.Domain (Domain) +import Data.ByteString.Conversion +import Data.Domain import Data.Metrics (Metrics) import Data.Metrics.Middleware qualified as Metrics import Data.Misc @@ -175,7 +175,7 @@ data Env = Env _templateBranding :: TemplateBranding, _httpManager :: Manager, _http2Manager :: Http2Manager, - _extGetManager :: (Manager, IORef [Fingerprint Rsa]), + _extGetManager :: (Manager, [Fingerprint Rsa] -> SSL.SSL -> IO ()), _settings :: Settings, _nexmoCreds :: Nexmo.Credentials, _twilioCreds :: Twilio.Credentials, @@ -213,6 +213,7 @@ newEnv o = do cas <- initCassandra o lgr mgr <- initHttpManager h2Mgr <- initHttp2Manager + ext <- initExtGetManager utp <- loadUserTemplates o ptp <- loadProviderTemplates o ttp <- loadTeamTemplates o @@ -250,8 +251,6 @@ newEnv o = do pure Nothing kpLock <- newMVar () rabbitChan <- traverse (Q.mkRabbitMqChannelMVar lgr) o.rabbitmq - fprVar <- newIORef [] - extMgr <- initExtGetManager fprVar let allDisabledVersions = foldMap expandVersionExp (Opt.setDisabledAPIVersions sett) pure $! @@ -275,7 +274,7 @@ newEnv o = do _templateBranding = branding, _httpManager = mgr, _http2Manager = h2Mgr, - _extGetManager = (extMgr, fprVar), + _extGetManager = ext, _settings = sett, _nexmoCreds = nxm, _twilioCreds = twl, @@ -368,28 +367,29 @@ initHttp2Manager = do -- faster. So, we reuse the context. -- TODO: somewhat duplicates Galley.App.initExtEnv -initExtGetManager :: IORef [Fingerprint Rsa] -> IO Manager -initExtGetManager fprVar = do +initExtGetManager :: IO (Manager, [Fingerprint Rsa] -> SSL.SSL -> IO ()) +initExtGetManager = do ctx <- SSL.context SSL.contextAddOption ctx SSL_OP_NO_SSLv2 SSL.contextAddOption ctx SSL_OP_NO_SSLv3 SSL.contextSetCiphers ctx rsaCiphers - SSL.contextSetVerificationMode - ctx - SSL.VerifyPeer - { vpFailIfNoPeerCert = True, - vpClientOnce = True, - vpCallback = Just \_b -> extEnvCallback fprVar - } - + -- We use public key pinning with service providers and want to + -- support self-signed certificates as well, hence 'VerifyNone'. + SSL.contextSetVerificationMode ctx SSL.VerifyNone SSL.contextSetDefaultVerifyPaths ctx - - newManager - (opensslManagerSettings (pure ctx)) -- see Note [SSL context] - { managerConnCount = 100, - managerIdleConnectionCount = 512, - managerResponseTimeout = responseTimeoutMicro 10000000 - } + mgr <- + newManager + (opensslManagerSettings (pure ctx)) -- see Note [SSL context] + { managerConnCount = 100, + managerIdleConnectionCount = 512, + managerResponseTimeout = responseTimeoutMicro 10000000 + } + Just sha <- getDigestByName "SHA256" + pure (mgr, mkVerify sha) + where + mkVerify sha fprs = + let pinset = map toByteString' fprs + in verifyRsaFingerprint sha pinset initCassandra :: Opts -> Logger -> IO Cas.ClientState initCassandra o g = diff --git a/services/brig/src/Brig/Provider/RPC.hs b/services/brig/src/Brig/Provider/RPC.hs index ae42498e4f..fd91cac91b 100644 --- a/services/brig/src/Brig/Provider/RPC.hs +++ b/services/brig/src/Brig/Provider/RPC.hs @@ -35,7 +35,7 @@ import Brig.App import Brig.Provider.DB (ServiceConn (..)) import Brig.RPC import Control.Error -import Control.Lens (set, (^.)) +import Control.Lens (set, view, (^.)) import Control.Monad.Catch import Control.Retry (recovering) import Data.Aeson @@ -49,6 +49,7 @@ import Imports import Network.HTTP.Client qualified as Http import Network.HTTP.Types.Method import Network.HTTP.Types.Status +import Ssl.Util (withVerifiedSslConnection) import System.Logger.Class (MonadLogger, field, msg, val, (~~)) import System.Logger.Class qualified as Log import URI.ByteString @@ -71,18 +72,16 @@ data ServiceError createBot :: ServiceConn -> NewBotRequest -> ExceptT ServiceError (AppT r) NewBotResponse createBot scon new = do let fprs = toList (sconFingerprints scon) - -- fresh http manager - man <- liftIO do - initExtGetManager =<< newIORef fprs + (man, verifyFingerprints) <- view extGetManager extHandleAll onExc $ do - let req = reqBuilder Http.defaultRequest rs <- lift $ wrapHttp $ recovering x3 httpHandlers $ const $ liftIO $ - Http.withConnection req man $ - \_conn -> Http.httpLbs req man + withVerifiedSslConnection (verifyFingerprints fprs) man reqBuilder $ + \req -> + Http.httpLbs req man case Bilge.statusCode rs of 201 -> decodeBytes "External" (responseBody rs) 409 -> throwE ServiceBotConflict diff --git a/services/cargohold/cargohold.cabal b/services/cargohold/cargohold.cabal index b82b8218b5..7723b5814f 100644 --- a/services/cargohold/cargohold.cabal +++ b/services/cargohold/cargohold.cabal @@ -272,7 +272,7 @@ executable cargohold-integration , federator , http-api-data , http-client >=0.7 - , http-client-tls >=0.3.6.3 + , http-client-tls >=0.3 , http-media , http-types >=0.8 , imports diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 1c40172da3..e646ea232c 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -25,7 +25,6 @@ common common-all default-extensions: AllowAmbiguousTypes BangPatterns - BlockArguments ConstraintKinds DataKinds DefaultSignatures diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 8004879993..14873001de 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -30,7 +30,9 @@ module Galley.App cstate, deleteQueue, createEnv, + extEnv, aEnv, + ExtEnv (..), extGetManager, -- * Running Galley effects @@ -158,11 +160,9 @@ createEnv m o l = do mgr <- initHttpManager o h2mgr <- initHttp2Manager codeURIcfg <- validateOptions o - fprVar <- newIORef [] - extEnv <- initExtEnv fprVar Env (RequestId "N/A") m o l mgr h2mgr (o ^. O.federator) (o ^. O.brig) cass <$> Q.new 16000 - <*> pure (extEnv, fprVar) + <*> initExtEnv <*> maybe (pure Nothing) (fmap Just . Aws.mkEnv l mgr) (o ^. journal) <*> loadAllMLSKeys (fold (o ^. settings . mlsPrivateKeyPaths)) <*> traverse (mkRabbitMqChannelMVar l) (o ^. rabbitmq) diff --git a/services/galley/src/Galley/Env.hs b/services/galley/src/Galley/Env.hs index b4e43adf16..2bdb38c27f 100644 --- a/services/galley/src/Galley/Env.hs +++ b/services/galley/src/Galley/Env.hs @@ -22,9 +22,10 @@ module Galley.Env where import Cassandra import Control.Lens hiding ((.=)) +import Data.ByteString.Conversion (toByteString') import Data.Id import Data.Metrics.Middleware -import Data.Misc (Fingerprint (..), HttpsUrl, Rsa) +import Data.Misc (Fingerprint, HttpsUrl, Rsa) import Data.Range import Galley.Aws qualified as Aws import Galley.Options @@ -35,6 +36,7 @@ import Imports import Network.AMQP qualified as Q import Network.HTTP.Client import Network.HTTP.Client.OpenSSL +import OpenSSL.EVP.Digest import OpenSSL.Session as Ssl import Ssl.Util import System.Logger @@ -54,42 +56,49 @@ data Env = Env _applog :: Logger, _manager :: Manager, _http2Manager :: Http2Manager, - _federator :: Maybe Endpoint, -- FUTUREWORK: should we use a better type ----- LegalHold.testLHClaimKeys01 FAIL (34.01 s) -----here? E.g. to avoid fresh connections all the time? + _federator :: Maybe Endpoint, -- FUTUREWORK: should we use a better type here? E.g. to avoid fresh connections all the time? _brig :: Endpoint, -- FUTUREWORK: see _federator _cstate :: ClientState, _deleteQueue :: Q.Queue DeleteItem, - _extGetManager :: (Manager, IORef [Fingerprint Rsa]), + _extEnv :: ExtEnv, _aEnv :: Maybe Aws.Env, _mlsKeys :: SignaturePurpose -> MLSKeys, _rabbitmqChannel :: Maybe (MVar Q.Channel), _convCodeURI :: Either HttpsUrl (Map Text HttpsUrl) } +-- | Environment specific to the communication with external +-- service providers. +data ExtEnv = ExtEnv + { _extGetManager :: (Manager, [Fingerprint Rsa] -> Ssl.SSL -> IO ()) + } + makeLenses ''Env +makeLenses ''ExtEnv + -- TODO: somewhat duplicates Brig.App.initExtGetManager -initExtEnv :: IORef [Fingerprint Rsa] -> IO Manager -initExtEnv fingerprints = do +initExtEnv :: IO ExtEnv +initExtEnv = do ctx <- Ssl.context + Ssl.contextSetVerificationMode ctx Ssl.VerifyNone Ssl.contextAddOption ctx SSL_OP_NO_SSLv2 Ssl.contextAddOption ctx SSL_OP_NO_SSLv3 Ssl.contextAddOption ctx SSL_OP_NO_TLSv1 Ssl.contextSetCiphers ctx rsaCiphers - Ssl.contextSetVerificationMode - ctx - Ssl.VerifyPeer - { vpFailIfNoPeerCert = True, - vpClientOnce = False, - vpCallback = Just \_b -> extEnvCallback fingerprints - } - Ssl.contextSetDefaultVerifyPaths ctx - - newManager - (opensslManagerSettings (pure ctx)) - { managerResponseTimeout = responseTimeoutMicro 10000000, - managerConnCount = 100 - } + mgr <- + newManager + (opensslManagerSettings (pure ctx)) + { managerResponseTimeout = responseTimeoutMicro 10000000, + managerConnCount = 100 + } + Just sha <- getDigestByName "SHA256" + pure $ ExtEnv (mgr, mkVerify sha) + where + mkVerify sha fprs = + let pinset = map toByteString' fprs + in verifyRsaFingerprint sha pinset reqIdMsg :: RequestId -> Msg -> Msg reqIdMsg = ("request" .=) . unRequestId diff --git a/services/galley/src/Galley/External.hs b/services/galley/src/Galley/External.hs index f56ff3c538..605ac731d0 100644 --- a/services/galley/src/Galley/External.hs +++ b/services/galley/src/Galley/External.hs @@ -34,12 +34,12 @@ import Galley.Intra.User import Galley.Monad import Galley.Types.Bot.Service (Service, serviceEnabled, serviceFingerprints, serviceToken, serviceUrl) import Imports -import Network.HTTP.Client (defaultRequest, withConnection) import Network.HTTP.Client qualified as Http import Network.HTTP.Types.Method import Network.HTTP.Types.Status (status410) import Polysemy import Polysemy.Input +import Ssl.Util (withVerifiedSslConnection) import System.Logger.Class qualified as Log import System.Logger.Message (field, msg, val, (~~)) import URI.ByteString @@ -151,10 +151,8 @@ urlPort (HttpsUrl u) = do sendMessage :: [Fingerprint Rsa] -> (Request -> Request) -> App () sendMessage fprs reqBuilder = do - (man, fprVar) <- view extGetManager - modifyIORef' fprVar (nub . (<> fprs)) - let req = reqBuilder defaultRequest - liftIO $ withConnection req man $ \_conn -> + (man, verifyFingerprints) <- view (extEnv . extGetManager) + liftIO . withVerifiedSslConnection (verifyFingerprints fprs) man reqBuilder $ \req -> Http.withResponse req man (const $ pure ()) x3 :: RetryPolicy diff --git a/services/galley/src/Galley/External/LegalHoldService/Internal.hs b/services/galley/src/Galley/External/LegalHoldService/Internal.hs index d34acd22b5..6923ebf02d 100644 --- a/services/galley/src/Galley/External/LegalHoldService/Internal.hs +++ b/services/galley/src/Galley/External/LegalHoldService/Internal.hs @@ -34,20 +34,23 @@ import Galley.Env import Galley.Monad import Imports import Network.HTTP.Client qualified as Http +import OpenSSL.Session qualified as SSL +import Ssl.Util import System.Logger.Class qualified as Log import URI.ByteString (uriPath) -- | Check that the given fingerprint is valid and make the request over ssl. -- If the team has a device registered use 'makeLegalHoldServiceRequest' instead. -makeVerifiedRequestWithManager :: Http.Manager -> HttpsUrl -> (Http.Request -> Http.Request) -> App (Http.Response LC8.ByteString) -makeVerifiedRequestWithManager mgr (HttpsUrl url) reqBuilder = do - let req = reqBuilderMods . reqBuilder $ Http.defaultRequest +makeVerifiedRequestWithManager :: Http.Manager -> ([Fingerprint Rsa] -> SSL.SSL -> IO ()) -> Fingerprint Rsa -> HttpsUrl -> (Http.Request -> Http.Request) -> App (Http.Response LC8.ByteString) +makeVerifiedRequestWithManager mgr verifyFingerprints fpr (HttpsUrl url) reqBuilder = do + let verified = verifyFingerprints [fpr] extHandleAll errHandler $ do recovering x3 httpHandlers $ const $ liftIO $ - Http.withConnection req mgr $ \_conn -> - Http.httpLbs req mgr + withVerifiedSslConnection verified mgr (reqBuilderMods . reqBuilder) $ + \req -> + Http.httpLbs req mgr where reqBuilderMods = maybe id Bilge.host (Bilge.extHost url) @@ -78,9 +81,8 @@ makeVerifiedRequest :: (Http.Request -> Http.Request) -> App (Http.Response LC8.ByteString) makeVerifiedRequest fpr url reqBuilder = do - (mgr, fprVar) <- view extGetManager - modifyIORef' fprVar (nub . (fpr :)) - makeVerifiedRequestWithManager mgr url reqBuilder + (mgr, verifyFingerprints) <- view (extEnv . extGetManager) + makeVerifiedRequestWithManager mgr verifyFingerprints fpr url reqBuilder -- | NOTE: Use this function wisely - this creates a new manager _every_ time it is called. -- We should really _only_ use it in `checkLegalHoldServiceStatus` for the time being because @@ -92,5 +94,5 @@ makeVerifiedRequestFreshManager :: (Http.Request -> Http.Request) -> App (Http.Response LC8.ByteString) makeVerifiedRequestFreshManager fpr url reqBuilder = do - mgr <- liftIO . initExtEnv =<< newIORef [fpr] - makeVerifiedRequestWithManager mgr url reqBuilder + ExtEnv (mgr, verifyFingerprints) <- liftIO initExtEnv + makeVerifiedRequestWithManager mgr verifyFingerprints fpr url reqBuilder diff --git a/services/gundeck/gundeck.cabal b/services/gundeck/gundeck.cabal index af1d57c662..ce1b2c82ac 100644 --- a/services/gundeck/gundeck.cabal +++ b/services/gundeck/gundeck.cabal @@ -131,7 +131,7 @@ library , gundeck-types >=1.0 , hedis >=0.14.0 , http-client >=0.7 - , http-client-tls >=0.3.6.3 + , http-client-tls >=0.3 , http-types >=0.8 , imports , lens >=4.4 diff --git a/services/proxy/proxy.cabal b/services/proxy/proxy.cabal index 4e7f7e5302..79da68ca4e 100644 --- a/services/proxy/proxy.cabal +++ b/services/proxy/proxy.cabal @@ -83,7 +83,7 @@ library , exceptions >=0.8 , extended , http-client >=0.7 - , http-client-tls >=0.3.6.3 + , http-client-tls >=0.3 , http-reverse-proxy >=0.4 , http-types >=0.9 , imports