Merge pull request #21 from haskell-works/newhoggy/allow-more-time-fo…

…r-rds-cluster-to-start Allow more time for RDS cluster to start
haskell-works · Oct 2, 2024 · b08eabd · b08eabd
2 parents bfc65f5 + 4b1f73a
commit b08eabd
Showing 1 changed file with 2 additions and 2 deletions.
diff --git a/testlib/Data/RdsData/Polysemy/Test/Cluster.hs b/testlib/Data/RdsData/Polysemy/Test/Cluster.hs
@@ -124,13 +124,13 @@ waitUntilRdsDbClusterAvailable :: ()
   -> Sem r ()
 waitUntilRdsDbClusterAvailable dbClusterArn =
   withFrozenCallStack do
-    repeatNWhileM_ 24 $ \_ -> do
+    repeatNWhileM_ 120 $ \_ -> do
       result <- sendAws $
         AWS.newDescribeDBClusters
           & the @"dbClusterIdentifier" .~ Just dbClusterArn
 
       let mStatus = result ^? the @"dbClusters" . _Just . each . the @"status" . _Just
 
       if mStatus == Just "available"
-        then pure False
+        then threadDelay 1_000_000 >> pure False
         else threadDelay 1_000_000 >> pure True