diff --git a/changelog.d/1-api-changes/WPB-240 b/changelog.d/1-api-changes/WPB-240 new file mode 100644 index 0000000000..cea66f7f0f --- /dev/null +++ b/changelog.d/1-api-changes/WPB-240 @@ -0,0 +1,3 @@ +Added a new notification event type, "federation.delete". +This event contains a single domain for a remote server that the local server is de-federating from. +This notification is sent twice during de-federation. Once before and once after cleaning up and removing references to the remote server from the local database. \ No newline at end of file diff --git a/changelog.d/6-federation/WPB-240 b/changelog.d/6-federation/WPB-240 new file mode 100644 index 0000000000..6c9deb4916 --- /dev/null +++ b/changelog.d/6-federation/WPB-240 @@ -0,0 +1 @@ +De-federating from a remote server sends a pair of notifications to clients, announcing which server will no longer be federated with. \ No newline at end of file diff --git a/libs/wire-api/src/Wire/API/Event/Federation.hs b/libs/wire-api/src/Wire/API/Event/Federation.hs new file mode 100644 index 0000000000..0665197590 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Event/Federation.hs @@ -0,0 +1,64 @@ +module Wire.API.Event.Federation + ( Event (..), + EventType (..), + ) +where + +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Aeson as A +import qualified Data.Aeson.KeyMap as KeyMap +import Data.Domain +import Data.Json.Util (ToJSONObject (toJSONObject)) +import Data.Schema +import qualified Data.Swagger as S +import Imports +import Wire.Arbitrary + +data Event = Event + { _eventType :: EventType, + _eventDomain :: Domain + } + deriving (Eq, Show, Ord, Generic) + +instance Arbitrary Event where + arbitrary = + Event + <$> arbitrary + <*> arbitrary + +data EventType + = FederationDelete + deriving (Eq, Show, Ord, Generic) + deriving (Arbitrary) via (GenericUniform EventType) + deriving (A.FromJSON, A.ToJSON, S.ToSchema) via Schema EventType + +instance ToSchema EventType where + schema = + enum @Text "EventType" $ + mconcat + [ element "federation.delete" FederationDelete + ] + +eventObjectSchema :: ObjectSchema SwaggerDoc Event +eventObjectSchema = + Event + <$> _eventType .= field "type" schema + <*> _eventDomain .= field "domain" schema + +instance ToSchema Event where + schema = object "Event" eventObjectSchema + +instance ToJSONObject Event where + toJSONObject = + KeyMap.fromList + . fromMaybe [] + . schemaOut eventObjectSchema + +instance S.ToSchema Event where + declareNamedSchema = schemaToSwagger + +instance FromJSON Event where + parseJSON = schemaParseJSON + +instance ToJSON Event where + toJSON = schemaToJSON diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index f4281a7906..bed2bcde37 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -37,6 +37,7 @@ library Wire.API.Error.Gundeck Wire.API.Event.Conversation Wire.API.Event.FeatureConfig + Wire.API.Event.Federation Wire.API.Event.Team Wire.API.FederationStatus Wire.API.FederationUpdate diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 0465b86da0..b7c61258c1 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -99,6 +99,7 @@ library Galley.Effects.CodeStore Galley.Effects.ConversationStore Galley.Effects.CustomBackendStore + Galley.Effects.DefederationNotifications Galley.Effects.ExternalAccess Galley.Effects.FederatorAccess Galley.Effects.FireAndForget diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 2aae9b9aaf..b97fdac2da 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -65,6 +65,7 @@ import Galley.Effects import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.ClientStore import Galley.Effects.ConversationStore +import Galley.Effects.DefederationNotifications (DefederationNotifications, sendDefederationNotifications) import Galley.Effects.FederatorAccess import Galley.Effects.GundeckAccess import Galley.Effects.LegalHoldStore as LegalHoldStore @@ -85,8 +86,8 @@ import Imports hiding (head) import qualified Network.AMQP as Q import Network.HTTP.Types import Network.Wai -import Network.Wai.Predicate hiding (Error, err, setStatus) -import qualified Network.Wai.Predicate as Predicate +import Network.Wai.Predicate hiding (Error, err, result, setStatus) +import qualified Network.Wai.Predicate as Predicate hiding (result) import Network.Wai.Routing hiding (App, route, toList) import Network.Wai.Utilities hiding (Error) import Network.Wai.Utilities.ZAuth @@ -538,12 +539,18 @@ internalDeleteFederationDomainH :: Member TeamStore r, Member BrigAccess r, Member GundeckAccess r, - Member ExternalAccess r + Member ExternalAccess r, + Member DefederationNotifications r ) => Domain ::: JSON -> Sem r Response internalDeleteFederationDomainH (domain ::: _) = do + -- We have to send the same event twice. + -- Once before and once after defederation work. + -- https://wearezeta.atlassian.net/wiki/spaces/ENGINEERIN/pages/809238539/Use+case+Stopping+to+federate+with+a+domain + sendDefederationNotifications domain deleteFederationDomain domain + sendDefederationNotifications domain pure (empty & setStatus status200) -- Remove remote members from local conversations diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 1b109134a1..515c558254 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -272,6 +272,7 @@ evalGalley e = . interpretFederatorAccess . interpretExternalAccess . interpretGundeckAccess + . interpretDefederationNotifications . interpretSparAccess . interpretBrigAccess where diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index 5942729edf..fcb6dea1f7 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -18,6 +18,8 @@ module Galley.Cassandra.Conversation.Members ( addMembers, members, + allMembers, + toMember, lookupRemoteMembers, removeMembersFromLocalConv, toMemberStatus, @@ -122,6 +124,11 @@ members conv = fmap (mapMaybe toMember) . retry x1 $ query Cql.selectMembers (params LocalQuorum (Identity conv)) +allMembers :: Client [LocalMember] +allMembers = + fmap (mapMaybe toMember) . retry x1 $ + query Cql.selectAllMembers (params LocalQuorum ()) + toMemberStatus :: ( -- otr muted Maybe MutedStatus, @@ -386,6 +393,7 @@ interpretMemberStoreToCassandra = interpret $ \case CreateBotMember sr bid cid -> embedClient $ addBotMember sr bid cid GetLocalMember cid uid -> embedClient $ member cid uid GetLocalMembers cid -> embedClient $ members cid + GetAllLocalMembers -> embedClient allMembers GetRemoteMember cid uid -> embedClient $ lookupRemoteMember cid (tDomain uid) (tUnqualified uid) GetRemoteMembers rcid -> embedClient $ lookupRemoteMembers rcid CheckLocalMemberRemoteConv uid rcnv -> fmap (not . null) $ embedClient $ lookupLocalMemberRemoteConv uid rcnv diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 8e3b596361..fd986b8c8e 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -339,6 +339,9 @@ selectMember = "select user, service, provider, status, otr_muted_status, otr_mu selectMembers :: PrepQuery R (Identity ConvId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName) selectMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role from member where conv = ?" +selectAllMembers :: PrepQuery R () (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName) +selectAllMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role from member" + insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, RoleName) () insertMember = "insert into member (conv, user, service, provider, status, conversation_role) values (?, ?, ?, ?, 0, ?)" diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index a8dc2a5198..fc8f406bec 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -69,6 +69,7 @@ import Galley.Effects.ClientStore import Galley.Effects.CodeStore import Galley.Effects.ConversationStore import Galley.Effects.CustomBackendStore +import Galley.Effects.DefederationNotifications import Galley.Effects.ExternalAccess import Galley.Effects.FederatorAccess import Galley.Effects.FireAndForget @@ -99,6 +100,7 @@ import Wire.Sem.Paging.Cassandra type GalleyEffects1 = '[ BrigAccess, SparAccess, + DefederationNotifications, GundeckAccess, ExternalAccess, FederatorAccess, diff --git a/services/galley/src/Galley/Effects/DefederationNotifications.hs b/services/galley/src/Galley/Effects/DefederationNotifications.hs new file mode 100644 index 0000000000..db1fc30119 --- /dev/null +++ b/services/galley/src/Galley/Effects/DefederationNotifications.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Galley.Effects.DefederationNotifications + ( DefederationNotifications (..), + sendDefederationNotifications + ) where + +import Polysemy +import Data.Domain (Domain) + +data DefederationNotifications m a where + SendDefederationNotifications :: Domain -> DefederationNotifications m () + +makeSem ''DefederationNotifications \ No newline at end of file diff --git a/services/galley/src/Galley/Effects/ExternalAccess.hs b/services/galley/src/Galley/Effects/ExternalAccess.hs index 936f0da5c8..7f6f3c4f0f 100644 --- a/services/galley/src/Galley/Effects/ExternalAccess.hs +++ b/services/galley/src/Galley/Effects/ExternalAccess.hs @@ -26,6 +26,7 @@ module Galley.Effects.ExternalAccess ) where +import Data.Aeson import Data.Id import Galley.Data.Services import Imports @@ -34,7 +35,7 @@ import Wire.API.Event.Conversation data ExternalAccess m a where Deliver :: Foldable f => f (BotMember, Event) -> ExternalAccess m [BotMember] - DeliverAsync :: Foldable f => f (BotMember, Event) -> ExternalAccess m () + DeliverAsync :: (ToJSON e, Foldable f) => f (BotMember, e) -> ExternalAccess m () DeliverAndDeleteAsync :: Foldable f => ConvId -> f (BotMember, Event) -> ExternalAccess m () makeSem ''ExternalAccess diff --git a/services/galley/src/Galley/Effects/MemberStore.hs b/services/galley/src/Galley/Effects/MemberStore.hs index 5003c7b477..c8542a71f3 100644 --- a/services/galley/src/Galley/Effects/MemberStore.hs +++ b/services/galley/src/Galley/Effects/MemberStore.hs @@ -30,6 +30,7 @@ module Galley.Effects.MemberStore -- * Read members getLocalMember, getLocalMembers, + getAllLocalMembers, getRemoteMember, getRemoteMembers, checkLocalMemberRemoteConv, @@ -70,6 +71,7 @@ data MemberStore m a where CreateBotMember :: ServiceRef -> BotId -> ConvId -> MemberStore m BotMember GetLocalMember :: ConvId -> UserId -> MemberStore m (Maybe LocalMember) GetLocalMembers :: ConvId -> MemberStore m [LocalMember] + GetAllLocalMembers :: MemberStore m [LocalMember] GetRemoteMember :: ConvId -> Remote UserId -> MemberStore m (Maybe RemoteMember) GetRemoteMembers :: ConvId -> MemberStore m [RemoteMember] CheckLocalMemberRemoteConv :: UserId -> Remote ConvId -> MemberStore m Bool diff --git a/services/galley/src/Galley/External.hs b/services/galley/src/Galley/External.hs index e265c15a9e..7d42ace136 100644 --- a/services/galley/src/Galley/External.hs +++ b/services/galley/src/Galley/External.hs @@ -21,6 +21,7 @@ import Bilge.Request import Bilge.Retry (httpHandlers) import Control.Lens import Control.Retry +import Data.Aeson (ToJSON) import Data.ByteString.Conversion.To import Data.Id import Data.Misc @@ -60,7 +61,7 @@ interpretExternalAccess = interpret $ \case -- | Like deliver, but ignore orphaned bots and return immediately. -- -- FUTUREWORK: Check if this can be removed. -deliverAsync :: [(BotMember, Event)] -> App () +deliverAsync :: ToJSON e => [(BotMember, e)] -> App () deliverAsync = void . forkIO . void . deliver -- | Like deliver, but remove orphaned bots and return immediately. @@ -69,10 +70,10 @@ deliverAndDeleteAsync cnv pushes = void . forkIO $ do gone <- deliver pushes mapM_ (deleteBot cnv . botMemId) gone -deliver :: [(BotMember, Event)] -> App [BotMember] +deliver :: forall e. ToJSON e => [(BotMember, e)] -> App [BotMember] deliver pp = mapM (async . exec) pp >>= foldM eval [] . zip (map fst pp) where - exec :: (BotMember, Event) -> App Bool + exec :: (BotMember, e) -> App Bool exec (b, e) = lookupService (botMemService b) >>= \case Nothing -> pure False @@ -118,7 +119,7 @@ deliver pp = mapM (async . exec) pp >>= foldM eval [] . zip (map fst pp) -- Internal ------------------------------------------------------------------- -deliver1 :: Service -> BotMember -> Event -> App () +deliver1 :: ToJSON e => Service -> BotMember -> e -> App () deliver1 s bm e | s ^. serviceEnabled = do let t = toByteString' (s ^. serviceToken) diff --git a/services/galley/src/Galley/Intra/Effects.hs b/services/galley/src/Galley/Intra/Effects.hs index 87c019c755..85f37c86f8 100644 --- a/services/galley/src/Galley/Intra/Effects.hs +++ b/services/galley/src/Galley/Intra/Effects.hs @@ -20,16 +20,27 @@ module Galley.Intra.Effects interpretSparAccess, interpretBotAccess, interpretGundeckAccess, + interpretDefederationNotifications, ) where +import Cassandra (ClientState, Consistency (LocalQuorum), Page (hasMore, nextPage, result), paginate, paramsP) +import Control.Lens ((.~)) +import Data.Range (Range (fromRange)) import Galley.API.Error +import Galley.API.Util (localBotsAndUsers) +import Galley.Cassandra.Conversation.Members (toMember) +import Galley.Cassandra.Queries (selectAllMembers) +import Galley.Cassandra.Store (embedClient) import Galley.Effects.BotAccess (BotAccess (..)) import Galley.Effects.BrigAccess (BrigAccess (..)) -import Galley.Effects.GundeckAccess (GundeckAccess (..)) +import Galley.Effects.DefederationNotifications (DefederationNotifications (..)) +import Galley.Effects.ExternalAccess (ExternalAccess, deliverAsync) +import Galley.Effects.GundeckAccess (GundeckAccess (..), push1) import Galley.Effects.SparAccess (SparAccess (..)) import Galley.Env import Galley.Intra.Client +import qualified Galley.Intra.Push as Intra import qualified Galley.Intra.Push.Internal as G import Galley.Intra.Spar import Galley.Intra.Team @@ -41,6 +52,8 @@ import Polysemy.Error import Polysemy.Input import qualified Polysemy.TinyLog as P import qualified UnliftIO +import qualified Wire.API.Event.Federation as Federation +import Wire.API.Team.Member (ListType (ListComplete)) interpretBrigAccess :: ( Member (Embed IO) r, @@ -123,3 +136,36 @@ interpretGundeckAccess :: interpretGundeckAccess = interpret $ \case Push ps -> embedApp $ G.push ps PushSlowly ps -> embedApp $ G.pushSlowly ps + +interpretDefederationNotifications :: + ( Member (Embed IO) r, + Member (Input Env) r, + Member (Input ClientState) r, + Member GundeckAccess r, + Member ExternalAccess r + ) => + Sem (DefederationNotifications ': r) a -> + Sem r a +interpretDefederationNotifications = interpret $ \case + SendDefederationNotifications domain -> do + maxPage <- inputs $ fromRange . currentFanoutLimit . _options -- This is based on the limits in removeIfLargeFanout + page <- embedClient $ paginate selectAllMembers (paramsP LocalQuorum () maxPage) + void $ sendNotificationPage page + where + pushEvents results = do + let (bots, mems) = localBotsAndUsers results + recipients = Intra.recipient <$> mems + event = Intra.FederationEvent $ Federation.Event Federation.FederationDelete domain + for_ (Intra.newPush ListComplete Nothing event recipients) $ \p -> do + -- Futurework: Transient or not? + -- RouteAny is used as it will wake up mobile clients + -- and notify them of the changes to federation state. + push1 $ p & Intra.pushRoute .~ Intra.RouteAny + deliverAsync (bots `zip` repeat (G.pushEventJson event)) + sendNotificationPage page = do + let res = result page + mems = mapMaybe toMember res + pushEvents mems + when (hasMore page) $ do + page' <- embedClient $ nextPage page + sendNotificationPage page' diff --git a/services/galley/src/Galley/Intra/Push/Internal.hs b/services/galley/src/Galley/Intra/Push/Internal.hs index 5232489a3c..4cbdd47889 100644 --- a/services/galley/src/Galley/Intra/Push/Internal.hs +++ b/services/galley/src/Galley/Intra/Push/Internal.hs @@ -40,6 +40,7 @@ import Imports hiding (forkIO) import UnliftIO.Async (mapConcurrently_) import Wire.API.Event.Conversation (Event (evtFrom)) import qualified Wire.API.Event.FeatureConfig as FeatureConfig +import qualified Wire.API.Event.Federation as Federation import qualified Wire.API.Event.Team as Teams import Wire.API.Team.Member @@ -47,11 +48,13 @@ data PushEvent = ConvEvent Event | TeamEvent Teams.Event | FeatureConfigEvent FeatureConfig.Event + | FederationEvent Federation.Event pushEventJson :: PushEvent -> Object pushEventJson (ConvEvent e) = toJSONObject e pushEventJson (TeamEvent e) = toJSONObject e pushEventJson (FeatureConfigEvent e) = toJSONObject e +pushEventJson (FederationEvent e) = toJSONObject e data RecipientBy user = Recipient { _recipientUserId :: user, diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 82f308e129..a7eda0513f 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -266,7 +266,8 @@ tests s = [ test s "send typing indicators" postTypingIndicators, test s "send typing indicators without domain" postTypingIndicatorsV2, test s "send typing indicators with invalid pyaload" postTypingIndicatorsHandlesNonsense - ] + ], + test s "delete federation notifications" testDefederationNotifications ] rb1, rb2, rb3 :: Remote Backend rb1 = @@ -4315,3 +4316,79 @@ testOne2OneConversationRequest shouldBeLocal actor desired = do pure $ statusCode resp == 200 liftIO $ found @?= ((actor, desired) == (LocalActor, Included)) ) + +-- Testing defederation notifications. The important thing to note for all +-- of this is that when defederating from a remote domain only _2_ notifications +-- are sent, and both are identical. One notification is at the start of +-- defederation, and one is sent at the end of defederation. No other +-- notifications about users being removed from conversations, or conversations +-- being deleted are sent. We are do not want to DOS either our local clients, +-- nor our own services. +testDefederationNotifications :: TestM () +testDefederationNotifications = do + -- alice, bob are in a team + (tid, alice, [bob]) <- createBindingTeamWithQualifiedMembers 2 + + -- charlie is a local guest + charlie <- randomQualifiedUser + connectUsers (qUnqualified alice) (pure (qUnqualified charlie)) + + let remoteDomain = Domain "far-away.example.com" + -- This variable should be commented out if the below + -- section is used to insert users to the database. + users = [] + -- This section of code is useful to massively increase + -- the amount of users in the testing database. This is + -- useful for checking that notifications are being fanned + -- out correctly, and that all users are sent a + -- notification. If the database already has a large + -- amount of users then this can be left out and will also + -- allow this test to run faster. + -- count = 10000 + -- users <- replicateM count randomQualifiedUser + -- replicateM_ count $ do + -- connectWithRemoteUser (qUnqualified alice) =<< + -- Qualified <$> randomId <*> pure remoteDomain + + -- dee is a remote guest + dee <- Qualified <$> randomId <*> pure remoteDomain + + connectWithRemoteUser (qUnqualified alice) dee + + -- they are all in a local conversation + conv <- + responseJsonError + =<< postConvWithRemoteUsers + (qUnqualified alice) + Nothing + defNewProteusConv + { newConvQualifiedUsers = [bob, charlie, dee], + newConvTeam = Just (ConvTeamInfo tid) + } + users) $ \(wsA : wsB : wsC : wsD : wsUsers) -> do + -- conversation access role changes to team only + (_, reqs) <- withTempMockFederator' (mockReply ()) $ do + -- Delete the domain that Dee lives on + deleteFederation remoteDomain !!! const 200 === statusCode + -- First notification to local clients + WS.assertMatchN_ (5 # Second) ([wsA, wsB, wsC] <> wsUsers) $ + wsAssertFederationDeleted remoteDomain + -- Second notification to local clients + WS.assertMatchN_ (5 # Second) ([wsA, wsB, wsC] <> wsUsers) $ + wsAssertFederationDeleted remoteDomain + -- dee's remote doesn't receive a notification + WS.assertNoEvent (5 # Second) [wsD] + -- There should be not requests out to the federtaion domain + liftIO $ reqs @?= [] + + -- only alice, bob, and charlie remain + conv2 <- + responseJsonError + =<< getConvQualified (qUnqualified alice) (cnvQualifiedId conv) + cmOthers (cnvMembers conv2)) @?= sort [bob, charlie] + +-- @END diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index dc772a3a92..060638f0e4 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -113,6 +113,7 @@ import Wire.API.Conversation.Role import Wire.API.Conversation.Typing import Wire.API.Event.Conversation import qualified Wire.API.Event.Conversation as Conv +import qualified Wire.API.Event.Federation as Fed import Wire.API.Event.Team import qualified Wire.API.Event.Team as TE import Wire.API.Federation.API @@ -1395,6 +1396,15 @@ postJoinCodeConv' mPw u j = do -- `json (JoinConversationByCode j Nothing)` and `json j` are equivalent, using the latter to test backwards compatibility . (if isJust mPw then json (JoinConversationByCode j mPw) else json j) +deleteFederation :: + (MonadHttp m, HasGalley m, MonadIO m) => + Domain -> + m ResponseLBS +deleteFederation dom = do + g <- viewGalley + delete $ + g . paths ["/i/federation", toByteString' dom] + putQualifiedAccessUpdate :: (MonadHttp m, HasGalley m, MonadIO m) => UserId -> @@ -1760,6 +1770,23 @@ assertJoinEvent conv usr new role e = do evtFrom e @?= usr fmap (sort . mMembers) (evtData e ^? _EdMembersJoin) @?= Just (sort (fmap (`SimpleMember` role) new)) +wsAssertFederationDeleted :: + HasCallStack => + Domain -> + Notification -> + IO () +wsAssertFederationDeleted dom n = do + ntfTransient n @?= False + assertFederationDeletedEvent dom $ List1.head (WS.unpackPayload n) + +assertFederationDeletedEvent :: + Domain -> + Fed.Event -> + IO () +assertFederationDeletedEvent dom e = do + Fed._eventType e @?= Fed.FederationDelete + Fed._eventDomain e @?= dom + -- FUTUREWORK: See if this one can be implemented in terms of: -- -- checkConvMemberLeaveEvent :: HasCallStack => Qualified ConvId -> Qualified UserId -> WS.WebSocket -> TestM ()