-- | 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 BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  (Value
alice, String
aliceTid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  (Value
bob, String
bobTid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OtherDomain Int
1
  [ClientIdentity
aliceC, ClientIdentity
bobC] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
bob]

  Codensity App [BackendResource]
-> forall b. ([BackendResource] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
1 ResourcePool BackendResource
resourcePool) (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
migratingBackend] -> do
    let domainM :: String
domainM = BackendResource
migratingBackend.berDomain
    (Value
mel, ClientIdentity
melC, Value
mark, ClientIdentity
markC, Value
mia, ClientIdentity
miaC, String
miaTid, TestConvList
domainAConvs, TestConvList
domainBConvs, TestConvList
domainMConvs, [Value]
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
      [Value
mel, Value
mark] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [String
domainM, String
domainM]
      (Value
mia, String
miaTid, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domainM Int
1
      [ClientIdentity
melC, ClientIdentity
markC, ClientIdentity
miaC] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def) [Value
mel, Value
mark, Value
mia]
      [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
bob, Value
mel, Value
mark, Value
mia]
      [Value]
otherMelConvs <- Value -> Int -> App [Value]
forall u. (HasCallStack, MakesValue u) => u -> Int -> App [Value]
getAllConvIds Value
mel Int
100

      TestConvList
domainAConvs <- HasCallStack =>
ClientIdentity
-> String
-> ClientIdentity
-> ClientIdentity
-> [ClientIdentity]
-> App TestConvList
ClientIdentity
-> String
-> ClientIdentity
-> ClientIdentity
-> [ClientIdentity]
-> App TestConvList
createTestConvs ClientIdentity
aliceC String
aliceTid ClientIdentity
melC ClientIdentity
markC []
      TestConvList
domainBConvs <- HasCallStack =>
ClientIdentity
-> String
-> ClientIdentity
-> ClientIdentity
-> [ClientIdentity]
-> App TestConvList
ClientIdentity
-> String
-> ClientIdentity
-> ClientIdentity
-> [ClientIdentity]
-> App TestConvList
createTestConvs ClientIdentity
bobC String
bobTid ClientIdentity
melC ClientIdentity
markC []
      TestConvList
domainMConvs <- HasCallStack =>
ClientIdentity
-> String
-> ClientIdentity
-> ClientIdentity
-> [ClientIdentity]
-> App TestConvList
ClientIdentity
-> String
-> ClientIdentity
-> ClientIdentity
-> [ClientIdentity]
-> App TestConvList
createTestConvs ClientIdentity
miaC String
miaTid ClientIdentity
melC ClientIdentity
markC []
      (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. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
mel, ClientIdentity
melC, Value
mark, ClientIdentity
markC, Value
mia, ClientIdentity
miaC, String
miaTid, TestConvList
domainAConvs, TestConvList
domainBConvs, TestConvList
domainMConvs, [Value]
otherMelConvs)

    IORef [ConvId]
newConvsRef <- [ConvId] -> App (IORef [ConvId])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
    [(String, Value)] -> App () -> App ()
forall user a.
MakesValue user =>
[(String, user)] -> App a -> App a
addUsersToFailureContext [(String
"alice", Value
alice), (String
"bob", Value
bob), (String
"mel", Value
mel), (String
"mark", Value
mark), (String
"mia", Value
mia)]
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> TestConvList -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"convIds" (TestConvList
domainAConvs TestConvList -> TestConvList -> TestConvList
forall a. Semigroup a => a -> a -> a
<> TestConvList
domainBConvs TestConvList -> TestConvList -> TestConvList
forall a. Semigroup a => a -> a -> a
<> TestConvList
domainMConvs)
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> [Value] -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"otherMelConvs" [Value]
otherMelConvs
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
        let runPhase :: (HasCallStack) => Int -> App ()
            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
                [ConvId]
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
                [ConvId]
newDomainBConvs <- HasCallStack =>
Int
-> ClientIdentity
-> String
-> TestConvList
-> ClientIdentity
-> ClientIdentity
-> App [ConvId]
Int
-> ClientIdentity
-> String
-> TestConvList
-> ClientIdentity
-> ClientIdentity
-> App [ConvId]
runPhaseOperations Int
phase ClientIdentity
bobC String
bobTid TestConvList
domainBConvs ClientIdentity
melC ClientIdentity
markC
                [ConvId]
newDomainCConvs <- HasCallStack =>
Int
-> ClientIdentity
-> String
-> TestConvList
-> ClientIdentity
-> ClientIdentity
-> App [ConvId]
Int
-> ClientIdentity
-> String
-> TestConvList
-> ClientIdentity
-> ClientIdentity
-> App [ConvId]
runPhaseOperations Int
phase ClientIdentity
miaC String
miaTid TestConvList
domainMConvs ClientIdentity
melC ClientIdentity
markC
                let newConvs :: [ConvId]
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
                IORef [ConvId] -> ([ConvId] -> [ConvId]) -> App ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef [ConvId]
newConvsRef ([ConvId]
newConvs <>)
                [ConvId]
allNewConvs <- IORef [ConvId] -> App [ConvId]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [ConvId]
newConvsRef
                [Value]
actualConvs <- Value -> Int -> App [Value]
forall u. (HasCallStack, MakesValue u) => u -> Int -> App [Value]
getAllConvIds Value
mel Int
n
                let expectedConvsFrom :: TestConvList -> [ConvId]
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 :: [ConvId]
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

                [Value]
actualConvs [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ((ConvId -> Value
convIdToQidObject (ConvId -> Value) -> [ConvId] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ConvId]
expectedConvs) [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
otherMelConvs)

                Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
phase Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> App ()
String -> App ()
waitForMigration String
domainM
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
1
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
2
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
3
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
4
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
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
      [ConvId]
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)

      IntMap [ConvId]
kickMelConvs <- App ConvId -> App (IntMap [ConvId])
forall a. App a -> App (IntMap [a])
forPhase (App ConvId -> App (IntMap [ConvId]))
-> App ConvId -> App (IntMap [ConvId])
forall a b. (a -> b) -> a -> b
$ 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]
othersC)
      IntMap [ConvId]
kickMarkConvs <- App ConvId -> App (IntMap [ConvId])
forall a. App a -> App (IntMap [a])
forPhase (App ConvId -> App (IntMap [ConvId]))
-> App ConvId -> App (IntMap [ConvId])
forall a b. (a -> b) -> a -> b
$ 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)
      IntMap [ConvId]
delConvs <- App ConvId -> App (IntMap [ConvId])
forall a. App a -> App (IntMap [a])
forPhase (App ConvId -> App (IntMap [ConvId]))
-> App ConvId -> App (IntMap [ConvId])
forall a b. (a -> b) -> a -> b
$ 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)
      IntMap [ConvId]
addMelConvs <- App ConvId -> App (IntMap [ConvId])
forall a. App a -> App (IntMap [a])
forPhase (App ConvId -> App (IntMap [ConvId]))
-> App ConvId -> App (IntMap [ConvId])
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> String -> [ClientIdentity] -> App ConvId
ClientIdentity -> String -> [ClientIdentity] -> App ConvId
createTestConv ClientIdentity
creatorC String
tid [ClientIdentity]
othersC
      TestConvList -> App TestConvList
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestConvList -> App TestConvList)
-> TestConvList -> App TestConvList
forall a b. (a -> b) -> a -> b
$ TestConvList {[ConvId]
IntMap [ConvId]
unmodifiedConvs :: [ConvId]
kickMelConvs :: IntMap [ConvId]
kickMarkConvs :: IntMap [ConvId]
delConvs :: IntMap [ConvId]
addMelConvs :: IntMap [ConvId]
addMelConvs :: IntMap [ConvId]
delConvs :: IntMap [ConvId]
kickMarkConvs :: IntMap [ConvId]
kickMelConvs :: IntMap [ConvId]
unmodifiedConvs :: [ConvId]
..}

    createTestConv :: (HasCallStack) => ClientIdentity -> String -> [ClientIdentity] -> App ConvId
    createTestConv :: HasCallStack =>
ClientIdentity -> String -> [ClientIdentity] -> App ConvId
createTestConv ClientIdentity
creatorC String
tid [ClientIdentity]
membersC = do
      ConvId
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}
      (ClientIdentity -> App String) -> [ClientIdentity] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def) [ClientIdentity]
membersC
      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
creatorC ConvId
conv ((.qualifiedUserId) (ClientIdentity -> Value) -> [ClientIdentity] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClientIdentity]
membersC) 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
      ConvId -> App ConvId
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConvId
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
        [a]
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
        (Int, [a]) -> App (Int, [a])
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
phase, [a]
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
        MessagePackage
mp <- HasCallStack =>
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
convAdmin ConvId
convId [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 -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp) 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

      [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
        MessagePackage
mp <- HasCallStack =>
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage
createRemoveCommit ClientIdentity
convAdmin ConvId
convId [ClientIdentity
markC]
        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 -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp) 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

      [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 BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  (Value
alice, String
aliceTid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  (Value
bob, String
bobTid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OtherDomain Int
1

  Codensity App [BackendResource]
-> forall b. ([BackendResource] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
1 ResourcePool BackendResource
resourcePool) (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
migratingBackend] -> do
    let domainM :: String
domainM = BackendResource
migratingBackend.berDomain
    (Value
mel, ClientIdentity
_melC, Value
mark, ClientIdentity
_markC, Value
mia, ClientIdentity
_miaC, String
miaTid, TestConvList
domainAConvs, TestConvList
domainBConvs, TestConvList
domainMConvs, [Value]
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
      [Value
mel, Value
mark] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [String
domainM, String
domainM]
      (Value
mia, String
miaTid, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domainM Int
1
      [ClientIdentity
melC, ClientIdentity
markC, ClientIdentity
miaC] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def) [Value
mel, Value
mark, Value
mia]
      [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
bob, Value
mel, Value
mark, Value
mia]
      [Value]
otherMelConvs <- Value -> Int -> App [Value]
forall u. (HasCallStack, MakesValue u) => u -> Int -> App [Value]
getAllConvIds Value
mel Int
100

      -- Other convs which just exist
      Int -> Int -> App ConvId -> App ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m ()
pooledReplicateConcurrentlyN_ Int
parallellism Int
100 (App ConvId -> App ()) -> App ConvId -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Value -> String -> [Value] -> App ConvId
Value -> String -> [Value] -> App ConvId
createTestConv Value
mia String
miaTid []
      Int -> Int -> App ConvId -> App ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m ()
pooledReplicateConcurrentlyN_ Int
parallellism Int
100 (App ConvId -> App ()) -> App ConvId -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Value -> String -> [Value] -> App ConvId
Value -> String -> [Value] -> App ConvId
createTestConv Value
alice String
aliceTid [Value
mia]
      Int -> Int -> App ConvId -> App ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m ()
pooledReplicateConcurrentlyN_ Int
parallellism Int
100 (App ConvId -> App ()) -> App ConvId -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Value -> String -> [Value] -> App ConvId
Value -> String -> [Value] -> App ConvId
createTestConv Value
bob String
bobTid [Value
mia]

      TestConvList
domainAConvs <- HasCallStack =>
Value -> String -> Value -> Value -> [Value] -> App TestConvList
Value -> String -> Value -> Value -> [Value] -> App TestConvList
createTestConvs Value
alice String
aliceTid Value
mel Value
mark []
      TestConvList
domainBConvs <- HasCallStack =>
Value -> String -> Value -> Value -> [Value] -> App TestConvList
Value -> String -> Value -> Value -> [Value] -> App TestConvList
createTestConvs Value
bob String
bobTid Value
mel Value
mark []
      TestConvList
domainMConvs <- HasCallStack =>
Value -> String -> Value -> Value -> [Value] -> App TestConvList
Value -> String -> Value -> Value -> [Value] -> App TestConvList
createTestConvs Value
mia String
miaTid Value
mel Value
mark []
      (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. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
mel, ClientIdentity
melC, Value
mark, ClientIdentity
markC, Value
mia, ClientIdentity
miaC, String
miaTid, TestConvList
domainAConvs, TestConvList
domainBConvs, TestConvList
domainMConvs, [Value]
otherMelConvs)

    IORef [ConvId]
newConvsRef <- [ConvId] -> App (IORef [ConvId])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
    [(String, Value)] -> App () -> App ()
forall user a.
MakesValue user =>
[(String, user)] -> App a -> App a
addUsersToFailureContext [(String
"alice", Value
alice), (String
"bob", Value
bob), (String
"mel", Value
mel), (String
"mark", Value
mark), (String
"mia", Value
mia)]
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> TestConvList -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"convIds" (TestConvList
domainAConvs TestConvList -> TestConvList -> TestConvList
forall a. Semigroup a => a -> a -> a
<> TestConvList
domainBConvs TestConvList -> TestConvList -> TestConvList
forall a. Semigroup a => a -> a -> a
<> TestConvList
domainMConvs)
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> [Value] -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"otherMelConvs" [Value]
otherMelConvs
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
        let runPhase :: (HasCallStack) => Int -> App ()
            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
                [ConvId]
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
                [ConvId]
newDomainBConvs <- HasCallStack =>
Int
-> Value
-> String
-> TestConvList
-> Value
-> Value
-> App [ConvId]
Int
-> Value
-> String
-> TestConvList
-> Value
-> Value
-> App [ConvId]
runPhaseOperations Int
phase Value
bob String
bobTid TestConvList
domainBConvs Value
mel Value
mark
                [ConvId]
newDomainCConvs <- HasCallStack =>
Int
-> Value
-> String
-> TestConvList
-> Value
-> Value
-> App [ConvId]
Int
-> Value
-> String
-> TestConvList
-> Value
-> Value
-> App [ConvId]
runPhaseOperations Int
phase Value
mia String
miaTid TestConvList
domainMConvs Value
mel Value
mark
                let newConvs :: [ConvId]
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
                IORef [ConvId] -> ([ConvId] -> [ConvId]) -> App ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef [ConvId]
newConvsRef ([ConvId]
newConvs <>)
                [ConvId]
allNewConvs <- IORef [ConvId] -> App [ConvId]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [ConvId]
newConvsRef
                [Value]
actualConvs <- Value -> Int -> App [Value]
forall u. (HasCallStack, MakesValue u) => u -> Int -> App [Value]
getAllConvIds Value
mel Int
n
                let expectedConvsFrom :: TestConvList -> [ConvId]
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 :: [ConvId]
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

                [Value]
actualConvs [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ((ConvId -> Value
convIdToQidObject (ConvId -> Value) -> [ConvId] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ConvId]
expectedConvs) [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
otherMelConvs)

                Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
phase Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> App ()
String -> App ()
waitForMigration String
domainM
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
1
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
2
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
3
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
4
        HasCallStack => Int -> App ()
Int -> App ()
runPhase Int
5
  where
    n :: Int
n = Int
20
    parallellism :: Int
parallellism = 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
      [ConvId]
unmodifiedConvs <- Int -> Int -> App ConvId -> App [ConvId]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
parallellism 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)

      IntMap [ConvId]
kickMelConvs <- App ConvId -> App (IntMap [ConvId])
forall a. App a -> App (IntMap [a])
forPhase (App ConvId -> App (IntMap [ConvId]))
-> App ConvId -> App (IntMap [ConvId])
forall a b. (a -> b) -> a -> b
$ 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]
others)
      IntMap [ConvId]
kickMarkConvs <- App ConvId -> App (IntMap [ConvId])
forall a. App a -> App (IntMap [a])
forPhase (App ConvId -> App (IntMap [ConvId]))
-> App ConvId -> App (IntMap [ConvId])
forall a b. (a -> b) -> a -> b
$ 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)
      IntMap [ConvId]
delConvs <- App ConvId -> App (IntMap [ConvId])
forall a. App a -> App (IntMap [a])
forPhase (App ConvId -> App (IntMap [ConvId]))
-> App ConvId -> App (IntMap [ConvId])
forall a b. (a -> b) -> a -> b
$ 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)
      IntMap [ConvId]
addMelConvs <- App ConvId -> App (IntMap [ConvId])
forall a. App a -> App (IntMap [a])
forPhase (App ConvId -> App (IntMap [ConvId]))
-> App ConvId -> App (IntMap [ConvId])
forall a b. (a -> b) -> a -> b
$ HasCallStack => Value -> String -> [Value] -> App ConvId
Value -> String -> [Value] -> App ConvId
createTestConv Value
creatorC String
tid [Value]
others
      TestConvList -> App TestConvList
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestConvList -> App TestConvList)
-> TestConvList -> App TestConvList
forall a b. (a -> b) -> a -> b
$ TestConvList {[ConvId]
IntMap [ConvId]
addMelConvs :: IntMap [ConvId]
delConvs :: IntMap [ConvId]
kickMarkConvs :: IntMap [ConvId]
kickMelConvs :: IntMap [ConvId]
unmodifiedConvs :: [ConvId]
unmodifiedConvs :: [ConvId]
kickMelConvs :: IntMap [ConvId]
kickMarkConvs :: IntMap [ConvId]
delConvs :: IntMap [ConvId]
addMelConvs :: IntMap [ConvId]
..}

    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
parallellism [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
        [a]
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
        (Int, [a]) -> App (Int, [a])
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
phase, [a]
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
          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
parallellism ([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
parallellism ([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
parallellism ([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
parallellism ([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
        Int -> Int -> App ConvId -> App [ConvId]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
parallellism 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]

-- 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
  Text
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 (Text
_, Text
_, Text
_, [Text]
convFinishedMatches) :: (Text, Text, Text, [Text]) = (Text
metrics Text -> Text -> (Text, Text, Text, [Text])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String -> Text
Text.pack String
"^wire_local_convs_migration_finished\\ ([0-9]+\\.[0-9]+)$")
  let (Text
_, Text
_, Text
_, [Text]
userFinishedMatches) :: (Text, Text, Text, [Text]) = (Text
metrics Text -> Text -> (Text, Text, Text, [Text])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String -> Text
Text.pack String
"^wire_user_remote_convs_migration_finished\\ ([0-9]+\\.[0-9]+)$")
  Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text]
convFinishedMatches [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [String -> Text
Text.pack String
"1.0"] Bool -> Bool -> Bool
|| [Text]
userFinishedMatches [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [String -> Text
Text.pack String
"1.0"]) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
100_000
    HasCallStack => String -> App ()
String -> App ()
waitForMigration String
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)
    ]