-- | The migration has these phases.
-- 1. Write to cassandra (before any migration activity)
-- 2. Galley is prepared for migrations (new things created in PG, old things are in Cassandra)
-- 3. Backgound worker starts migration
-- 4. Background worker finishes migration, galley is still configured to think migration is on going
-- 5. Background worker is configured to not do anything, galley is configured to only use PG
--
-- The comments and variable names call these phases by number i.e. Phase1, Phase2, and so on.
--
-- The tests are from the perspective of mel, a user on the dynamic backend,
-- called backendM (migrating backend). There are also users called mark and mia
-- on this backend.
module Test.Conversation.Migration where

import API.Galley
import Control.Applicative
import Control.Concurrent (threadDelay)
import Control.Monad.Codensity
import Control.Monad.Reader
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import GHC.Stack
import MLS.Util
import Notifications
import SetupHelpers hiding (deleteUser)
import Testlib.Prelude
import Testlib.ResourcePool
import Text.Regex.TDFA ((=~))
import UnliftIO

-- | Our test setup cannot process updates to many MLS convs concurrently, so we
-- run this will only 1 conv per type per phase and use no concurrency.
testMigrationToPostgresMLS :: App ()
testMigrationToPostgresMLS :: App ()
testMigrationToPostgresMLS = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  (alice, aliceTid, _) <- createTeam OwnDomain 1
  (bob, bobTid, _) <- createTeam OtherDomain 1
  [aliceC, bobC] <- traverse (createMLSClient def) [alice, bob]

  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
migratingBackend] -> do
    let domainM :: String
domainM = BackendResource
migratingBackend.berDomain
    (mel, melC, mark, markC, mia, miaC, miaTid, domainAConvs, domainBConvs, domainMConvs, otherMelConvs) <- Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
migratingBackend ServiceOverrides
phase1Overrides) ((String
  -> App
       (Value, ClientIdentity, Value, ClientIdentity, Value,
        ClientIdentity, String, TestConvList, TestConvList, TestConvList,
        [Value]))
 -> App
      (Value, ClientIdentity, Value, ClientIdentity, Value,
       ClientIdentity, String, TestConvList, TestConvList, TestConvList,
       [Value]))
-> (String
    -> App
         (Value, ClientIdentity, Value, ClientIdentity, Value,
          ClientIdentity, String, TestConvList, TestConvList, TestConvList,
          [Value]))
-> App
     (Value, ClientIdentity, Value, ClientIdentity, Value,
      ClientIdentity, String, TestConvList, TestConvList, TestConvList,
      [Value])
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      [mel, mark] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [String
domainM, String
domainM]
      (mia, miaTid, _) <- createTeam domainM 1
      [melC, markC, miaC] <- traverse (createMLSClient def) [mel, mark, mia]
      connectUsers [alice, bob, mel, mark, mia]
      otherMelConvs <- getAllConvIds mel 100

      domainAConvs <- createTestConvs aliceC aliceTid melC markC []
      domainBConvs <- createTestConvs bobC bobTid melC markC []
      domainMConvs <- createTestConvs miaC miaTid melC markC []
      pure (mel, melC, mark, markC, mia, miaC, miaTid, domainAConvs, domainBConvs, domainMConvs, otherMelConvs)

    newConvsRef <- newIORef []
    addUsersToFailureContext [("alice", alice), ("bob", bob), ("mel", mel), ("mark", mark), ("mia", mia)]
      $ addJSONToFailureContext "convIds" (domainAConvs <> domainBConvs <> domainMConvs)
      $ addJSONToFailureContext "otherMelConvs" otherMelConvs
      $ do
        let runPhase :: (HasCallStack) => Int -> App ()
            runPhase Int
phase = do
              Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
migratingBackend (IntMap ServiceOverrides
phaseOverrides IntMap ServiceOverrides -> Int -> ServiceOverrides
forall a. IntMap a -> Int -> a
IntMap.! Int
phase)) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
                newDomainAConvs <- HasCallStack =>
Int
-> ClientIdentity
-> String
-> TestConvList
-> ClientIdentity
-> ClientIdentity
-> App [ConvId]
Int
-> ClientIdentity
-> String
-> TestConvList
-> ClientIdentity
-> ClientIdentity
-> App [ConvId]
runPhaseOperations Int
phase ClientIdentity
aliceC String
aliceTid TestConvList
domainAConvs ClientIdentity
melC ClientIdentity
markC
                newDomainBConvs <- runPhaseOperations phase bobC bobTid domainBConvs melC markC
                newDomainCConvs <- runPhaseOperations phase miaC miaTid domainMConvs melC markC
                let newConvs = [ConvId]
newDomainAConvs [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [ConvId]
newDomainBConvs [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [ConvId]
newDomainCConvs
                modifyIORef newConvsRef (newConvs <>)
                allNewConvs <- readIORef newConvsRef
                actualConvs <- getAllConvIds mel n
                let expectedConvsFrom TestConvList
dom =
                      TestConvList
dom.unmodifiedConvs
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [[ConvId]] -> [ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IntMap [ConvId] -> [[ConvId]]
forall a. IntMap a -> [a]
IntMap.elems (IntMap [ConvId] -> IntSet -> IntMap [ConvId]
forall a. IntMap a -> IntSet -> IntMap a
IntMap.restrictKeys TestConvList
dom.kickMelConvs ([Int] -> IntSet
IntSet.fromList [(Int
phase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) .. Int
5])))
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [[ConvId]] -> [ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IntMap [ConvId] -> [[ConvId]]
forall a. IntMap a -> [a]
IntMap.elems TestConvList
dom.kickMarkConvs)
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [[ConvId]] -> [ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IntMap [ConvId] -> [[ConvId]]
forall a. IntMap a -> [a]
IntMap.elems (IntMap [ConvId] -> IntSet -> IntMap [ConvId]
forall a. IntMap a -> IntSet -> IntMap a
IntMap.restrictKeys TestConvList
dom.delConvs ([Int] -> IntSet
IntSet.fromList [(Int
phase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) .. Int
5])))
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [[ConvId]] -> [ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IntMap [ConvId] -> [[ConvId]]
forall a. IntMap a -> [a]
IntMap.elems (IntMap [ConvId] -> IntSet -> IntMap [ConvId]
forall a. IntMap a -> IntSet -> IntMap a
IntMap.restrictKeys TestConvList
dom.addMelConvs ([Int] -> IntSet
IntSet.fromList [Int
1 .. Int
phase])))
                    expectedConvs =
                      TestConvList -> [ConvId]
expectedConvsFrom TestConvList
domainAConvs
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> TestConvList -> [ConvId]
expectedConvsFrom TestConvList
domainBConvs
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> TestConvList -> [ConvId]
expectedConvsFrom TestConvList
domainMConvs
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [ConvId]
allNewConvs

                actualConvs `shouldMatchSet` ((convIdToQidObject <$> expectedConvs) <> otherMelConvs)

                when (phase == 3) $ waitForMigration domainM
        runPhase 1
        runPhase 2
        runPhase 3
        runPhase 4
        runPhase 5
  where
    n :: Int
n = Int
1
    createTestConvs :: (HasCallStack) => ClientIdentity -> String -> ClientIdentity -> ClientIdentity -> [ClientIdentity] -> App TestConvList
    createTestConvs :: HasCallStack =>
ClientIdentity
-> String
-> ClientIdentity
-> ClientIdentity
-> [ClientIdentity]
-> App TestConvList
createTestConvs ClientIdentity
creatorC String
tid ClientIdentity
melC ClientIdentity
markC [ClientIdentity]
othersC = do
      unmodifiedConvs <- Int -> App ConvId -> App [ConvId]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (App ConvId -> App [ConvId]) -> App ConvId -> App [ConvId]
forall a b. (a -> b) -> a -> b
$ do
        HasCallStack =>
ClientIdentity -> String -> [ClientIdentity] -> App ConvId
ClientIdentity -> String -> [ClientIdentity] -> App ConvId
createTestConv ClientIdentity
creatorC String
tid (ClientIdentity
melC ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: ClientIdentity
markC ClientIdentity -> [ClientIdentity] -> [ClientIdentity]
forall a. a -> [a] -> [a]
: [ClientIdentity]
othersC)

      kickMelConvs <- forPhase $ createTestConv creatorC tid (melC : othersC)
      kickMarkConvs <- forPhase $ createTestConv creatorC tid (melC : markC : othersC)
      delConvs <- forPhase $ createTestConv creatorC tid (melC : markC : othersC)
      addMelConvs <- forPhase $ createTestConv creatorC tid othersC
      pure $ TestConvList {..}

    createTestConv :: (HasCallStack) => ClientIdentity -> String -> [ClientIdentity] -> App ConvId
    createTestConv :: HasCallStack =>
ClientIdentity -> String -> [ClientIdentity] -> App ConvId
createTestConv ClientIdentity
creatorC String
tid [ClientIdentity]
membersC = do
      conv <- HasCallStack =>
Ciphersuite -> ClientIdentity -> CreateConv -> App ConvId
Ciphersuite -> ClientIdentity -> CreateConv -> App ConvId
createNewGroupWith Ciphersuite
forall a. Default a => a
def ClientIdentity
creatorC CreateConv
defMLS {team = Just tid}
      traverse_ (uploadNewKeyPackage def) membersC
      void $ createAddCommit creatorC conv ((.qualifiedUserId) <$> membersC) >>= sendAndConsumeCommitBundle
      pure conv

    forPhase :: App a -> App (IntMap [a])
    forPhase :: forall a. App a -> App (IntMap [a])
forPhase App a
action =
      ([(Int, [a])] -> IntMap [a])
-> App [(Int, [a])] -> App (IntMap [a])
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Int, [a])] -> IntMap [a]
forall a. [(Int, a)] -> IntMap a
IntMap.fromList (App [(Int, [a])] -> App (IntMap [a]))
-> ((Int -> App (Int, [a])) -> App [(Int, [a])])
-> (Int -> App (Int, [a]))
-> App (IntMap [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> (Int -> App (Int, [a])) -> App [(Int, [a])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Int
1 .. Int
5] ((Int -> App (Int, [a])) -> App (IntMap [a]))
-> (Int -> App (Int, [a])) -> App (IntMap [a])
forall a b. (a -> b) -> a -> b
$ \Int
phase -> do
        convs <- Int -> App a -> App [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (App a -> App [a]) -> App a -> App [a]
forall a b. (a -> b) -> a -> b
$ App a
action
        pure (phase, convs)

    runPhaseOperations :: (HasCallStack) => Int -> ClientIdentity -> String -> TestConvList -> ClientIdentity -> ClientIdentity -> App [ConvId]
    runPhaseOperations :: HasCallStack =>
Int
-> ClientIdentity
-> String
-> TestConvList
-> ClientIdentity
-> ClientIdentity
-> App [ConvId]
runPhaseOperations Int
phase ClientIdentity
convAdmin String
tid TestConvList {[ConvId]
IntMap [ConvId]
addMelConvs :: TestConvList -> IntMap [ConvId]
delConvs :: TestConvList -> IntMap [ConvId]
kickMarkConvs :: TestConvList -> IntMap [ConvId]
kickMelConvs :: TestConvList -> IntMap [ConvId]
unmodifiedConvs :: TestConvList -> [ConvId]
unmodifiedConvs :: [ConvId]
kickMelConvs :: IntMap [ConvId]
kickMarkConvs :: IntMap [ConvId]
delConvs :: IntMap [ConvId]
addMelConvs :: IntMap [ConvId]
..} ClientIdentity
melC ClientIdentity
markC = do
      [ConvId] -> (ConvId -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([ConvId] -> Int -> IntMap [ConvId] -> [ConvId]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
phase IntMap [ConvId]
kickMelConvs) ((ConvId -> App ()) -> App ()) -> (ConvId -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ConvId
convId -> do
        mp <- HasCallStack =>
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
convAdmin ConvId
convId [ClientIdentity
melC]
        void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201

      [ConvId] -> (ConvId -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([ConvId] -> Int -> IntMap [ConvId] -> [ConvId]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
phase IntMap [ConvId]
kickMarkConvs) ((ConvId -> App ()) -> App ()) -> (ConvId -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ConvId
convId -> do
        mp <- HasCallStack =>
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
convAdmin ConvId
convId [ClientIdentity
markC]
        void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201

      [ConvId] -> (ConvId -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([ConvId] -> Int -> IntMap [ConvId] -> [ConvId]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
phase IntMap [ConvId]
delConvs) ((ConvId -> App ()) -> App ()) -> (ConvId -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ConvId
convId -> do
        String -> ConvId -> ClientIdentity -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
String -> conv -> user -> App Response
deleteTeamConversation String
tid ConvId
convId ClientIdentity
convAdmin App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
        ClientIdentity -> ConvId -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation ClientIdentity
convAdmin ConvId
convId App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

      [ConvId] -> (ConvId -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([ConvId] -> Int -> IntMap [ConvId] -> [ConvId]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
phase IntMap [ConvId]
addMelConvs) ((ConvId -> App ()) -> App ()) -> (ConvId -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ConvId
convId -> do
        App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
melC
        App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
convAdmin ConvId
convId [ClientIdentity
melC.qualifiedUserId] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

      Int -> App ConvId -> App [ConvId]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (App ConvId -> App [ConvId]) -> App ConvId -> App [ConvId]
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> String -> [ClientIdentity] -> App ConvId
ClientIdentity -> String -> [ClientIdentity] -> App ConvId
createTestConv ClientIdentity
convAdmin String
tid [ClientIdentity
melC]

testMigrationToPostgresProteus :: App ()
testMigrationToPostgresProteus :: App ()
testMigrationToPostgresProteus = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  (alice, aliceTid, _) <- createTeam OwnDomain 1
  (bob, bobTid, _) <- createTeam OtherDomain 1

  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
migratingBackend] -> do
    let domainM :: String
domainM = BackendResource
migratingBackend.berDomain
    (mel, _melC, mark, _markC, mia, _miaC, miaTid, domainAConvs, domainBConvs, domainMConvs, otherMelConvs) <- Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
migratingBackend ServiceOverrides
phase1Overrides) ((String
  -> App
       (Value, ClientIdentity, Value, ClientIdentity, Value,
        ClientIdentity, String, TestConvList, TestConvList, TestConvList,
        [Value]))
 -> App
      (Value, ClientIdentity, Value, ClientIdentity, Value,
       ClientIdentity, String, TestConvList, TestConvList, TestConvList,
       [Value]))
-> (String
    -> App
         (Value, ClientIdentity, Value, ClientIdentity, Value,
          ClientIdentity, String, TestConvList, TestConvList, TestConvList,
          [Value]))
-> App
     (Value, ClientIdentity, Value, ClientIdentity, Value,
      ClientIdentity, String, TestConvList, TestConvList, TestConvList,
      [Value])
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      [mel, mark] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [String
domainM, String
domainM]
      (mia, miaTid, _) <- createTeam domainM 1
      [melC, markC, miaC] <- traverse (createMLSClient def) [mel, mark, mia]
      connectUsers [alice, bob, mel, mark, mia]
      otherMelConvs <- getAllConvIds mel 100

      -- Other convs which just exist
      pooledReplicateConcurrentlyN_ parallelism 100 $ createTestConv mia miaTid []
      pooledReplicateConcurrentlyN_ parallelism 100 $ createTestConv alice aliceTid [mia]
      pooledReplicateConcurrentlyN_ parallelism 100 $ createTestConv bob bobTid [mia]

      domainAConvs <- createTestConvs alice aliceTid mel mark []
      domainBConvs <- createTestConvs bob bobTid mel mark []
      domainMConvs <- createTestConvs mia miaTid mel mark []
      pure (mel, melC, mark, markC, mia, miaC, miaTid, domainAConvs, domainBConvs, domainMConvs, otherMelConvs)

    newConvsRef <- newIORef []
    addUsersToFailureContext [("alice", alice), ("bob", bob), ("mel", mel), ("mark", mark), ("mia", mia)]
      $ addJSONToFailureContext "convIds" (domainAConvs <> domainBConvs <> domainMConvs)
      $ addJSONToFailureContext "otherMelConvs" otherMelConvs
      $ do
        let runPhase :: (HasCallStack) => Int -> App ()
            runPhase Int
phase = do
              Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
migratingBackend (IntMap ServiceOverrides
phaseOverrides IntMap ServiceOverrides -> Int -> ServiceOverrides
forall a. IntMap a -> Int -> a
IntMap.! Int
phase)) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
                newDomainAConvs <- HasCallStack =>
Int
-> Value
-> String
-> TestConvList
-> Value
-> Value
-> App [ConvId]
Int
-> Value
-> String
-> TestConvList
-> Value
-> Value
-> App [ConvId]
runPhaseOperations Int
phase Value
alice String
aliceTid TestConvList
domainAConvs Value
mel Value
mark
                newDomainBConvs <- runPhaseOperations phase bob bobTid domainBConvs mel mark
                newDomainCConvs <- runPhaseOperations phase mia miaTid domainMConvs mel mark
                let newConvs = [ConvId]
newDomainAConvs [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [ConvId]
newDomainBConvs [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [ConvId]
newDomainCConvs
                modifyIORef newConvsRef (newConvs <>)
                allNewConvs <- readIORef newConvsRef
                actualConvs <- getAllConvIds mel n
                let expectedConvsFrom TestConvList
dom =
                      TestConvList
dom.unmodifiedConvs
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [[ConvId]] -> [ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IntMap [ConvId] -> [[ConvId]]
forall a. IntMap a -> [a]
IntMap.elems (IntMap [ConvId] -> IntSet -> IntMap [ConvId]
forall a. IntMap a -> IntSet -> IntMap a
IntMap.restrictKeys TestConvList
dom.kickMelConvs ([Int] -> IntSet
IntSet.fromList [(Int
phase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) .. Int
5])))
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [[ConvId]] -> [ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IntMap [ConvId] -> [[ConvId]]
forall a. IntMap a -> [a]
IntMap.elems TestConvList
dom.kickMarkConvs)
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [[ConvId]] -> [ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IntMap [ConvId] -> [[ConvId]]
forall a. IntMap a -> [a]
IntMap.elems (IntMap [ConvId] -> IntSet -> IntMap [ConvId]
forall a. IntMap a -> IntSet -> IntMap a
IntMap.restrictKeys TestConvList
dom.delConvs ([Int] -> IntSet
IntSet.fromList [(Int
phase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) .. Int
5])))
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [[ConvId]] -> [ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IntMap [ConvId] -> [[ConvId]]
forall a. IntMap a -> [a]
IntMap.elems (IntMap [ConvId] -> IntSet -> IntMap [ConvId]
forall a. IntMap a -> IntSet -> IntMap a
IntMap.restrictKeys TestConvList
dom.addMelConvs ([Int] -> IntSet
IntSet.fromList [Int
1 .. Int
phase])))
                    expectedConvs =
                      TestConvList -> [ConvId]
expectedConvsFrom TestConvList
domainAConvs
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> TestConvList -> [ConvId]
expectedConvsFrom TestConvList
domainBConvs
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> TestConvList -> [ConvId]
expectedConvsFrom TestConvList
domainMConvs
                        [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> [ConvId]
allNewConvs

                actualConvs `shouldMatchSet` ((convIdToQidObject <$> expectedConvs) <> otherMelConvs)

                when (phase == 3) $ waitForMigration domainM
        runPhase 1
        runPhase 2
        runPhase 3
        runPhase 4
        runPhase 5
  where
    n :: Int
n = Int
20
    parallelism :: Int
parallelism = Int
8
    createTestConvs :: (HasCallStack) => Value -> String -> Value -> Value -> [Value] -> App TestConvList
    createTestConvs :: HasCallStack =>
Value -> String -> Value -> Value -> [Value] -> App TestConvList
createTestConvs Value
creatorC String
tid Value
mel Value
mark [Value]
others = do
      unmodifiedConvs <- Int -> Int -> App ConvId -> App [ConvId]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
parallelism Int
n (App ConvId -> App [ConvId]) -> App ConvId -> App [ConvId]
forall a b. (a -> b) -> a -> b
$ do
        HasCallStack => Value -> String -> [Value] -> App ConvId
Value -> String -> [Value] -> App ConvId
createTestConv Value
creatorC String
tid (Value
mel Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: Value
mark Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
others)

      kickMelConvs <- forPhase $ createTestConv creatorC tid (mel : others)
      kickMarkConvs <- forPhase $ createTestConv creatorC tid (mel : mark : others)
      delConvs <- forPhase $ createTestConv creatorC tid (mel : mark : others)
      addMelConvs <- forPhase $ createTestConv creatorC tid others
      pure $ TestConvList {..}

    createTestConv :: (HasCallStack) => Value -> String -> [Value] -> App ConvId
    createTestConv :: HasCallStack => Value -> String -> [Value] -> App ConvId
createTestConv Value
creator String
tid [Value]
members = do
      Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
creator CreateConv
defProteus {team = Just tid, qualifiedUsers = members}
        App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
        App Value -> (Value -> App ConvId) -> App ConvId
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId

    forPhase :: App a -> App (IntMap [a])
    forPhase :: forall a. App a -> App (IntMap [a])
forPhase App a
action =
      ([(Int, [a])] -> IntMap [a])
-> App [(Int, [a])] -> App (IntMap [a])
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Int, [a])] -> IntMap [a]
forall a. [(Int, a)] -> IntMap a
IntMap.fromList (App [(Int, [a])] -> App (IntMap [a]))
-> ((Int -> App (Int, [a])) -> App [(Int, [a])])
-> (Int -> App (Int, [a]))
-> App (IntMap [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> (Int -> App (Int, [a])) -> App [(Int, [a])]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> t a -> (a -> m b) -> m (t b)
pooledForConcurrentlyN Int
parallelism [Int
1 .. Int
5] ((Int -> App (Int, [a])) -> App (IntMap [a]))
-> (Int -> App (Int, [a])) -> App (IntMap [a])
forall a b. (a -> b) -> a -> b
$ \Int
phase -> do
        convs <- Int -> App a -> App [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (App a -> App [a]) -> App a -> App [a]
forall a b. (a -> b) -> a -> b
$ App a
action
        pure (phase, convs)

    retry500Once :: App Response -> App Response
    retry500Once :: App Response -> App Response
retry500Once App Response
action = do
      App Response
action App Response -> (Response -> App Response) -> App Response
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
        if Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
500 Bool -> Bool -> Bool
|| Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
422
          then App Response
action
          else Response -> App Response
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
resp

    runPhaseOperations :: (HasCallStack) => Int -> Value -> String -> TestConvList -> Value -> Value -> App [ConvId]
    runPhaseOperations :: HasCallStack =>
Int
-> Value
-> String
-> TestConvList
-> Value
-> Value
-> App [ConvId]
runPhaseOperations Int
phase Value
convAdmin String
tid TestConvList {[ConvId]
IntMap [ConvId]
addMelConvs :: TestConvList -> IntMap [ConvId]
delConvs :: TestConvList -> IntMap [ConvId]
kickMarkConvs :: TestConvList -> IntMap [ConvId]
kickMelConvs :: TestConvList -> IntMap [ConvId]
unmodifiedConvs :: TestConvList -> [ConvId]
unmodifiedConvs :: [ConvId]
kickMelConvs :: IntMap [ConvId]
kickMarkConvs :: IntMap [ConvId]
delConvs :: IntMap [ConvId]
addMelConvs :: IntMap [ConvId]
..} Value
mel Value
mark = do
      Value -> (WebSocket -> App [ConvId]) -> App [ConvId]
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
mel ((WebSocket -> App [ConvId]) -> App [ConvId])
-> (WebSocket -> App [ConvId]) -> App [ConvId]
forall a b. (a -> b) -> a -> b
$ \WebSocket
melWS -> do
        Int -> [ConvId] -> (ConvId -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism ([ConvId] -> Int -> IntMap [ConvId] -> [ConvId]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
phase IntMap [ConvId]
kickMelConvs) ((ConvId -> App ()) -> App ()) -> (ConvId -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ConvId
convId -> do
          App Response -> App Response
retry500Once (Value -> ConvId -> Value -> App Response
forall remover conv removed.
(HasCallStack, MakesValue remover, MakesValue conv,
 MakesValue removed) =>
remover -> conv -> removed -> App Response
removeMember Value
convAdmin ConvId
convId Value
mel) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

        App [Value] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [Value] -> App ()) -> App [Value] -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
awaitNMatches Int
n Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvLeaveNotif WebSocket
melWS

        Int -> [ConvId] -> (ConvId -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism ([ConvId] -> Int -> IntMap [ConvId] -> [ConvId]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
phase IntMap [ConvId]
kickMarkConvs) ((ConvId -> App ()) -> App ()) -> (ConvId -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ConvId
convId -> do
          App Response -> App Response
retry500Once (Value -> ConvId -> Value -> App Response
forall remover conv removed.
(HasCallStack, MakesValue remover, MakesValue conv,
 MakesValue removed) =>
remover -> conv -> removed -> App Response
removeMember Value
convAdmin ConvId
convId Value
mark) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

        App [Value] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [Value] -> App ()) -> App [Value] -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
awaitNMatches Int
n Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvLeaveNotif WebSocket
melWS

        Int -> [ConvId] -> (ConvId -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism ([ConvId] -> Int -> IntMap [ConvId] -> [ConvId]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
phase IntMap [ConvId]
delConvs) ((ConvId -> App ()) -> App ()) -> (ConvId -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ConvId
convId -> do
          App Response -> App Response
retry500Once (String -> ConvId -> Value -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
String -> conv -> user -> App Response
deleteTeamConversation String
tid ConvId
convId Value
convAdmin) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

        Int -> [ConvId] -> (ConvId -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism ([ConvId] -> Int -> IntMap [ConvId] -> [ConvId]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
phase IntMap [ConvId]
addMelConvs) ((ConvId -> App ()) -> App ()) -> (ConvId -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ConvId
convId -> do
          App Response -> App Response
retry500Once (Value -> ConvId -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
convAdmin ConvId
convId (AddMembers
forall a. Default a => a
def {users = [mel]})) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

        App [Value] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [Value] -> App ()) -> App [Value] -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
awaitNMatches Int
n Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvDeleteNotif WebSocket
melWS

        convIds <-
          Int -> Int -> App ConvId -> App [ConvId]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
parallelism Int
n
            (App ConvId -> App [ConvId]) -> App ConvId -> App [ConvId]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Value -> String -> [Value] -> App ConvId
Value -> String -> [Value] -> App ConvId
createTestConv Value
convAdmin String
tid [Value
mel]

        void $ awaitNMatches n isMemberJoinNotif melWS

        pure convIds

-- Test Helpers

data TestConvList = TestConvList
  { TestConvList -> [ConvId]
unmodifiedConvs :: [ConvId],
    TestConvList -> IntMap [ConvId]
kickMelConvs :: IntMap [ConvId],
    TestConvList -> IntMap [ConvId]
kickMarkConvs :: IntMap [ConvId],
    TestConvList -> IntMap [ConvId]
delConvs :: IntMap [ConvId],
    TestConvList -> IntMap [ConvId]
addMelConvs :: IntMap [ConvId]
  }

instance ToJSON TestConvList where
  toJSON :: TestConvList -> Value
toJSON TestConvList
convList = do
    [Pair] -> Value
object
      [ String -> String
forall a. IsString a => String -> a
fromString String
"unmodifiedConvs" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (ConvId -> String
mkId (ConvId -> String) -> [ConvId] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestConvList
convList.unmodifiedConvs),
        String -> String
forall a. IsString a => String -> a
fromString String
"kickMelConvs" String -> IntMap [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (ConvId -> String
mkId (ConvId -> String) -> IntMap [ConvId] -> IntMap [String]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> TestConvList
convList.kickMelConvs),
        String -> String
forall a. IsString a => String -> a
fromString String
"kickMarkConvs" String -> IntMap [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (ConvId -> String
mkId (ConvId -> String) -> IntMap [ConvId] -> IntMap [String]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> TestConvList
convList.kickMarkConvs),
        String -> String
forall a. IsString a => String -> a
fromString String
"delConvs" String -> IntMap [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (ConvId -> String
mkId (ConvId -> String) -> IntMap [ConvId] -> IntMap [String]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> TestConvList
convList.delConvs),
        String -> String
forall a. IsString a => String -> a
fromString String
"addMelConvs" String -> IntMap [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (ConvId -> String
mkId (ConvId -> String) -> IntMap [ConvId] -> IntMap [String]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> TestConvList
convList.addMelConvs)
      ]
    where
      mkId :: ConvId -> String
      mkId :: ConvId -> String
mkId ConvId
cid = ConvId
cid.id_ String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConvId
cid.domain

instance Semigroup TestConvList where
  TestConvList
l1 <> :: TestConvList -> TestConvList -> TestConvList
<> TestConvList
l2 =
    TestConvList
      { unmodifiedConvs :: [ConvId]
unmodifiedConvs = TestConvList
l1.unmodifiedConvs [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
<> TestConvList
l2.unmodifiedConvs,
        kickMelConvs :: IntMap [ConvId]
kickMelConvs = ([ConvId] -> [ConvId] -> [ConvId])
-> IntMap [ConvId] -> IntMap [ConvId] -> IntMap [ConvId]
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
(<>) TestConvList
l1.kickMelConvs TestConvList
l2.kickMelConvs,
        kickMarkConvs :: IntMap [ConvId]
kickMarkConvs = ([ConvId] -> [ConvId] -> [ConvId])
-> IntMap [ConvId] -> IntMap [ConvId] -> IntMap [ConvId]
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
(<>) TestConvList
l1.kickMarkConvs TestConvList
l2.kickMarkConvs,
        delConvs :: IntMap [ConvId]
delConvs = ([ConvId] -> [ConvId] -> [ConvId])
-> IntMap [ConvId] -> IntMap [ConvId] -> IntMap [ConvId]
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
(<>) TestConvList
l1.delConvs TestConvList
l2.delConvs,
        addMelConvs :: IntMap [ConvId]
addMelConvs = ([ConvId] -> [ConvId] -> [ConvId])
-> IntMap [ConvId] -> IntMap [ConvId] -> IntMap [ConvId]
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith [ConvId] -> [ConvId] -> [ConvId]
forall a. Semigroup a => a -> a -> a
(<>) TestConvList
l1.addMelConvs TestConvList
l2.addMelConvs
      }

waitForMigration :: (HasCallStack) => String -> App ()
waitForMigration :: HasCallStack => String -> App ()
waitForMigration String
domainM = do
  metrics <-
    String -> Service -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Service -> App Response
getMetrics String
domainM 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 (_, _, _, convFinishedMatches) :: (Text, Text, Text, [Text]) = (metrics =~ Text.pack "^wire_local_convs_migration_finished\\ ([0-9]+\\.[0-9]+)$")
  let (_, _, _, userFinishedMatches) :: (Text, Text, Text, [Text]) = (metrics =~ Text.pack "^wire_user_remote_convs_migration_finished\\ ([0-9]+\\.[0-9]+)$")
  when (convFinishedMatches /= [Text.pack "1.0"] || userFinishedMatches /= [Text.pack "1.0"]) $ do
    liftIO $ threadDelay 100_000
    waitForMigration domainM

phase1Overrides, phase2Overrides, phase3Overrides, phase4Overrides, phase5Overrides :: ServiceOverrides
phase1Overrides :: ServiceOverrides
phase1Overrides =
  ServiceOverrides
forall a. Default a => a
def
    { galleyCfg = setField "postgresMigration.conversation" "cassandra",
      backgroundWorkerCfg = setField "migrateConversations" False
    }
phase2Overrides :: ServiceOverrides
phase2Overrides =
  ServiceOverrides
forall a. Default a => a
def
    { galleyCfg = setField "postgresMigration.conversation" "migration-to-postgresql",
      backgroundWorkerCfg = setField "migrateConversations" False
    }
phase3Overrides :: ServiceOverrides
phase3Overrides =
  ServiceOverrides
forall a. Default a => a
def
    { galleyCfg = setField "postgresMigration.conversation" "migration-to-postgresql",
      backgroundWorkerCfg = setField "migrateConversations" True
    }
phase4Overrides :: ServiceOverrides
phase4Overrides =
  ServiceOverrides
forall a. Default a => a
def
    { galleyCfg = setField "postgresMigration.conversation" "migration-to-postgresql",
      backgroundWorkerCfg = setField "migrateConversations" False
    }
phase5Overrides :: ServiceOverrides
phase5Overrides =
  ServiceOverrides
forall a. Default a => a
def
    { galleyCfg = setField "postgresMigration.conversation" "postgresql",
      backgroundWorkerCfg = setField "migrateConversations" False
    }

phaseOverrides :: IntMap ServiceOverrides
phaseOverrides :: IntMap ServiceOverrides
phaseOverrides =
  [(Int, ServiceOverrides)] -> IntMap ServiceOverrides
forall a. [(Int, a)] -> IntMap a
IntMap.fromList
    [ (Int
1, ServiceOverrides
phase1Overrides),
      (Int
2, ServiceOverrides
phase2Overrides),
      (Int
3, ServiceOverrides
phase3Overrides),
      (Int
4, ServiceOverrides
phase4Overrides),
      (Int
5, ServiceOverrides
phase5Overrides)
    ]