Test error wrapping

This test creates a fake ingress that always returns an error, then
tries to access it by making a federated user query.

integration/integration.cabal

@@ -108,6 +108,7 @@ library
     Test.Client
     Test.Conversation
     Test.Demo
+    Test.Errors
     Test.Federation
     Test.Federator
     Test.MessageTimer
@@ -127,6 +128,7 @@ library
     Testlib.Env
     Testlib.HTTP
     Testlib.JSON
+    Testlib.Mock
     Testlib.ModService
     Testlib.One2One
     Testlib.Options
@@ -189,6 +191,7 @@ library
     , scientific
     , split
     , stm
+    , streaming-commons
     , string-conversions
     , tagged
     , temporary
@@ -200,6 +203,9 @@ library
     , unliftio
     , uuid
     , vector
+    , wai
+    , warp
+    , warp-tls
     , websockets
     , wire-message-proto-lens
     , xml

integration/test/Test/Errors.hs

@@ -0,0 +1,45 @@
+{-# OPTIONS -Wno-ambiguous-fields #-}
+module Test.Errors where
+
+import API.Brig
+import Control.Monad.Codensity
+import Control.Monad.Reader
+import Data.Aeson qualified as Aeson
+import Network.HTTP.Types qualified as HTTP
+import Network.Wai qualified as Wai
+import SetupHelpers
+import Testlib.Mock
+import Testlib.Prelude
+import Testlib.ResourcePool
+
+testNestedError :: HasCallStack => App ()
+testNestedError = do
+  let innerError =
+        object
+          [ "code" .= (400 :: Int),
+            "label" .= "example",
+            "message" .= "Example remote federator failure"
+          ]
+
+  resourcePool <- asks resourcePool
+  lowerCodensity $ do
+    [res] <- acquireResources 1 resourcePool
+    void
+      $ startMockServer
+        def
+          { port = Just (fromIntegral res.berNginzSslPort),
+            tls = True
+          }
+      $ codensityApp
+      $ \_req -> do
+        liftIO $ putStrLn "received request"
+        pure $ Wai.responseLBS HTTP.status400 mempty $ Aeson.encode innerError
+
+    -- get remote user
+    lift $ do
+      user <- randomUser OwnDomain def
+      targetId <- randomId
+      let target = object ["id" .= targetId, "domain" .= res.berDomain]
+      bindResponse (getUser user target) $ \resp -> do
+        resp.status `shouldMatchInt` 533
+        resp.json %. "inner" `shouldMatch` innerError

integration/test/Testlib/Mock.hs

@@ -0,0 +1,63 @@
+module Testlib.Mock where
+
+import Control.Concurrent.Async
+import Control.Concurrent.MVar
+import Control.Exception
+import Control.Monad.Codensity
+import Data.Streaming.Network
+import Network.Socket qualified as Socket
+import Network.Wai qualified as Wai
+import Network.Wai.Handler.Warp qualified as Warp
+import Network.Wai.Handler.WarpTLS qualified as Warp
+import Testlib.Prelude
+
+codensityApp :: (Wai.Request -> Codensity IO Wai.Response) -> Wai.Application
+codensityApp f req = runCodensity (f req)
+
+data MockServerConfig = MockServerConfig
+  { port :: Maybe Warp.Port,
+    tls :: Bool
+  }
+
+instance Default MockServerConfig where
+  def = MockServerConfig {port = Nothing, tls = False}
+
+startMockServer :: MockServerConfig -> Wai.Application -> Codensity App Warp.Port
+startMockServer config app = do
+  (port, sock) <- liftIO $ case config.port of
+    Nothing -> bindRandomPortTCP (fromString "*6")
+    Just n -> (n,) <$> bindPortTCP n (fromString "*6")
+  serverStarted <- liftIO newEmptyMVar
+  let wsettings =
+        Warp.defaultSettings
+          & Warp.setPort port
+          & Warp.setGracefulCloseTimeout2 0
+          & Warp.setBeforeMainLoop (putMVar serverStarted ())
+
+  -- Start server in a separate thread. Here it's fine to fire and forget,
+  -- because the server is linked to the socket, and closing the socket will
+  -- shutdown the server.
+  void . liftIO . async $
+    if config.tls
+      then
+        Warp.runTLSSocket
+          ( Warp.tlsSettings
+              "services/federator/test/resources/integration-leaf.pem"
+              "services/federator/test/resources/integration-leaf-key.pem"
+          )
+          wsettings
+          sock
+          app
+      else Warp.runSettingsSocket wsettings sock app
+
+  Codensity $ \k -> do
+    action <- appToIO (k ())
+    liftIO
+      $ bracket
+        (readMVar serverStarted)
+        ( \_ ->
+            catch (Socket.close sock) (\(_ :: SomeException) -> pure ())
+        )
+      $ \_ -> action
+
+  pure port

integration/test/Testlib/ResourcePool.hs

@@ -2,7 +2,6 @@ module Testlib.ResourcePool
   ( ResourcePool,
     BackendResource (..),
     DynamicBackendConfig (..),
-    backendResources,
     createBackendResourcePool,
     acquireResources,
     backendA,