Don't setup what we don't need

Author: supersven

integration/test/Testlib/Run.hs

@@ -132,7 +132,7 @@ runTests tests mXMLOutput cfg shardingGroup = do
       -- Although migrations are run on service start up we are running them here before
       -- to prevent race conditions between brig and galley
       -- which cause flakiness and can make the complete test suite fail
-      runAppWithEnv env runMigrations
+      -- runAppWithEnv env runMigrations
       -- Currently 4 seems to be stable, more seems to create more timeouts.
       report <- fmap mconcat $ pooledForConcurrentlyN 4 tests $ \(qname, _, _, action) -> do
         timestamp <- getCurrentTime
@@ -156,7 +156,7 @@ runTests tests mXMLOutput cfg shardingGroup = do
             pure (TestSuiteReport [TestCaseReport qname TestSuccess tm])
       writeChan output Nothing
       wait displayThread
-      deleteFederationV0AndV1Queues genv
+      -- deleteFederationV0AndV1Queues genv
       printReport report
       mapM_ (saveXMLReport report) mXMLOutput
       when (any (\testCase -> testCase.result /= TestSuccess) report.cases) $
@@ -168,58 +168,58 @@ runTests tests mXMLOutput cfg shardingGroup = do
       e <- mkEnv Nothing g
       pure (g, e)
 
-runMigrations :: App ()
-runMigrations = do
-  cwdBase <- asks (.servicesCwdBase)
-  let brig = "brig"
-  let (cwd, exe) = case cwdBase of
-        Nothing -> (Nothing, brig)
-        Just dir ->
-          (Just (dir </> brig), "../../dist" </> brig)
-  getConfig <- readAndUpdateConfig def backendA Brig
-  config <- liftIO getConfig
-  tempFile <- liftIO $ writeTempFile "/tmp" "brig-migrations.yaml" (cs $ Yaml.encode config)
-  dynDomains <- asks (.dynamicDomains)
-  pool <- asks (.resourcePool)
-  lowerCodensity $ do
-    resources <- acquireResources (length dynDomains) pool
-    let dbnames = [backendA.berPostgresqlDBName, backendB.berPostgresqlDBName] <> map (.berPostgresqlDBName) resources
-    for_ dbnames $ runMigration exe tempFile cwd
-    liftIO $ putStrLn "Postgres migrations finished"
-  where
-    runMigration :: (MonadIO m) => FilePath -> FilePath -> Maybe FilePath -> String -> m ()
-    runMigration exe tempFile cwd dbname = do
-      let cp = (proc exe ["-c", tempFile, "migrate-postgres", "--dbname", dbname]) {cwd}
-      (_, _, _, ph) <- liftIO $ createProcess cp
-      void $ liftIO $ waitForProcess ph
-
-deleteFederationV0AndV1Queues :: GlobalEnv -> IO ()
-deleteFederationV0AndV1Queues env = do
-  let testDomains = env.gDomain1 : env.gDomain2 : env.gDynamicDomains
-  putStrLn "Attempting to delete federation V0 queues..."
-  (mV0User, mV0Pass) <- readCredsFromEnvWithSuffix "V0"
-  fromMaybe (putStrLn "No or incomplete credentials for fed V0 RabbitMQ") $
-    deleteFederationQueues testDomains env.gRabbitMQConfigV0 <$> mV0User <*> mV0Pass
-
-  putStrLn "Attempting to delete federation V1 queues..."
-  (mV1User, mV1Pass) <- readCredsFromEnvWithSuffix "V1"
-  fromMaybe (putStrLn "No or incomplete credentials for fed V1 RabbitMQ") $
-    deleteFederationQueues testDomains env.gRabbitMQConfigV1 <$> mV1User <*> mV1Pass
-  where
-    readCredsFromEnvWithSuffix :: String -> IO (Maybe Text, Maybe Text)
-    readCredsFromEnvWithSuffix suffix =
-      (,)
-        <$> (fmap fromString <$> lookupEnv ("RABBITMQ_USERNAME_" <> suffix))
-        <*> (fmap fromString <$> lookupEnv ("RABBITMQ_PASSWORD_" <> suffix))
-
-deleteFederationQueues :: [String] -> RabbitMqAdminOpts -> Text -> Text -> IO ()
-deleteFederationQueues testDomains opts username password = do
-  client <- mkRabbitMqAdminClientEnvWithCreds opts username password
-  for_ testDomains $ \domain -> do
-    page <- client.listQueuesByVHost opts.vHost (fromString $ "^backend-notifications\\." <> domain <> "$") True 100 1
-    for_ page.items $ \queue -> do
-      putStrLn $ "Deleting queue " <> T.unpack queue.name
-      void $ deleteQueue client opts.vHost queue.name
+-- runMigrations :: App ()
+-- runMigrations = do
+--   cwdBase <- asks (.servicesCwdBase)
+--   let brig = "brig"
+--   let (cwd, exe) = case cwdBase of
+--         Nothing -> (Nothing, brig)
+--         Just dir ->
+--           (Just (dir </> brig), "../../dist" </> brig)
+--   getConfig <- readAndUpdateConfig def backendA Brig
+--   config <- liftIO getConfig
+--   tempFile <- liftIO $ writeTempFile "/tmp" "brig-migrations.yaml" (cs $ Yaml.encode config)
+--   dynDomains <- asks (.dynamicDomains)
+--   pool <- asks (.resourcePool)
+--   lowerCodensity $ do
+--     resources <- acquireResources (length dynDomains) pool
+--     let dbnames = [backendA.berPostgresqlDBName, backendB.berPostgresqlDBName] <> map (.berPostgresqlDBName) resources
+--     for_ dbnames $ runMigration exe tempFile cwd
+--     liftIO $ putStrLn "Postgres migrations finished"
+--   where
+--     runMigration :: (MonadIO m) => FilePath -> FilePath -> Maybe FilePath -> String -> m ()
+--     runMigration exe tempFile cwd dbname = do
+--       let cp = (proc exe ["-c", tempFile, "migrate-postgres", "--dbname", dbname]) {cwd}
+--       (_, _, _, ph) <- liftIO $ createProcess cp
+--       void $ liftIO $ waitForProcess ph
+
+-- deleteFederationV0AndV1Queues :: GlobalEnv -> IO ()
+-- deleteFederationV0AndV1Queues env = do
+--   let testDomains = env.gDomain1 : env.gDomain2 : env.gDynamicDomains
+--   putStrLn "Attempting to delete federation V0 queues..."
+--   (mV0User, mV0Pass) <- readCredsFromEnvWithSuffix "V0"
+--   fromMaybe (putStrLn "No or incomplete credentials for fed V0 RabbitMQ") $
+--     deleteFederationQueues testDomains env.gRabbitMQConfigV0 <$> mV0User <*> mV0Pass
+--
+--   putStrLn "Attempting to delete federation V1 queues..."
+--   (mV1User, mV1Pass) <- readCredsFromEnvWithSuffix "V1"
+--   fromMaybe (putStrLn "No or incomplete credentials for fed V1 RabbitMQ") $
+--     deleteFederationQueues testDomains env.gRabbitMQConfigV1 <$> mV1User <*> mV1Pass
+--   where
+--     readCredsFromEnvWithSuffix :: String -> IO (Maybe Text, Maybe Text)
+--     readCredsFromEnvWithSuffix suffix =
+--       (,)
+--         <$> (fmap fromString <$> lookupEnv ("RABBITMQ_USERNAME_" <> suffix))
+--         <*> (fmap fromString <$> lookupEnv ("RABBITMQ_PASSWORD_" <> suffix))
+--
+-- deleteFederationQueues :: [String] -> RabbitMqAdminOpts -> Text -> Text -> IO ()
+-- deleteFederationQueues testDomains opts username password = do
+--   client <- mkRabbitMqAdminClientEnvWithCreds opts username password
+--   for_ testDomains $ \domain -> do
+--     page <- client.listQueuesByVHost opts.vHost (fromString $ "^backend-notifications\\." <> domain <> "$") True 100 1
+--     for_ page.items $ \queue -> do
+--       putStrLn $ "Deleting queue " <> T.unpack queue.name
+--       void $ deleteQueue client opts.vHost queue.name
 
 doListTests :: [(String, String, String, x)] -> IO ()
 doListTests tests = for_ tests $ \(qname, _desc, _full, _) -> do