Merge branch 'wireapp:develop' into develop

changelog.d/5-internal/wpb-15151-revive-and-translate-tests

@@ -1 +1 @@
-Revive and translate old integration test.
+Revive and translate old integration test (#4387, ##)

integration/test/SetupHelpers.hs

@@ -8,7 +8,6 @@ import API.BrigInternal
 import API.Cargohold
 import API.Common
 import API.Galley
-import API.GalleyInternal (legalholdWhitelistTeam)
 import API.Spar
 import Control.Monad.Reader
 import Crypto.Random (getRandomBytes)
@@ -34,7 +33,6 @@ import qualified SAML2.WebSSO.API.Example as SAML
 import qualified SAML2.WebSSO.Test.MockResponse as SAML
 import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata)
 import Testlib.JSON
-import Testlib.MockIntegrationService (mkLegalHoldSettings)
 import Testlib.Prelude
 import Testlib.Printing (indent)
 import qualified Text.XML as XML
@@ -324,30 +322,6 @@ setupProvider u np@(NewProvider {..}) = do
   activateProvider dom key code
   loginProvider dom newProviderEmail pass $> provider
 
--- | setup a legalhold device for @uid@, authorised by @owner@
---   at the specified port
-setUpLHDevice ::
-  (HasCallStack, MakesValue tid, MakesValue owner, MakesValue uid) =>
-  tid ->
-  owner ->
-  uid ->
-  -- | the host and port the LH service is running on
-  (String, Int) ->
-  App ()
-setUpLHDevice tid alice bob lhPort = do
-  legalholdWhitelistTeam tid alice
-    >>= assertStatus 200
-
-  -- the status messages for these have already been tested
-  postLegalHoldSettings tid alice (mkLegalHoldSettings lhPort)
-    >>= assertStatus 201
-
-  requestLegalHoldDevice tid alice bob
-    >>= assertStatus 201
-
-  approveLegalHoldDevice tid bob defPassword
-    >>= assertStatus 200
-
 lhDeviceIdOf :: (MakesValue user) => user -> App String
 lhDeviceIdOf bob = do
   bobId <- objId bob

integration/test/Test/Events.hs

@@ -23,7 +23,7 @@ import Servant.API (AsApi, ToServant, toServant)
 import Servant.API.Generic (fromServant)
 import qualified Servant.Client as Servant
 import SetupHelpers
-import Testlib.Prelude hiding (assertNoEvent)
+import Testlib.Prelude
 import UnliftIO hiding (handle)
 
 testConsumeEventsOneWebSocket :: (HasCallStack) => App ()
@@ -480,21 +480,23 @@ testChannelKilled = startDynamicBackendsReturnResources [def] $ \[backend] -> do
       >>= asString
 
   runCodensity (createEventsWebSocket alice (Just c1)) $ \ws -> do
-    assertEvent ws $ \e -> do
+    -- If creating the user takes longer (async) than adding the clients, we get a
+    -- `"user.activate"` here, so we use `assertFindsEvent`.
+
+    assertFindsEvent ws $ \e -> do
       e %. "data.event.payload.0.type" `shouldMatch` "user.client-add"
       e %. "data.event.payload.0.client.id" `shouldMatch` c1
       ackEvent ws e
 
-    assertEvent ws $ \e -> do
+    assertFindsEvent ws $ \e -> do
       e %. "data.event.payload.0.type" `shouldMatch` "user.client-add"
       e %. "data.event.payload.0.client.id" `shouldMatch` c2
 
-      recoverAll
-        (constantDelay 500_000 <> limitRetries 10)
-        (const (killConnection backend))
+    recoverAll
+      (constantDelay 500_000 <> limitRetries 10)
+      (const (killConnection backend))
 
-    noEvent <- assertNoEvent ws
-    noEvent `shouldMatch` WebSocketDied
+    assertWebSocketDied ws
 
 ----------------------------------------------------------------------
 -- helpers
@@ -622,17 +624,30 @@ instance ToJSON NoEvent where
   toJSON NoEvent = toJSON "no-event"
   toJSON WebSocketDied = toJSON "web-socket-died"
 
-assertNoEvent :: (HasCallStack) => EventWebSocket -> App NoEvent
-assertNoEvent ws = do
-  timeout 1_000_000 (readChan ws.events) >>= \case
+assertNoEventHelper :: (HasCallStack) => EventWebSocket -> App NoEvent
+assertNoEventHelper ws = do
+  timeOutSeconds <- asks (.timeOutSeconds)
+  timeout (timeOutSeconds * 1_000_000) (readChan ws.events) >>= \case
     Nothing -> pure NoEvent
     Just (Left _) -> pure WebSocketDied
     Just (Right e) -> do
       eventJSON <- prettyJSON e
       assertFailure $ "Did not expect event: \n" <> eventJSON
 
+-- | Similar to `assertNoEvent` from Testlib, but with rabbitMQ typing (`/event` end-point, not
+-- `/await`).
 assertNoEvent_ :: (HasCallStack) => EventWebSocket -> App ()
-assertNoEvent_ = void . assertNoEvent
+assertNoEvent_ = void . assertNoEventHelper
+
+assertWebSocketDied :: (HasCallStack) => EventWebSocket -> App ()
+assertWebSocketDied ws = do
+  recpol <- do
+    timeOutSeconds <- asks (.timeOutSeconds)
+    pure $ limitRetriesByCumulativeDelay (timeOutSeconds * 1_000_000) (constantDelay 800_000)
+  recoverAll recpol $ \_ ->
+    assertNoEventHelper ws >>= \case
+      NoEvent -> assertFailure $ "WebSocket is still open"
+      WebSocketDied -> pure ()
 
 consumeAllEvents :: EventWebSocket -> App ()
 consumeAllEvents ws = do