WPB-3797 do not cache federation remote domain config

changelog.d/5-internal/WPB-3797-do-not-cache-federation-remote-domain-config

@@ -0,0 +1 @@
+Do not cache federation remote configs on non-brig services

libs/wire-api/default.nix

@@ -46,7 +46,6 @@
 , hspec
 , hspec-wai
 , http-api-data
-, http-client
 , http-media
 , http-types
 , imports
@@ -72,7 +71,6 @@
 , quickcheck-instances
 , random
 , resourcet
-, retry
 , saml2-web-sso
 , schema-profunctor
 , scientific
@@ -95,7 +93,6 @@
 , tasty-quickcheck
 , text
 , time
-, tinylog
 , transitive-anns
 , types-common
 , unliftio
@@ -119,7 +116,6 @@ mkDerivation {
   src = gitignoreSource ./.;
   libraryHaskellDepends = [
     aeson
-    async
     attoparsec
     base
     base64-bytestring
@@ -153,7 +149,6 @@ mkDerivation {
     hscim
     HsOpenSSL
     http-api-data
-    http-client
     http-media
     http-types
     imports
@@ -176,7 +171,6 @@ mkDerivation {
     quickcheck-instances
     random
     resourcet
-    retry
     saml2-web-sso
     schema-profunctor
     scientific
@@ -195,7 +189,6 @@ mkDerivation {
     tagged
     text
     time
-    tinylog
     transitive-anns
     types-common
     unordered-containers

libs/wire-api/src/Wire/API/FederationUpdate.hs

@@ -1,99 +1,13 @@
 module Wire.API.FederationUpdate
-  ( syncFedDomainConfigs,
-    SyncFedDomainConfigsCallback (..),
-    emptySyncFedDomainConfigsCallback,
+  ( getFederationDomainConfigs,
   )
 where
 
-import Control.Concurrent.Async
-import Control.Exception
-import Control.Retry qualified as R
-import Data.Set qualified as Set
-import Data.Text
-import Data.Typeable (cast)
 import Imports
-import Network.HTTP.Client (defaultManagerSettings, newManager)
-import Servant.Client (BaseUrl (BaseUrl), ClientEnv (ClientEnv), ClientError, Scheme (Http), runClientM)
-import Servant.Client.Internal.HttpClient (defaultMakeClientRequest)
-import System.Logger qualified as L
-import Util.Options
+import Servant.Client (ClientEnv, ClientError, runClientM)
 import Wire.API.Routes.FederationDomainConfig
 import Wire.API.Routes.Internal.Brig qualified as IAPI
 import Wire.API.Routes.Named (namedClient)
 
--- | 'FedUpdateCallback' is not called if a new settings cannot be fetched, or if they are
--- equal to the old settings.
-syncFedDomainConfigs :: Endpoint -> L.Logger -> SyncFedDomainConfigsCallback -> IO (IORef FederationDomainConfigs, Async ())
-syncFedDomainConfigs (Endpoint h p) log' cb = do
-  let baseUrl = BaseUrl Http (unpack h) (fromIntegral p) ""
-  clientEnv <- newManager defaultManagerSettings <&> \mgr -> ClientEnv mgr baseUrl Nothing defaultMakeClientRequest
-  ioref <- newIORef =<< initialize log' clientEnv
-  updateDomainsThread <- async $ loop log' clientEnv cb ioref
-  pure (ioref, updateDomainsThread)
-
--- | Initial function for getting the set of domains from brig, and an update interval
-initialize :: L.Logger -> ClientEnv -> IO FederationDomainConfigs
-initialize logger clientEnv =
-  let policy :: R.RetryPolicy
-      policy = R.capDelay 30_000_000 $ R.exponentialBackoff 3_000
-
-      go :: IO (Maybe FederationDomainConfigs)
-      go = do
-        fetch clientEnv >>= \case
-          Right s -> pure $ Just s
-          Left e -> do
-            L.log logger L.Info $
-              L.msg (L.val "Failed to reach brig for federation setup, retrying...")
-                L.~~ "error" L..= show e
-            pure Nothing
-   in R.retrying policy (const (pure . isNothing)) (const go) >>= \case
-        Just c -> pure c
-        Nothing -> throwIO $ ErrorCall "*** Failed to reach brig for federation setup, giving up!"
-
-loop :: L.Logger -> ClientEnv -> SyncFedDomainConfigsCallback -> IORef FederationDomainConfigs -> IO ()
-loop logger clientEnv (SyncFedDomainConfigsCallback callback) env = forever $
-  catch go $ \(e :: SomeException) -> do
-    -- log synchronous exceptions
-    case fromException e of
-      -- Rethrow async exceptions so that we can kill this thread with the `async` tools
-      -- The use of cast here comes from https://hackage.haskell.org/package/base-4.18.0.0/docs/src/GHC.IO.Exception.html#asyncExceptionFromException
-      -- But I only want to check for AsyncCancelled while leaving non-async exception
-      -- logging in place.
-      Just (SomeAsyncException e') -> case cast e' of
-        Just AsyncCancelled -> throwIO e
-        Nothing -> pure ()
-      Nothing ->
-        L.log logger L.Error $
-          L.msg (L.val "Federation domain sync thread died, restarting domain synchronization.")
-            L.~~ "error" L..= displayException e
-  where
-    go = do
-      fetch clientEnv >>= \case
-        Left e ->
-          L.log logger L.Info $
-            L.msg (L.val "Could not retrieve an updated list of federation domains from Brig; I'll keep trying!")
-              L.~~ "error" L..= displayException e
-        Right new -> do
-          old <- readIORef env
-          unless (domainListsEqual old new) $ callback old new
-          atomicWriteIORef env new
-      delay <- updateInterval <$> readIORef env
-      threadDelay (delay * 1_000_000)
-
-    domainListsEqual o n =
-      Set.fromList (domain <$> remotes o)
-        == Set.fromList (domain <$> remotes n)
-
-fetch :: ClientEnv -> IO (Either ClientError FederationDomainConfigs)
-fetch = runClientM (namedClient @IAPI.API @"get-federation-remotes")
-
--- | The callback takes the previous and the new settings and runs a given action.
-newtype SyncFedDomainConfigsCallback = SyncFedDomainConfigsCallback
-  { fromFedUpdateCallback ::
-      FederationDomainConfigs -> -- old value
-      FederationDomainConfigs -> -- new value
-      IO ()
-  }
-
-emptySyncFedDomainConfigsCallback :: SyncFedDomainConfigsCallback
-emptySyncFedDomainConfigsCallback = SyncFedDomainConfigsCallback $ \_ _ -> pure ()
+getFederationDomainConfigs :: ClientEnv -> IO (Either ClientError FederationDomainConfigs)
+getFederationDomainConfigs = runClientM $ namedClient @IAPI.API @"get-federation-remotes"

libs/wire-api/wire-api.cabal

@@ -225,7 +225,6 @@ library
 
   build-depends:
       aeson                      >=2.0.1.0
-    , async
     , attoparsec                 >=0.10
     , base                       >=4       && <5
     , base64-bytestring          >=1.0
@@ -259,7 +258,6 @@ library
     , hscim
     , HsOpenSSL
     , http-api-data
-    , http-client
     , http-media
     , http-types
     , imports
@@ -282,7 +280,6 @@ library
     , quickcheck-instances       >=0.3.16
     , random                     >=1.2.0
     , resourcet
-    , retry
     , saml2-web-sso
     , schema-profunctor
     , scientific
@@ -301,7 +298,6 @@ library
     , tagged
     , text                       >=0.11
     , time                       >=1.4
-    , tinylog
     , transitive-anns
     , types-common               >=0.16
     , unordered-containers       >=0.2

services/background-worker/background-worker.cabal

@@ -29,7 +29,6 @@ library
   build-depends:
       aeson
     , amqp
-    , base
     , containers
     , exceptions
     , extended
@@ -50,7 +49,6 @@ library
     , types-common
     , unliftio
     , wai-utilities
-    , wire-api
     , wire-api-federation
 
   default-extensions:

services/background-worker/background-worker.integration.yaml

@@ -17,4 +17,4 @@ rabbitmq:
 backendNotificationPusher:
   pushBackoffMinWait: 1000 # 1ms
   pushBackoffMaxWait: 1000000 # 1s
-  remotesRefreshInterval: 10000 # 10ms
+  remotesRefreshInterval: 10000 # 10ms

services/background-worker/default.nix

@@ -50,7 +50,6 @@ mkDerivation {
   libraryHaskellDepends = [
     aeson
     amqp
-    base
     containers
     exceptions
     extended
@@ -71,7 +70,6 @@ mkDerivation {
     types-common
     unliftio
     wai-utilities
-    wire-api
     wire-api-federation
   ];
   executableHaskellDepends = [ HsOpenSSL imports types-common ];

services/background-worker/src/Wire/BackendNotificationPusher.hs

@@ -118,7 +118,6 @@ startPusher consumersRef chan = do
         consumers <- liftIO $ readIORef consumersRef
         traverse_ (liftIO . Q.cancelConsumer chan . fst) $ Map.elems consumers
         throwM e
-
   timeBeforeNextRefresh <- asks (.backendNotificationsConfig.remotesRefreshInterval)
   -- If this thread is cancelled, catch the exception, kill the consumers, and carry on.
   -- FUTUREWORK?:

services/background-worker/src/Wire/BackgroundWorker/Env.hs

@@ -3,7 +3,6 @@
 
 module Wire.BackgroundWorker.Env where
 
-import Control.Concurrent.Chan
 import Control.Monad.Base
 import Control.Monad.Catch
 import Control.Monad.Trans.Control
@@ -22,7 +21,6 @@ import System.Logger qualified as Log
 import System.Logger.Class (Logger, MonadLogger (..))
 import System.Logger.Extended qualified as Log
 import Util.Options
-import Wire.API.Routes.FederationDomainConfig
 import Wire.BackgroundWorker.Options
 
 type IsWorking = Bool
@@ -41,7 +39,6 @@ data Env = Env
     federatorInternal :: Endpoint,
     httpManager :: Manager,
     defederationTimeout :: ResponseTimeout,
-    remoteDomainsChan :: Chan FederationDomainConfigs,
     backendNotificationMetrics :: BackendNotificationMetrics,
     backendNotificationsConfig :: BackendNotificationsConfig,
     statuses :: IORef (Map Worker IsWorking)
@@ -65,7 +62,6 @@ mkEnv opts = do
   http2Manager <- initHttp2Manager
   logger <- Log.mkLogger opts.logLevel Nothing opts.logFormat
   httpManager <- newManager defaultManagerSettings
-  remoteDomainsChan <- newChan
   let federatorInternal = opts.federatorInternal
       defederationTimeout =
         maybe

services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs

@@ -4,7 +4,6 @@
 
 module Test.Wire.BackendNotificationPusherSpec where
 
-import Control.Concurrent.Chan
 import Control.Exception
 import Control.Monad.Trans.Except
 import Data.Aeson qualified as Aeson
@@ -181,7 +180,6 @@ spec = do
           ]
       logger <- Logger.new Logger.defSettings
       httpManager <- newManager defaultManagerSettings
-      remoteDomainsChan <- newChan
       let federatorInternal = Endpoint "localhost" 8097
           http2Manager = undefined
           statuses = undefined
@@ -200,7 +198,6 @@ spec = do
       mockAdmin <- newMockRabbitMqAdmin True ["backend-notifications.foo.example"]
       logger <- Logger.new Logger.defSettings
       httpManager <- newManager defaultManagerSettings
-      remoteDomainsChan <- newChan
       let federatorInternal = Endpoint "localhost" 8097
           http2Manager = undefined
           statuses = undefined

services/background-worker/test/Test/Wire/Util.hs

@@ -2,12 +2,12 @@
 
 module Test.Wire.Util where
 
-import Control.Concurrent.Chan
 import Imports
 import Network.HTTP.Client
 import System.Logger.Class qualified as Logger
 import Util.Options (Endpoint (..))
-import Wire.BackgroundWorker.Env
+import Wire.BackgroundWorker.Env hiding (federatorInternal)
+import Wire.BackgroundWorker.Env qualified as E
 import Wire.BackgroundWorker.Options
 import Wire.BackgroundWorker.Util
 
@@ -18,7 +18,6 @@ testEnv = do
   statuses <- newIORef mempty
   backendNotificationMetrics <- mkBackendNotificationMetrics
   httpManager <- newManager defaultManagerSettings
-  remoteDomainsChan <- newChan
   let federatorInternal = Endpoint "localhost" 0
       rabbitmqAdminClient = undefined
       rabbitmqVHost = undefined

services/federator/default.nix

@@ -110,6 +110,7 @@ mkDerivation {
     polysemy-wire-zoo
     prometheus-client
     servant
+    servant-client
     servant-client-core
     servant-server
     text

services/federator/federator.cabal

@@ -137,6 +137,7 @@ library
     , polysemy-wire-zoo
     , prometheus-client
     , servant
+    , servant-client
     , servant-client-core
     , servant-server
     , text

services/federator/src/Federator/Env.hs

@@ -34,7 +34,6 @@ import Prometheus
 import System.Logger.Class qualified as LC
 import Util.Options
 import Wire.API.Federation.Component
-import Wire.API.Routes.FederationDomainConfig (FederationDomainConfigs)
 
 data FederatorMetrics = FederatorMetrics
   { outgoingRequests :: Vector Text Counter,
@@ -47,7 +46,6 @@ data Env = Env
     _requestId :: RequestId,
     _dnsResolver :: Resolver,
     _runSettings :: RunSettings,
-    _domainConfigs :: IORef FederationDomainConfigs,
     _service :: Component -> Endpoint,
     _externalPort :: Word16,
     _internalPort :: Word16,