Note on race condition in integration test. (#2719)

wireapp · Sep 23, 2022 · 987c648 · 987c648
1 parent b83b671
commit 987c648
Show file tree

Hide file tree

Showing 5 changed files with 16 additions and 9 deletions.
diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs
@@ -733,7 +733,8 @@ testDeleteTeamBotTeam config db brig galley cannon = withTestService config db b
   forM_ [uid1, uid2] $ \uid -> do
     void $ retryWhileN 20 (/= Intra.Deleted) (getStatus brig uid)
     chkStatus brig uid Intra.Deleted
-    getConversation galley uid cid !!! const 404 === statusCode
+    eventually $ do
+      getConversation galley uid cid !!! const 404 === statusCode
   -- Check the bot cannot see the conversation either
   getBotConv galley bid cid !!! const 404 === statusCode
 

diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs
@@ -1048,6 +1048,10 @@ aFewTimes
       (\_ -> pure . not . good)
       (const action)
 
+-- see also: `aFewTimes`.  we should really clean this up.
+eventually :: (MonadIO m, MonadMask m) => m a -> m a
+eventually = recovering (limitRetries 3 <> exponentialBackoff 100000) [] . const
+
 assertOne :: (HasCallStack, MonadIO m, Show a) => [a] -> m a
 assertOne [a] = pure a
 assertOne xs = liftIO . assertFailure $ "Expected exactly one element, found " <> show xs

diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs
@@ -33,7 +33,6 @@ import qualified Brig.Types.Intra as Brig
 import Control.Arrow ((>>>))
 import Control.Lens hiding ((#), (.=))
 import Control.Monad.Catch
-import Control.Retry
 import Data.Aeson hiding (json)
 import Data.ByteString.Conversion
 import Data.ByteString.Lazy (fromStrict)
@@ -75,7 +74,7 @@ import Test.Tasty
 import Test.Tasty.Cannon (TimeoutUnit (..), (#))
 import qualified Test.Tasty.Cannon as WS
 import Test.Tasty.HUnit
-import TestHelpers (test, viewFederationDomain)
+import TestHelpers (eventually, test, viewFederationDomain)
 import TestSetup (TestM, TestSetup, tsBrig, tsCannon, tsGConf, tsGalley)
 import UnliftIO (mapConcurrently)
 import Wire.API.Conversation
@@ -491,8 +490,6 @@ testCreateOne2OneWithMembers (rolePermissions -> perms) = do
 -- | At the time of writing this test, the only event sent to this queue is 'MemberJoin'.
 testTeamQueue :: TestM ()
 testTeamQueue = do
-  let eventually = recovering (limitRetries 3 <> exponentialBackoff 100000) [] . const
-
   (owner, tid) <- createBindingTeam
   eventually $ do
     queue <- getTeamQueue owner Nothing Nothing False

diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs
@@ -51,7 +51,7 @@ import Test.QuickCheck (Gen, generate, suchThat)
 import Test.Tasty
 import qualified Test.Tasty.Cannon as WS
 import Test.Tasty.HUnit (assertFailure, (@?=))
-import TestHelpers (test)
+import TestHelpers (eventually, test)
 import TestSetup
 import Wire.API.Conversation.Protocol (ProtocolTag (ProtocolMLSTag, ProtocolProteusTag))
 import qualified Wire.API.Event.FeatureConfig as FeatureConfig
@@ -495,17 +495,17 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do
   nonMember <- Util.randomUser
 
   let getFlag :: HasCallStack => Public.FeatureStatus -> TestM ()
-      getFlag expected =
+      getFlag expected = eventually $ do
         flip (assertFlagNoConfig @cfg) expected $ Util.getTeamFeatureFlag @cfg member tid
 
       getFeatureConfig :: HasCallStack => Public.FeatureStatus -> FeatureTTL -> TestM ()
-      getFeatureConfig expectedStatus expectedTtl = do
+      getFeatureConfig expectedStatus expectedTtl = eventually $ do
         actual <- Util.getFeatureConfig @cfg member
         liftIO $ Public.wsStatus actual @?= expectedStatus
         liftIO $ Public.wsTTL actual @?= expectedTtl
 
       getFlagInternal :: HasCallStack => Public.FeatureStatus -> TestM ()
-      getFlagInternal expected =
+      getFlagInternal expected = eventually $ do
         flip (assertFlagNoConfig @cfg) expected $ Util.getTeamFeatureFlagInternal @cfg tid
 
       setFlagInternal :: Public.FeatureStatus -> FeatureTTL -> TestM ()

diff --git a/services/galley/test/integration/TestHelpers.hs b/services/galley/test/integration/TestHelpers.hs
@@ -21,6 +21,8 @@ module TestHelpers where
 
 import API.SQS
 import Control.Lens (view)
+import Control.Monad.Catch (MonadMask)
+import Control.Retry
 import Data.Domain (Domain)
 import Data.Qualified
 import qualified Galley.Aws as Aws
@@ -60,3 +62,6 @@ qualifyLocal :: a -> TestM (Local a)
 qualifyLocal x = do
   domain <- viewFederationDomain
   pure $ toLocalUnsafe domain x
+
+eventually :: (MonadIO m, MonadMask m) => m a -> m a
+eventually = recovering (limitRetries 3 <> exponentialBackoff 100000) [] . const