Migrate from http-client fork, use upstream.

integration/integration.cabal

@@ -24,6 +24,7 @@ common common-all
   ghc-options:
     -Wall -Wpartial-fields -fwarn-tabs -Wno-incomplete-uni-patterns
 
+  -- NoImportQualifiedPost is required
   default-extensions:
     AllowAmbiguousTypes
     BangPatterns

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 -> Client.Request -> Response BodyReader
+      toBilgeResponse :: BodyReader -> WaiTest.SResponse -> Request -> Response BodyReader
       toBilgeResponse bodyReader WaiTest.SResponse {WaiTest.simpleStatus, WaiTest.simpleHeaders} originalReq =
         Client.Response
           { responseStatus = simpleStatus,

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;

libs/ssl-util/src/Ssl/Util.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
-
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
@@ -28,25 +26,27 @@ module Ssl.Util
     -- * Cipher suites
     rsaCiphers,
 
-    -- * Network
-    withVerifiedSslConnection,
+    -- * to be used when initializing SSL Contexts to obtain SSL enabled
+
+    --   'Network.HTTP.Client.ManagerSettings'
+    extEnvCallback,
   )
 where
 
 import Control.Exception
 import Data.ByteString.Builder
 import Data.Byteable (constEqBytes)
-import Data.Dynamic (fromDynamic)
+import Data.Misc (Fingerprint (fingerprintBytes), Rsa)
 import Data.Time.Clock (getCurrentTime)
 import Imports
-import Network.HTTP.Client.Internal
 import OpenSSL.BN (integerToMPI)
-import OpenSSL.EVP.Digest (Digest, digestLBS)
+import OpenSSL.EVP.Digest (Digest, digestLBS, getDigestByName)
 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,34 +180,28 @@ verifyRsaFingerprint d = verifyFingerprint $ \pk ->
 -- [1] https://wiki.openssl.org/index.php/Hostname_validation
 -- [2] https://www.cs.utexas.edu/~shmat/shmat_ccs12.pdf
 
--- 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
+-- | this is used as a 'OpenSSL.Session.vpCallback' in 'Brig.App.initExtGetManager'
+--   and 'Galley.Env.initExtEnv'
+extEnvCallback :: [Fingerprint Rsa] -> X509StoreCtx -> IO Bool
+extEnvCallback fingerprints store = do
+  Just sha <- getDigestByName "SHA256"
+  cert <- getStoreCtxCert store
+  pk <- getPublicKey cert
+  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) fingerprints)
+        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)

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
-    , http-client  >=0.7
+      base          >=4.7  && <5
+    , byteable      >=0.1
+    , bytestring    >=0.10
+    , HsOpenSSL     >=0.11
     , imports
-    , time         >=1.5
+    , time          >=1.5
+    , types-common
 
   default-language:   GHC2021

libs/types-common-aws/default.nix

@@ -4,7 +4,6 @@
 # dependencies are added or removed.
 { mkDerivation
 , amazonka
-, amazonka-core
 , amazonka-sqs
 , base
 , base64-bytestring
@@ -24,7 +23,6 @@ mkDerivation {
   src = gitignoreSource ./.;
   libraryHaskellDepends = [
     amazonka
-    amazonka-core
     amazonka-sqs
     base
     base64-bytestring

libs/types-common-aws/src/AWS/Util.hs

@@ -18,7 +18,6 @@
 module AWS.Util where
 
 import Amazonka qualified as AWS
-import Amazonka.Data.Time qualified as AWS
 import Data.Time
 import Imports
 

libs/types-common-aws/src/Util/Test/SQS.hs

@@ -164,5 +164,13 @@ parseDeleteMessage url m = do
         liftIO $ putStrLn $ "Failed to delete message, this error will be ignored. Message: " <> show m <> ", Exception: " <> displayException e
   pure evt
 
-sendEnv :: (MonadReader AWS.Env m, MonadResource m, AWS.AWSRequest a) => a -> m (AWS.AWSResponse a)
+sendEnv ::
+  ( MonadReader AWS.Env m,
+    MonadResource m,
+    Typeable a,
+    Typeable (AWS.AWSResponse a),
+    AWS.AWSRequest a
+  ) =>
+  a ->
+  m (AWS.AWSResponse a)
 sendEnv x = flip AWS.send x =<< ask

libs/types-common-aws/types-common-aws.cabal

@@ -78,7 +78,6 @@ library
   ghc-prof-options:   -fprof-auto-exported
   build-depends:
       amazonka
-    , amazonka-core
     , amazonka-sqs
     , base               >=4    && <5
     , base64-bytestring  >=1.0

nix/haskell-pins.nix

@@ -73,25 +73,6 @@ let
         sha256 = "sha256-ov85XFztGM0mEoj01lRZN9xYJttKa/crPnp0lh4A5DA=";
       };
     };
-    amazonka = {
-      src = fetchgit {
-        url = "https://github.com/brendanhay/amazonka";
-        rev = "cfe2584aef0b03c86650372d362c74f237925d8c";
-        sha256 = "sha256-ss8IuIN0BbS6LMjlaFmUdxUqQu+IHsA8ucsjxXJwbyg=";
-      };
-      packages = {
-        amazonka = "lib/amazonka";
-        amazonka-core = "lib/amazonka-core";
-        amazonka-cloudfront = "lib/services/amazonka-cloudfront";
-        amazonka-dynamodb = "lib/services/amazonka-dynamodb";
-        amazonka-s3 = "lib/services/amazonka-s3";
-        amazonka-ses = "lib/services/amazonka-ses";
-        amazonka-sns = "lib/services/amazonka-sns";
-        amazonka-sqs = "lib/services/amazonka-sqs";
-        amazonka-sso = "lib/services/amazonka-sso";
-        amazonka-sts = "lib/services/amazonka-sts";
-      };
-    };
     bloodhound = {
       src = fetchgit {
         url = "https://github.com/wireapp/bloodhound";
@@ -122,19 +103,6 @@ let
         sha256 = "sha256-jYJBhXBQ1MTLPI8JsiF2XUtgDxK+eniavNB2B1zaSQg=";
       };
     };
-    http-client = {
-      src = fetchgit {
-        url = "https://github.com/wireapp/http-client";
-        rev = "eabf64b4a8ff4c0fe6a3b39cb0f396ba8c2fb236";
-        sha256 = "sha256-8NPRVDlul9Xnj6IyUOUe6w7fDt/5WWZNjR07CaAp/Kk=";
-      };
-      packages = {
-        http-client = "http-client";
-        http-client-openssl = "http-client-openssl";
-        http-client-tls = "http-client-tls";
-        http-conduit = "http-conduit";
-      };
-    };
     hspec-wai = {
       src = fetchgit {
         url = "https://github.com/wireapp/hspec-wai";

nix/manual-overrides.nix

@@ -63,6 +63,8 @@ hself: hsuper: {
   hsaml2 = hlib.dontCheck hsuper.hsaml2;
   saml2-web-sso = hlib.dontCheck hsuper.saml2-web-sso;
   http2 = hlib.dontCheck hsuper.http2;
+  http-client-tls = hsuper.http-client-tls_0_3_6_3;
+  http-client = hsuper.http-client;
 
 
   # Disable tests because they need network access to a running cassandra
@@ -77,19 +79,6 @@ hself: hsuper: {
   # due to related broken quickcheck-arbitrary-template
   bloodhound = hlib.dontCheck hsuper.bloodhound;
 
-  # These tests require newer version on hspec-wai, which doesn't work with some of the wire-server packages.
-  amazonka = hlib.doJailbreak (hlib.dontCheck hsuper.amazonka);
-  amazonka-cloudfront = hlib.dontCheck hsuper.amazonka-cloudfront;
-  amazonka-core = hlib.doJailbreak (hlib.dontCheck hsuper.amazonka-core);
-  amazonka-dynamodb = hlib.dontCheck hsuper.amazonka-dynamodb;
-  amazonka-s3 = hlib.dontCheck hsuper.amazonka-s3;
-  amazonka-ses = hlib.dontCheck hsuper.amazonka-ses;
-  amazonka-sns = hlib.dontCheck hsuper.amazonka-sns;
-  amazonka-sqs = hlib.dontCheck hsuper.amazonka-sqs;
-  amazonka-sso = hlib.dontCheck hsuper.amazonka-sso;
-  amazonka-sts = hlib.dontCheck hsuper.amazonka-sts;
-  servant-server = hlib.dontCheck hsuper.servant-server;
-
   # Build toool dependencies of local packages
   types-common-journal = hlib.addBuildTool hsuper.types-common-journal protobuf;
   wire-api = hlib.addBuildTool hsuper.wire-api mls-test-cli;

services/brig/brig.cabal

@@ -465,7 +465,7 @@ executable brig-integration
     , HsOpenSSL
     , http-api-data
     , http-client
-    , http-client-tls        >=0.3
+    , http-client-tls        >=0.3.6.3
     , http-media
     , http-reverse-proxy
     , http-types

services/brig/src/Brig/AWS.hs

@@ -235,19 +235,27 @@ sendMail m = do
 --------------------------------------------------------------------------------
 -- Utilities
 
-sendCatch :: AWSRequest r => r -> Amazon (Either AWS.Error (AWSResponse r))
+sendCatch :: (AWSRequest r, Typeable r, Typeable (AWSResponse r)) => r -> Amazon (Either AWS.Error (AWSResponse r))
 sendCatch req = do
   env <- view amazonkaEnv
   AWS.trying AWS._Error . AWS.send env $ req
 
-send :: AWSRequest r => r -> Amazon (AWSResponse r)
+send ::
+  (AWSRequest r, Typeable r, Typeable (AWSResponse r)) =>
+  r ->
+  Amazon (AWSResponse r)
 send r = throwA =<< sendCatch r
 
 throwA :: Either AWS.Error a -> Amazon a
 throwA = either (throwM . GeneralError) pure
 
 execCatch ::
-  (AWSRequest a, MonadUnliftIO m, MonadCatch m) =>
+  ( AWSRequest a,
+    Typeable a,
+    MonadUnliftIO m,
+    Typeable (AWSResponse a),
+    MonadCatch m
+  ) =>
   AWS.Env ->
   a ->
   m (Either AWS.Error (AWSResponse a))
@@ -257,7 +265,12 @@ execCatch e cmd =
       AWS.send e cmd
 
 exec ::
-  (AWSRequest a, MonadCatch m, MonadIO m) =>
+  ( AWSRequest a,
+    Typeable a,
+    Typeable (AWSResponse a),
+    MonadCatch m,
+    MonadIO m
+  ) =>
   AWS.Env ->
   a ->
   m (AWSResponse a)