[WPB-10659] Test notifications for personal user to team user migration

changelog.d/2-features/WPB-10658

@@ -1 +1 @@
-Allow an existing non-team user to migrate to a team
+Allow an existing non-team user to migrate to a team (#4229, ##)

integration/test/API/Galley.hs

@@ -720,3 +720,10 @@ setTeamFeatureConfigVersioned versioned user team featureName payload = do
 -- | http://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_feature_configs
 getFeaturesForUser :: (HasCallStack, MakesValue user) => user -> App Response
 getFeaturesForUser user = baseRequest user Galley Versioned "feature-configs" >>= submit "GET"
+
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_teams_notifications
+getTeamNotifications :: (HasCallStack, MakesValue user) => user -> Maybe String -> App Response
+getTeamNotifications user mSince =
+  baseRequest user Galley Versioned "teams/notifications" >>= \req ->
+    submit "GET"
+      $ addQueryParams [("since", since) | since <- maybeToList mSince] req

integration/test/Notifications.hs

@@ -166,6 +166,9 @@ isConvDeleteNotif n = fieldEquals n "payload.0.type" "conversation.delete"
 notifTypeIsEqual :: (MakesValue a) => String -> a -> App Bool
 notifTypeIsEqual typ n = nPayload n %. "type" `isEqual` typ
 
+isTeamMemberJoinNotif :: (MakesValue a) => a -> App Bool
+isTeamMemberJoinNotif = notifTypeIsEqual "team.member-join"
+
 isTeamMemberLeaveNotif :: (MakesValue a) => a -> App Bool
 isTeamMemberLeaveNotif = notifTypeIsEqual "team.member-leave"
 

integration/test/Test/Teams.hs

@@ -20,12 +20,12 @@ module Test.Teams where
 import API.Brig
 import API.BrigInternal (createUser, getInvitationCode, refreshIndex)
 import API.Common
-import API.Galley (getTeam, getTeamMembers)
+import API.Galley (getTeam, getTeamMembers, getTeamNotifications)
 import API.GalleyInternal (setTeamFeatureStatus)
 import Control.Monad.Codensity (Codensity (runCodensity))
 import Control.Monad.Extra (findM)
 import Control.Monad.Reader (asks)
-import Notifications (isUserUpdatedNotif)
+import Notifications
 import SetupHelpers
 import Testlib.JSON
 import Testlib.Prelude
@@ -63,11 +63,20 @@ testInvitePersonalUserToTeam = do
         acceptTeamInvitation user code Nothing >>= assertStatus 400
         acceptTeamInvitation user code (Just "wrong-password") >>= assertStatus 403
 
-        void $ withWebSockets [user] $ \wss -> do
+        withWebSockets [owner, user, tm] $ \wss@[wsOwner, _, _] -> do
           acceptTeamInvitation user code (Just defPassword) >>= assertSuccess
-          for wss $ \ws -> do
-            n <- awaitMatch isUserUpdatedNotif ws
-            n %. "payload.0.user.team" `shouldMatch` tid
+
+          -- When the team is smaller than fanout limit, all members get this
+          -- notification.
+          for_ wss $ \ws -> do
+            updateNotif <- awaitMatch isUserUpdatedNotif ws
+            updateNotif %. "payload.0.user.team" `shouldMatch` tid
+
+          -- Admins get a team.member-join notif on the websocket for
+          -- team-settings
+          memberJobNotif <- awaitMatch isTeamMemberJoinNotif wsOwner
+          memberJobNotif %. "payload.0.team" `shouldMatch` tid
+          memberJobNotif %. "payload.0.data.user" `shouldMatch` objId user
 
         bindResponse (getSelf user) $ \resp -> do
           resp.status `shouldMatchInt` 200
@@ -126,6 +135,71 @@ testInvitePersonalUserToTeam = do
       queryParam <- url & asString <&> getQueryParam "team-code"
       queryParam `shouldMatch` Just (Just code)
 
+testInvitePersonalUserToLargeTeam :: (HasCallStack) => App ()
+testInvitePersonalUserToLargeTeam = do
+  teamSize <- readServiceConfig Galley %. "settings.maxFanoutSize" & asInt <&> (+ 1)
+  (owner, tid, (alice : otherTeamMembers)) <- createTeam OwnDomain teamSize
+  -- User to be invited to the team
+  knut <- createUser OwnDomain def >>= getJSON 201
+
+  -- Non team friends of knut
+  dawn <- createUser OwnDomain def >>= getJSON 201
+  eli <- createUser OtherDomain def >>= getJSON 201
+
+  -- knut is also friends with alice, but not any other team members.
+  traverse_ (connectTwoUsers knut) [alice, dawn, eli]
+
+  addFailureContext ("tid: " <> tid) $ do
+    uidContext <- mkContextUserIds [("owner", owner), ("alice", alice), ("knut", knut), ("dawn", dawn), ("eli", eli)]
+    addFailureContext uidContext $ do
+      lastTeamNotif <-
+        getTeamNotifications owner Nothing `bindResponse` \resp -> do
+          resp.status `shouldMatchInt` 200
+          resp.json %. "notifications.-1.id" & asString
+
+      knutEmail <- knut %. "email" >>= asString
+      inv <- postInvitation owner (PostInvitation (Just knutEmail) Nothing) >>= getJSON 201
+      code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
+
+      withWebSockets [owner, alice, dawn, eli, head otherTeamMembers] $ \[wsOwner, wsAlice, wsDawn, wsEli, wsOther] -> do
+        acceptTeamInvitation knut code (Just defPassword) >>= assertSuccess
+
+        for_ [wsAlice, wsDawn] $ \ws -> do
+          notif <- awaitMatch isUserUpdatedNotif ws
+          nPayload notif %. "user.id" `shouldMatch` (objId knut)
+          nPayload notif %. "user.team" `shouldMatch` tid
+
+        -- Admins get a team.member-join notif on the websocket for
+        -- team-settings
+        memberJobNotif <- awaitMatch isTeamMemberJoinNotif wsOwner
+        memberJobNotif %. "payload.0.team" `shouldMatch` tid
+        memberJobNotif %. "payload.0.data.user" `shouldMatch` objId knut
+
+        -- Other team members don't get notified on the websocket
+        assertNoEvent 1 wsOther
+
+        -- Remote users are not notified at all
+        assertNoEvent 1 wsEli
+
+      -- Other team members learn about knut via team notifications
+      getTeamNotifications (head otherTeamMembers) (Just lastTeamNotif) `bindResponse` \resp -> do
+        resp.status `shouldMatchInt` 200
+        -- Ignore the first notif because it is always the notif matching the
+        -- lastTeamNotif id.
+        resp.json %. "notifications.1.payload.0.type" `shouldMatch` "team.member-join"
+        resp.json %. "notifications.1.payload.0.team" `shouldMatch` tid
+        resp.json %. "notifications.1.payload.0.data.user" `shouldMatch` objId knut
+
+mkContextUserIds :: (MakesValue user) => [(String, user)] -> App String
+mkContextUserIds =
+  fmap (intercalate "\n")
+    . traverse
+      ( \(name, user) -> do
+          uid <- objQidObject user %. "id" & asString
+          domain <- objDomain user
+          pure $ name <> ": " <> uid <> "@" <> domain
+      )
+
 testInvitePersonalUserToTeamMultipleInvitations :: (HasCallStack) => App ()
 testInvitePersonalUserToTeamMultipleInvitations = do
   (owner, tid, _) <- createTeam OwnDomain 0

integration/test/Testlib/Assertions.hs

@@ -252,13 +252,21 @@ super `shouldContain` sub = do
     assertFailure $ "String or List:\n" <> show super <> "\nDoes not contain:\n" <> show sub
 
 printFailureDetails :: AssertionFailure -> IO String
-printFailureDetails (AssertionFailure stack mbResponse msg) = do
+printFailureDetails (AssertionFailure stack mbResponse ctx msg) = do
   s <- prettierCallStack stack
   pure . unlines $
     colored yellow "assertion failure:"
       : colored red msg
       : "\n" <> s
       : toList (fmap prettyResponse mbResponse)
+        <> toList (fmap prettyContext ctx)
+
+prettyContext :: String -> String
+prettyContext ctx = do
+  unlines
+    [ colored yellow "context:",
+      colored blue ctx
+    ]
 
 printExceptionDetails :: SomeException -> IO String
 printExceptionDetails e = do

integration/test/Testlib/Cannon.hs

@@ -219,7 +219,7 @@ run wsConnect app = do
                   headers = mempty,
                   request = request
                 }
-        throwIO (AssertionFailure callStack (Just r) (displayException ex))
+        throwIO (AssertionFailure callStack (Just r) Nothing (displayException ex))
 
   liftIO $ race_ waitForPresence waitForException
   pure wsapp
@@ -421,7 +421,11 @@ awaitNMatches ::
   App [Value]
 awaitNMatches nExpected checkMatch ws = do
   res <- awaitNMatchesResult nExpected checkMatch ws
-  assertAwaitResult res
+  withWebSocketFailureContext ws $
+    assertAwaitResult res
+
+withWebSocketFailureContext :: WebSocket -> App a -> App a
+withWebSocketFailureContext ws = addFailureContext ("on websocket for user: " <> ws.wsConnect.user <> "@" <> ws.wsConnect.domain)
 
 assertAwaitResult :: (HasCallStack) => AwaitResult -> App [Value]
 assertAwaitResult res = do
@@ -481,7 +485,7 @@ assertNoEvent ::
   Int ->
   WebSocket ->
   App ()
-assertNoEvent to ws = do
+assertNoEvent to ws = withWebSocketFailureContext ws $ do
   mEvent <- awaitAnyEvent to ws
   case mEvent of
     Just event -> assertFailure $ "Expected no event, but got: " <> show event

integration/test/Testlib/HTTP.hs

@@ -139,8 +139,8 @@ assertLabel status label resp = do
 onFailureAddResponse :: (HasCallStack) => Response -> App a -> App a
 onFailureAddResponse r m = App $ do
   e <- ask
-  liftIO $ E.catch (runAppWithEnv e m) $ \(AssertionFailure stack _ msg) -> do
-    E.throw (AssertionFailure stack (Just r) msg)
+  liftIO $ E.catch (runAppWithEnv e m) $ \(AssertionFailure stack _ ctx msg) -> do
+    E.throw (AssertionFailure stack (Just r) ctx msg)
 
 data Versioned = Versioned | Unversioned | ExplicitVersion Int
   deriving stock (Generic)

integration/test/Testlib/JSON.hs

@@ -25,6 +25,7 @@ import Data.String
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import Data.Vector ((!?))
+import qualified Data.Vector as V
 import GHC.Stack
 import Testlib.Types
 import Prelude
@@ -237,7 +238,10 @@ lookupField val selector = do
         Object ob -> pure (KM.lookup (KM.fromString k) ob)
         -- index array
         Array arr -> case reads k of
-          [(i, "")] -> pure (arr !? i)
+          [(i, "")] ->
+            if i >= 0
+              then pure (arr !? i)
+              else pure (arr !? (V.length arr + i))
           _ -> assertFailureWithJSON arr $ "Invalid array index \"" <> k <> "\""
         x -> assertFailureWithJSON x ("Object or Array" `typeWasExpectedButGot` x)
     go k [] v = get v k

integration/test/Testlib/Types.hs

@@ -312,14 +312,15 @@ getRequestBody req = case HTTP.requestBody req of
 data AssertionFailure = AssertionFailure
   { callstack :: CallStack,
     response :: Maybe Response,
+    context :: Maybe String,
     msg :: String
   }
 
 instance Show AssertionFailure where
-  show (AssertionFailure _ _ msg) = "AssertionFailure _ _ " <> show msg
+  show (AssertionFailure _ _ _ msg) = "AssertionFailure _ _ _ " <> show msg
 
 instance Exception AssertionFailure where
-  displayException (AssertionFailure _ _ msg) = msg
+  displayException (AssertionFailure _ _ _ msg) = msg
 
 newtype App a = App {unApp :: ReaderT Env IO a}
   deriving newtype
@@ -391,7 +392,7 @@ assertFailure :: (HasCallStack) => String -> App a
 assertFailure msg =
   forceList msg $
     liftIO $
-      E.throw (AssertionFailure callStack Nothing msg)
+      E.throw (AssertionFailure callStack Nothing Nothing msg)
   where
     forceList [] y = y
     forceList (x : xs) y = seq x (forceList xs y)
@@ -404,11 +405,16 @@ assertNothing :: (HasCallStack) => Maybe a -> App ()
 assertNothing = maybe (pure ()) $ const $ assertFailure "Maybe value was Just, not Nothing"
 
 addFailureContext :: String -> App a -> App a
-addFailureContext msg = modifyFailureMsg (\m -> m <> "\nThis failure happened in this context:\n" <> msg)
+addFailureContext ctx = modifyFailureContext (\mCtx0 -> Just $ maybe ctx (\x -> ctx <> "\n" <> x) mCtx0)
 
 modifyFailureMsg :: (String -> String) -> App a -> App a
 modifyFailureMsg modMessage = modifyFailure (\e -> e {msg = modMessage e.msg})
 
+modifyFailureContext :: (Maybe String -> Maybe String) -> App a -> App a
+modifyFailureContext modContext =
+  modifyFailure
+    (\e -> e {context = modContext e.context})
+
 modifyFailure :: (AssertionFailure -> AssertionFailure) -> App a -> App a
 modifyFailure modifyAssertion action = do
   env <- ask