module Test.Migration.Util where import Control.Applicative import Control.Concurrent (threadDelay) import Control.Monad.Reader import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import GHC.Stack import SetupHelpers hiding (deleteUser) import Testlib.Prelude import Text.Regex.TDFA ((=~)) waitForMigration :: (HasCallStack) => String -> String -> App () waitForMigration :: HasCallStack => String -> String -> App () waitForMigration String domain String name = do metrics <- String -> Service -> App Response forall domain. (HasCallStack, MakesValue domain) => domain -> Service -> App Response getMetrics String domain Service BackgroundWorker App Response -> (Response -> App Text) -> App Text forall a. HasCallStack => App Response -> (Response -> App a) -> App a `bindResponse` \Response resp -> do Response resp.status Int -> Int -> App () forall a. (MakesValue a, HasCallStack) => a -> Int -> App () `shouldMatchInt` Int 200 Text -> App Text forall a. a -> App a forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> App Text) -> Text -> App Text forall a b. (a -> b) -> a -> b $ ByteString -> Text Text.decodeUtf8 Response resp.body let (_, _, _, finishedMatches) :: (Text, Text, Text, [Text]) = (metrics =~ Text.pack (name <> "\\ ([0-9]+\\.[0-9]+)$")) when (finishedMatches /= [Text.pack "1.0"]) $ do liftIO $ threadDelay 100_000 waitForMigration domain name