Close GRPC client after making a request to a remote federator

changelog.d/6-federation/close-grpc-client

@@ -0,0 +1 @@
+Close GRPC client after making a request to a remote federator.

libs/wire-api-federation/src/Wire/API/Federation/GRPC/Client.hs

@@ -15,7 +15,12 @@
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
-module Wire.API.Federation.GRPC.Client where
+module Wire.API.Federation.GRPC.Client
+  ( GrpcClientErr (..),
+    createGrpcClient,
+    grpcClientError,
+  )
+where
 
 import Control.Exception
 import qualified Data.Text as T
@@ -32,11 +37,15 @@ createGrpcClient :: MonadIO m => GrpcClientConfig -> m (Either GrpcClientErr Grp
 createGrpcClient cfg = do
   res <- liftIO $ try @IOException $ setupGrpcClient' cfg
   pure $ case res of
-    Left err -> Left (GrpcClientErr (T.pack (show err <> errorInfo)))
-    Right (Left err) -> Left (GrpcClientErr (T.pack (show err <> errorInfo)))
+    Left err -> Left (grpcClientError (Just cfg) err)
+    Right (Left err) -> Left (grpcClientError (Just cfg) err)
     Right (Right client) -> Right client
-  where
-    errorInfo = addressToErrInfo $ _grpcClientConfigAddress cfg
+
+grpcClientError :: Exception e => Maybe GrpcClientConfig -> e -> GrpcClientErr
+grpcClientError mcfg err =
+  GrpcClientErr . T.pack $
+    displayException err
+      <> maybe "" (\cfg -> " " <> addressToErrInfo (_grpcClientConfigAddress cfg)) mcfg
 
 addressToErrInfo :: Address -> String
 addressToErrInfo = \case

services/federator/src/Federator/InternalServer.hs

@@ -45,6 +45,7 @@ import qualified Polysemy.Error as Polysemy
 import Polysemy.IO (embedToMonadIO)
 import qualified Polysemy.Input as Polysemy
 import qualified Polysemy.Reader as Polysemy
+import qualified Polysemy.Resource as Polysemy
 import Polysemy.TinyLog (TinyLog)
 import qualified Polysemy.TinyLog as Log
 import Wire.API.Federation.GRPC.Client (GrpcClientErr (..))
@@ -134,6 +135,7 @@ serveOutward env port = do
            Polysemy.Error ServerError,
            Polysemy.Reader RunSettings,
            Polysemy.Input TLSSettings,
+           Polysemy.Resource,
            Embed IO,
            Embed Federator
          ]
@@ -143,6 +145,7 @@ serveOutward env port = do
       runAppT env
         . runM -- Embed Federator
         . embedToMonadIO @Federator -- Embed IO
+        . Polysemy.runResource -- Resource
         . Polysemy.runInputSem (embed @IO (readIORef (view tls env))) -- Input TLSSettings
         . Polysemy.runReader (view runSettings env) -- Reader RunSettings
         . absorbServerError

services/federator/src/Federator/Remote.hs

@@ -28,6 +28,7 @@ module Federator.Remote
 where
 
 import Control.Lens ((^.))
+import Control.Monad.Except
 import Data.Default (def)
 import Data.Domain (Domain, domainText)
 import Data.String.Conversions (cs)
@@ -42,12 +43,14 @@ import Mu.GRpc.Client.Optics (GRpcReply)
 import Mu.GRpc.Client.Record (GRpcMessageProtocol (MsgProtoBuf))
 import Mu.GRpc.Client.TyApps (gRpcCall)
 import Network.GRPC.Client.Helpers
+import Network.HTTP2.Client.Exceptions
 import Network.TLS as TLS
 import qualified Network.TLS.Extra.Cipher as TLS
 import Polysemy
 import qualified Polysemy.Error as Polysemy
 import qualified Polysemy.Input as Polysemy
 import qualified Polysemy.Reader as Polysemy
+import qualified Polysemy.Resource as Polysemy
 import Polysemy.TinyLog (TinyLog)
 import qualified Polysemy.TinyLog as Log
 import qualified System.Logger.Message as Log
@@ -72,7 +75,8 @@ interpretRemote ::
        DiscoverFederator,
        TinyLog,
        Polysemy.Reader RunSettings,
-       Polysemy.Input TLSSettings
+       Polysemy.Input TLSSettings,
+       Polysemy.Resource
      ]
     r =>
   Sem (Remote ': r) a ->
@@ -82,8 +86,8 @@ interpretRemote = interpret $ \case
     target <-
       Polysemy.mapError (RemoteErrorDiscoveryFailure vDomain) $
         discoverFederatorWithError vDomain
-    client <- mkGrpcClient target
-    callInward client vRequest
+    Polysemy.bracket (mkGrpcClient target) (closeGrpcClient target) $ \client ->
+      callInward client vRequest
 
 callInward :: MonadIO m => GrpcClient -> Request -> m (GRpcReply InwardResponse)
 callInward client request =
@@ -154,6 +158,20 @@ mkGrpcClient target@(SrvTarget host port) = do
     . Polysemy.fromEither
     =<< Polysemy.fromExceptionVia (RemoteErrorTLSException target) (createGrpcClient cfg')
 
+closeGrpcClient ::
+  Members '[Embed IO, Polysemy.Error RemoteError] r =>
+  SrvTarget ->
+  GrpcClient ->
+  Sem r ()
+closeGrpcClient target =
+  Polysemy.mapError handle
+    . Polysemy.fromEitherM
+    . runExceptT
+    . close
+  where
+    handle :: ClientError -> RemoteError
+    handle = RemoteErrorClientFailure target . grpcClientError Nothing
+
 logRemoteErrors ::
   Members '[Polysemy.Error RemoteError, TinyLog] r =>
   Sem r x ->