Get galley to compile.

services/brig/src/Brig/CanonicalInterpreter.hs

@@ -22,8 +22,7 @@ import Control.Monad.Catch (throwM)
 import Data.Qualified (Local, toLocalUnsafe)
 import Data.Time.Clock (UTCTime, getCurrentTime)
 import Imports
-import Network.AMQP
-import Network.AMQP qualified as Q
+import Network.AMQP as Q
 import Polysemy
 import Polysemy.Async
 import Polysemy.Conc

services/galley/src/Galley/App.hs

@@ -84,6 +84,7 @@ import Galley.Queue qualified as Q
 import Galley.Types.Teams
 import HTTP2.Client.Manager (Http2Manager, http2ManagerWithSSLCtx)
 import Imports hiding (forkIO)
+import Network.AMQP qualified as AMQP
 import Network.AMQP.Extended (mkRabbitMqChannelMVar)
 import Network.HTTP.Client (responseTimeoutMicro)
 import Network.HTTP.Client.OpenSSL
@@ -102,6 +103,7 @@ import Ssl.Util
 import System.Logger qualified as Log
 import System.Logger.Class (Logger)
 import System.Logger.Extended qualified as Logger
+import System.Timeout qualified
 import UnliftIO.Exception qualified as UnliftIO
 import Wire.API.Conversation.Protocol
 import Wire.API.Error
@@ -118,6 +120,7 @@ import Wire.Sem.Random.IO
 type GalleyEffects0 =
   '[ Input ClientState,
      Input Env,
+     Input AMQP.Channel,
      Error InvalidInput,
      Error InternalError,
      -- federation errors can be thrown by almost every endpoint, so we avoid
@@ -143,10 +146,6 @@ validateOptions o = do
     error "setMaxConvSize cannot be > setTruncationLimit"
   when (settings' ^. maxTeamSize < optFanoutLimit) $
     error "setMaxTeamSize cannot be < setTruncationLimit"
-  case (o ^. O.federator, o ^. rabbitmq) of
-    (Nothing, Just _) -> error "RabbitMQ config is specified and federator is not, please specify both or none"
-    (Just _, Nothing) -> error "Federator is specified and RabbitMQ config is not, please specify both or none"
-    _ -> pure ()
   let mlsFlag = settings' ^. featureFlags . to (featureDefaults @MLSConfig)
       mlsConfig = mlsFlag.config
       migrationStatus = (.status) $ settings' ^. featureFlags . to (featureDefaults @MlsMigrationConfig)
@@ -172,7 +171,7 @@ createEnv o l = do
     <*> initExtEnv
     <*> maybe (pure Nothing) (fmap Just . Aws.mkEnv l mgr) (o ^. journal)
     <*> traverse loadAllMLSKeys (o ^. settings . mlsPrivateKeyPaths)
-    <*> traverse (mkRabbitMqChannelMVar l) (o ^. rabbitmq)
+    <*> mkRabbitMqChannelMVar l (o ^. rabbitmq)
     <*> pure codeURIcfg
 
 initCassandra :: Opts -> Logger -> IO ClientState
@@ -251,6 +250,7 @@ evalGalley e =
     . mapError toResponse
     . mapError toResponse
     . mapError toResponse
+    . runInputSem (embed $ fromMaybe (error "TODO: no rabbitmq channel in Env") <$> System.Timeout.timeout 1_000_000 (readMVar @IO e._rabbitmqChannel))
     . runInputConst e
     . runInputConst (e ^. cstate)
     . mapError toResponse -- DynError

services/galley/src/Galley/Env.hs

@@ -62,7 +62,7 @@ data Env = Env
     _extEnv :: ExtEnv,
     _aEnv :: Maybe Aws.Env,
     _mlsKeys :: Maybe (MLSKeysByPurpose MLSPrivateKeys),
-    _rabbitmqChannel :: Maybe (MVar Q.Channel),
+    _rabbitmqChannel :: MVar Q.Channel,
     _convCodeURI :: Either HttpsUrl (Map Text HttpsUrl)
   }
 

services/galley/src/Galley/Intra/BackendNotificationQueue.hs

@@ -41,9 +41,6 @@ interpretBackendNotificationQueueAccess = interpret $ \case
     logEffect "BackendNotificationQueueAccess.EnqueueNotificationsConcurrentlyBuckets"
     embedApp . runExceptT $ enqueueNotificationsConcurrentlyBuckets m xs rpc
 
-getChannel :: ExceptT FederationError App (MVar Q.Channel)
-getChannel = view rabbitmqChannel >>= maybe (throwE FederationNotConfigured) pure
-
 enqueueSingleNotification :: Domain -> Q.DeliveryMode -> MVar Q.Channel -> FedQueueClient c a -> App a
 enqueueSingleNotification remoteDomain deliveryMode chanVar action = do
   ownDomain <- view (options . settings . federationDomain)
@@ -71,7 +68,7 @@ enqueueSingleNotification remoteDomain deliveryMode chanVar action = do
 
 enqueueNotification :: Q.DeliveryMode -> Domain -> FedQueueClient c a -> ExceptT FederationError App a
 enqueueNotification deliveryMode remoteDomain action = do
-  chanVar <- getChannel
+  chanVar <- view rabbitmqChannel
   lift $ enqueueSingleNotification remoteDomain deliveryMode chanVar action
 
 enqueueNotificationsConcurrently ::
@@ -94,7 +91,7 @@ enqueueNotificationsConcurrentlyBuckets m xs f = do
     -- only attempt to get a channel if there is at least one notification to send
     [] -> pure []
     _ -> do
-      chanVar <- getChannel
+      chanVar <- view rabbitmqChannel
       lift $ pooledForConcurrentlyN 8 (toList xs) $ \r ->
         qualifyAs r
           <$> enqueueSingleNotification (tDomain r) m chanVar (f r)

services/galley/src/Galley/Options.hs

@@ -181,8 +181,8 @@ data Opts = Opts
     _spar :: !Endpoint,
     -- | Federator endpoint
     _federator :: !(Maybe Endpoint),
-    -- | RabbitMQ settings, required when federation is enabled.
-    _rabbitmq :: !(Maybe AmqpEndpoint),
+    -- | RabbitMQ settings
+    _rabbitmq :: !AmqpEndpoint,
     -- | Disco URL
     _discoUrl :: !(Maybe Text),
     -- | Other settings

services/galley/test/integration/API.hs

@@ -67,7 +67,7 @@ import Data.Time.Clock (getCurrentTime)
 import Federator.Discovery (DiscoveryFailure (..))
 import Federator.MockServer
 import Galley.API.Mapping
-import Galley.Options (federator, rabbitmq)
+import Galley.Options (federator)
 import Galley.Types.Conversations.Members
 import Imports hiding (id)
 import Imports qualified as I
@@ -1902,10 +1902,7 @@ postConvQualifiedFederationNotEnabled = do
   let domain = Domain "some-remote-backend.example.com"
   bob <- flip Qualified domain <$> randomId
   connectWithRemoteUser alice bob
-  let federatorNotConfigured o =
-        o
-          & federator .~ Nothing
-          & rabbitmq .~ Nothing
+  let federatorNotConfigured = federator .~ Nothing
   withSettingsOverrides federatorNotConfigured $ do
     g <- viewGalley
     unreachable :: UnreachableBackends <-
@@ -2360,10 +2357,7 @@ testAddRemoteMemberFederationDisabled = do
 
   -- federator endpoint not configured is equivalent to federation being disabled
   -- This is the case on staging/production in May 2021.
-  let federatorNotConfigured o =
-        o
-          & federator .~ Nothing
-          & rabbitmq .~ Nothing
+  let federatorNotConfigured = federator .~ Nothing
   withSettingsOverrides federatorNotConfigured $
     postQualifiedMembers alice (remoteBob :| []) qconvId !!! do
       const 400 === statusCode