Add federated access update tests

Author: pcapriotti

services/galley/test/integration/API/Federation.hs

@@ -72,6 +72,7 @@ tests s =
       test s "POST /federation/on-conversation-updated : Notify local user about message timer update" notifyMessageTimer,
       test s "POST /federation/on-conversation-updated : Notify local user about member update" notifyMemberUpdate,
       test s "POST /federation/on-conversation-updated : Notify local user about receipt mode update" notifyReceiptMode,
+      test s "POST /federation/on-conversation-updated : Notify local user about access update" notifyAccess,
       test s "POST /federation/leave-conversation : Success" leaveConversationSuccess,
       test s "POST /federation/on-message-sent : Receive a message from another backend" onMessageSent,
       test s "POST /federation/send-message : Post a message sent from another backend" sendMessage
@@ -365,6 +366,15 @@ notifyReceiptMode = do
     ConvReceiptModeUpdate
     (EdConvReceiptModeUpdate d)
 
+notifyAccess :: TestM ()
+notifyAccess = do
+  let d = ConversationAccessData (Set.fromList [InviteAccess, LinkAccess]) TeamAccessRole
+  notifyUpdate
+    []
+    (ConversationActionAccessUpdate d)
+    ConvAccessUpdate
+    (EdConvAccessUpdate d)
+
 notifyMemberUpdate :: TestM ()
 notifyMemberUpdate = do
   qdee <- randomQualifiedUser

services/galley/test/integration/API/Roles.hs

@@ -53,6 +53,7 @@ tests s =
     [ test s "conversation roles admin (and downgrade)" handleConversationRoleAdmin,
       test s "conversation roles member (and upgrade)" handleConversationRoleMember,
       test s "conversation role update with remote users present" roleUpdateWithRemotes,
+      test s "conversation access update with remote users present" accessUpdateWithRemotes,
       test s "conversation role update of remote member" roleUpdateRemoteMember,
       test s "get all conversation roles" testAllConversationRoles
     ]
@@ -286,6 +287,51 @@ roleUpdateWithRemotes = do
       evtFrom e @?= qbob
       evtData e @?= EdMemberUpdate mu
 
+accessUpdateWithRemotes :: TestM ()
+accessUpdateWithRemotes = do
+  c <- view tsCannon
+  let remoteDomain = Domain "alice.example.com"
+  qalice <- Qualified <$> randomId <*> pure remoteDomain
+  qbob <- randomQualifiedUser
+  qcharlie <- randomQualifiedUser
+  let bob = qUnqualified qbob
+      charlie = qUnqualified qcharlie
+
+  connectUsers bob (singleton charlie)
+  resp <-
+    postConvWithRemoteUser
+      remoteDomain
+      (mkProfile qalice (Name "Alice"))
+      bob
+      [qalice, qcharlie]
+  let qconv = decodeQualifiedConvId resp
+
+  opts <- view tsGConf
+  let access = ConversationAccessData (Set.singleton CodeAccess) NonActivatedAccessRole
+  WS.bracketR2 c bob charlie $ \(wsB, wsC) -> do
+    (_, requests) <-
+      withTempMockFederator opts remoteDomain (const ()) $
+        putQualifiedAccessUpdate bob qconv access
+          !!! const 200 === statusCode
+
+    req <- assertOne requests
+    liftIO $ do
+      F.domain req @?= domainText remoteDomain
+      fmap F.component (F.request req) @?= Just F.Galley
+      fmap F.path (F.request req) @?= Just "/federation/on-conversation-updated"
+      Just (Right cu) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req)
+      F.cuConvId cu @?= qUnqualified qconv
+      F.cuAction cu @?= ConversationActionAccessUpdate access
+      F.cuAlreadyPresentUsers cu @?= [qUnqualified qalice]
+
+    liftIO . WS.assertMatchN_ (5 # Second) [wsB, wsC] $ \n -> do
+      let e = List1.head (WS.unpackPayload n)
+      ntfTransient n @?= False
+      evtConv e @?= qconv
+      evtType e @?= ConvAccessUpdate
+      evtFrom e @?= qbob
+      evtData e @?= EdConvAccessUpdate access
+
 -- | Given an admin, another admin and a member run all
 --   the necessary checks targeting the admin
 wireAdminChecks ::

services/galley/test/integration/API/Util.hs

@@ -1086,6 +1086,22 @@ putAccessUpdate u c acc = do
       . zType "access"
       . json acc
 
+putQualifiedAccessUpdate ::
+  (MonadHttp m, HasGalley m, MonadIO m) =>
+  UserId ->
+  Qualified ConvId ->
+  ConversationAccessData ->
+  m ResponseLBS
+putQualifiedAccessUpdate u (Qualified c domain) acc = do
+  g <- viewGalley
+  put $
+    g
+      . paths ["/conversations", toByteString' domain, toByteString' c, "access"]
+      . zUser u
+      . zConn "conn"
+      . zType "access"
+      . json acc
+
 putMessageTimerUpdateQualified ::
   (HasGalley m, MonadIO m, MonadHttp m) =>
   UserId ->