{-# LANGUAGE ApplicativeDo #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- | 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.Migration.User where

import API.Brig
import qualified API.BrigInternal as I
import API.Common
import API.Galley
import qualified API.GalleyInternal as I
import API.Spar
import Control.Applicative
import Control.Monad.Codensity
import Control.Monad.Reader
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.KeyMap as KeyMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import Data.String.Conversions
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Tuple.Extra
import Data.UUID (UUID)
import qualified Data.UUID as UUID
import qualified Data.Vector as Vector
import Database.CQL.IO
import GHC.Stack
import Notifications
import SetupHelpers hiding (deleteUser)
import Test.Bot (mkBotService)
import Test.Migration.Util
import Test.QuickCheck
import Test.Search
import Testlib.MockIntegrationService (MockServerSettings (..), withMockServer)
import Testlib.Prelude
import Testlib.ResourcePool
import UnliftIO

testUserMigrationToPostgres :: App ()
testUserMigrationToPostgres :: App ()
testUserMigrationToPostgres = MockServerSettings
-> (Chan BotEvent -> LiftedApplication)
-> ((String, Int) -> Chan BotEvent -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
botServiceSettings Chan BotEvent -> LiftedApplication
mkBotService (((String, Int) -> Chan BotEvent -> App ()) -> App ())
-> ((String, Int) -> Chan BotEvent -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
botHost, Int
botPort) Chan BotEvent
_botChan -> do
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)

  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, String
pid, String
sid, TestUsersByOperations
seedUsers) <- 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, String, String, TestUsersByOperations))
 -> App (Value, String, String, TestUsersByOperations))
-> (String -> App (Value, String, String, TestUsersByOperations))
-> App (Value, String, String, TestUsersByOperations)
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      -- mel exists to connect with all the personal users, so we can wait for a
      -- notification for their deletion
      Value
mel <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainM CreateUser
forall a. Default a => a
def

      String
pid <- String -> NewProvider -> App Value
forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider String
domainM NewProvider
forall a. Default a => a
def {newProviderPassword = Just defPassword} App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      Value
service <-
        String -> String -> NewService -> App Value
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> NewService -> App Value
newService String
domainM String
pid
          (NewService -> App Value) -> NewService -> App Value
forall a b. (a -> b) -> a -> b
$ NewService
forall a. Default a => a
def
            { newServiceUrl = "https://" <> botHost <> ":" <> show botPort,
              newServiceKey = cs botServiceSettings.publicKey
            }
      String
sid <- Value
service Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      String -> String -> String -> Value -> App Response
forall domain conn.
(HasCallStack, MakesValue domain, MakesValue conn) =>
domain -> String -> String -> conn -> App Response
updateServiceConn String
domainM String
pid String
sid ([Pair] -> Value
object [String
"password" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
defPassword, String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True]) 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

      TestUsersByOperations
seedUsers <- String -> Value -> String -> String -> App TestUsersByOperations
forall mel.
(HasCallStack, MakesValue mel) =>
String -> mel -> String -> String -> App TestUsersByOperations
seedTestUsers String
domainM Value
mel String
pid String
sid
      pure (Value
mel, String
pid, String
sid, TestUsersByOperations
seedUsers)

    IORef (IntMap TestUserList)
newUsersRef <- IntMap TestUserList -> App (IORef (IntMap TestUserList))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef IntMap TestUserList
forall a. Monoid a => a
mempty
    IORef (IntMap TestUserList)
updatedUsersRef <- IntMap TestUserList -> App (IORef (IntMap TestUserList))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef IntMap TestUserList
forall a. Monoid a => a
mempty
    IntMap PhaseUpdates
updates <- ([(Int, PhaseUpdates)] -> IntMap PhaseUpdates)
-> App [(Int, PhaseUpdates)] -> App (IntMap PhaseUpdates)
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Int, PhaseUpdates)] -> IntMap PhaseUpdates
forall a. [(Int, a)] -> IntMap a
IntMap.fromList (App [(Int, PhaseUpdates)] -> App (IntMap PhaseUpdates))
-> ((Int -> App (Int, PhaseUpdates)) -> App [(Int, PhaseUpdates)])
-> (Int -> App (Int, PhaseUpdates))
-> App (IntMap PhaseUpdates)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int]
-> (Int -> App (Int, PhaseUpdates)) -> App [(Int, PhaseUpdates)]
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, PhaseUpdates)) -> App (IntMap PhaseUpdates))
-> (Int -> App (Int, PhaseUpdates)) -> App (IntMap PhaseUpdates)
forall a b. (a -> b) -> a -> b
$ \Int
phase -> do
      (Int
phase,) (PhaseUpdates -> (Int, PhaseUpdates))
-> App PhaseUpdates -> App (Int, PhaseUpdates)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO PhaseUpdates -> App PhaseUpdates
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Gen PhaseUpdates -> IO PhaseUpdates
forall a. Gen a -> IO a
generate (Int -> Gen PhaseUpdates
arbitraryPhaseUpdates Int
nUpdates))

    [(String, Value)] -> App () -> App ()
forall user a.
MakesValue user =>
[(String, user)] -> App a -> App a
addUsersToFailureContext [(String
"mel", Value
mel)]
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> IntMap PhaseUpdates -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"updates" IntMap PhaseUpdates
updates
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> TestUsersByOperations -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"seed users" TestUsersByOperations
seedUsers 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
                let toBeUpdated :: TestUserList
toBeUpdated = TestUsersByOperations
seedUsers.updates IntMap TestUserList -> Int -> TestUserList
forall a. IntMap a -> Int -> a
IntMap.! Int
phase
                    phaseUpdates :: PhaseUpdates
phaseUpdates = IntMap PhaseUpdates
updates IntMap PhaseUpdates -> Int -> PhaseUpdates
forall a. IntMap a -> Int -> a
IntMap.! Int
phase

                TestScimUsers
updatedScimUsersWithRichInfo <- HasCallStack =>
String -> TestScimUsers -> [UserUpdate] -> App TestScimUsers
String -> TestScimUsers -> [UserUpdate] -> App TestScimUsers
updateScimUsers String
domainM TestUserList
toBeUpdated.scimUsersWithRichInfo PhaseUpdates
phaseUpdates.scimUsersWithRichInfo
                TestScimUsers
updatedScimUsersWithoutRichInfo <- HasCallStack =>
String -> TestScimUsers -> [UserUpdate] -> App TestScimUsers
String -> TestScimUsers -> [UserUpdate] -> App TestScimUsers
updateScimUsers String
domainM TestUserList
toBeUpdated.scimUsersWithoutRichInfo PhaseUpdates
phaseUpdates.scimUsersWithoutRichInfo
                TestScimUsers
updatedPendingScimUsers <- HasCallStack =>
String -> TestScimUsers -> [PendingScimUpdate] -> App TestScimUsers
String -> TestScimUsers -> [PendingScimUpdate] -> App TestScimUsers
updatePendingScimUsers String
domainM TestUserList
toBeUpdated.pendingScimUsers PhaseUpdates
phaseUpdates.pendingScimUsers
                Map String (Value, Maybe String)
updatedSsoUsers <- HasCallStack =>
Map String (Value, Maybe String)
-> [UserUpdate] -> App (Map String (Value, Maybe String))
Map String (Value, Maybe String)
-> [UserUpdate] -> App (Map String (Value, Maybe String))
checkUpdateUser TestUserList
toBeUpdated.ssoUsers.users PhaseUpdates
phaseUpdates.ssoUsers
                Map String (Value, Maybe String)
updatedPasswordTeamUsers <- HasCallStack =>
Map String (Value, Maybe String)
-> [UserUpdate] -> App (Map String (Value, Maybe String))
Map String (Value, Maybe String)
-> [UserUpdate] -> App (Map String (Value, Maybe String))
checkUpdateUser TestUserList
toBeUpdated.passwordTeamUsers.users PhaseUpdates
phaseUpdates.passwordTeamUsers
                Map String (Value, Maybe String)
updatedPersonalUsersWithoutHandle <- HasCallStack =>
Map String (Value, Maybe String)
-> [UserUpdate] -> App (Map String (Value, Maybe String))
Map String (Value, Maybe String)
-> [UserUpdate] -> App (Map String (Value, Maybe String))
checkUpdateUser TestUserList
toBeUpdated.personalUsersWithoutHandle PhaseUpdates
phaseUpdates.personalUsersWithoutHandle
                Map String (Value, Maybe String)
updatedPersonalUsersWithHandle <- HasCallStack =>
Map String (Value, Maybe String)
-> [UserUpdate] -> App (Map String (Value, Maybe String))
Map String (Value, Maybe String)
-> [UserUpdate] -> App (Map String (Value, Maybe String))
checkUpdateUser TestUserList
toBeUpdated.personalUsersWithHandle PhaseUpdates
phaseUpdates.personalUsersWithHandle
                let updatedUsers :: TestUserList
updatedUsers =
                      TestUserList
                        { scimUsersWithRichInfo :: TestScimUsers
scimUsersWithRichInfo = TestScimUsers
updatedScimUsersWithRichInfo,
                          scimUsersWithoutRichInfo :: TestScimUsers
scimUsersWithoutRichInfo = TestScimUsers
updatedScimUsersWithoutRichInfo,
                          pendingScimUsers :: TestScimUsers
pendingScimUsers = TestScimUsers
updatedPendingScimUsers,
                          ssoUsers :: TestTeamUsers
ssoUsers = TestUserList
toBeUpdated.ssoUsers {users = updatedSsoUsers} :: TestTeamUsers,
                          passwordTeamUsers :: TestTeamUsers
passwordTeamUsers = TestUserList
toBeUpdated.passwordTeamUsers {users = updatedPasswordTeamUsers} :: TestTeamUsers,
                          personalUsersWithoutHandle :: Map String (Value, Maybe String)
personalUsersWithoutHandle = Map String (Value, Maybe String)
updatedPersonalUsersWithoutHandle,
                          personalUsersWithHandle :: Map String (Value, Maybe String)
personalUsersWithHandle = Map String (Value, Maybe String)
updatedPersonalUsersWithHandle,
                          -- Bots don't have any updates
                          botsInTeamConvs :: TestTeamUsers
botsInTeamConvs = TestUserList
toBeUpdated.botsInTeamConvs,
                          botsInPersonalConvs :: Map String (Value, Value)
botsInPersonalConvs = TestUserList
toBeUpdated.botsInPersonalConvs
                        }

                TestUserList
newUsers <- String -> Value -> String -> String -> Int -> App TestUserList
forall mel.
(HasCallStack, MakesValue mel) =>
String -> mel -> String -> String -> Int -> App TestUserList
createTestUsers String
domainM Value
mel String
pid String
sid Int
nNew
                IORef (IntMap TestUserList)
-> (IntMap TestUserList -> IntMap TestUserList) -> App ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef (IntMap TestUserList)
newUsersRef (Int -> TestUserList -> IntMap TestUserList -> IntMap TestUserList
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
phase TestUserList
newUsers)
                IORef (IntMap TestUserList)
-> (IntMap TestUserList -> IntMap TestUserList) -> App ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef (IntMap TestUserList)
updatedUsersRef (Int -> TestUserList -> IntMap TestUserList -> IntMap TestUserList
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
phase TestUserList
updatedUsers)

                let toBeDeleted :: TestUserList
toBeDeleted = TestUsersByOperations
seedUsers.deletes IntMap TestUserList -> Int -> TestUserList
forall a. IntMap a -> Int -> a
IntMap.! Int
phase

                HasCallStack => String -> Bool -> TestScimUsers -> App ()
String -> Bool -> TestScimUsers -> App ()
deleteScimUsers String
domainM Bool
False TestUserList
toBeDeleted.scimUsersWithRichInfo
                HasCallStack => String -> Bool -> TestScimUsers -> App ()
String -> Bool -> TestScimUsers -> App ()
deleteScimUsers String
domainM Bool
False TestUserList
toBeDeleted.scimUsersWithoutRichInfo
                HasCallStack => String -> Bool -> TestScimUsers -> App ()
String -> Bool -> TestScimUsers -> App ()
deleteScimUsers String
domainM Bool
True TestUserList
toBeDeleted.pendingScimUsers
                HasCallStack => TestTeamUsers -> App ()
TestTeamUsers -> App ()
deleteTeamUsers TestUserList
toBeDeleted.ssoUsers
                HasCallStack => TestTeamUsers -> App ()
TestTeamUsers -> App ()
deleteTeamUsers TestUserList
toBeDeleted.passwordTeamUsers
                Value -> Map String (Value, Maybe String) -> App ()
forall mel.
(HasCallStack, MakesValue mel, ToWSConnect mel) =>
mel -> Map String (Value, Maybe String) -> App ()
deletePersonalUsers Value
mel TestUserList
toBeDeleted.personalUsersWithoutHandle
                Value -> Map String (Value, Maybe String) -> App ()
forall mel.
(HasCallStack, MakesValue mel, ToWSConnect mel) =>
mel -> Map String (Value, Maybe String) -> App ()
deletePersonalUsers Value
mel TestUserList
toBeDeleted.personalUsersWithHandle
                HasCallStack => TestTeamUsers -> String -> String -> App ()
TestTeamUsers -> String -> String -> App ()
deleteBotsTeam TestUserList
toBeDeleted.botsInTeamConvs String
pid String
sid
                HasCallStack => Value -> Map String (Value, Value) -> App ()
Value -> Map String (Value, Value) -> App ()
deleteBotConvs Value
mel TestUserList
toBeDeleted.botsInPersonalConvs

                HasCallStack =>
String -> Value -> IntMap TestUserList -> Int -> App ()
String -> Value -> IntMap TestUserList -> Int -> App ()
checkAllDeletionsWorked String
domainM Value
mel TestUsersByOperations
seedUsers.deletes Int
phase
                HasCallStack =>
String
-> IntMap TestUserList -> IntMap TestUserList -> Int -> App ()
String
-> IntMap TestUserList -> IntMap TestUserList -> Int -> App ()
checkUnaffectedUsers String
domainM TestUsersByOperations
seedUsers.deletes TestUsersByOperations
seedUsers.updates Int
phase
                IntMap TestUserList
updatedSoFar <- IORef (IntMap TestUserList) -> App (IntMap TestUserList)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (IntMap TestUserList)
updatedUsersRef
                IntMap TestUserList
newSoFar <- IORef (IntMap TestUserList) -> App (IntMap TestUserList)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (IntMap TestUserList)
newUsersRef
                String -> IntMap TestUserList -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"newSoFar" IntMap TestUserList
newSoFar
                  (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
String -> IntMap TestUserList -> IntMap TestUserList -> App ()
String -> IntMap TestUserList -> IntMap TestUserList -> App ()
checkNewAndUpdatedUsers String
domainM IntMap TestUserList
updatedSoFar IntMap TestUserList
newSoFar

                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
$ do
                  HasCallStack => String -> String -> App ()
String -> String -> App ()
waitForMigration String
domainM String
userMigrationFinishedCounterName
        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
    parallelism :: Int
parallelism = Int
64

    -- Number of users of each type
    nUpdates :: Int
nUpdates = Int
5
    nDeletes :: Int
nDeletes = Int
1
    nNew :: Int
nNew = Int
1

    botServiceSettings :: MockServerSettings
botServiceSettings = MockServerSettings
forall a. Default a => a
def

    seedTestUsers :: (HasCallStack, MakesValue mel) => String -> mel -> String -> String -> App TestUsersByOperations
    seedTestUsers :: forall mel.
(HasCallStack, MakesValue mel) =>
String -> mel -> String -> String -> App TestUsersByOperations
seedTestUsers String
domain mel
mel String
pid String
sid =
      ([TestUsersByOperations] -> TestUsersByOperations)
-> App [TestUsersByOperations] -> App TestUsersByOperations
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TestUsersByOperations] -> TestUsersByOperations
forall a. Monoid a => [a] -> a
mconcat (App [TestUsersByOperations] -> App TestUsersByOperations)
-> ((Int -> App TestUsersByOperations)
    -> App [TestUsersByOperations])
-> (Int -> App TestUsersByOperations)
-> App TestUsersByOperations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int]
-> (Int -> App TestUsersByOperations)
-> App [TestUsersByOperations]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Int
1 :: Int) .. Int
5] ((Int -> App TestUsersByOperations) -> App TestUsersByOperations)
-> (Int -> App TestUsersByOperations) -> App TestUsersByOperations
forall a b. (a -> b) -> a -> b
$ \Int
phase -> do
        IntMap TestUserList
updates <- Int -> TestUserList -> IntMap TestUserList
forall a. Int -> a -> IntMap a
IntMap.singleton Int
phase (TestUserList -> IntMap TestUserList)
-> App TestUserList -> App (IntMap TestUserList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> mel -> String -> String -> Int -> App TestUserList
forall mel.
(HasCallStack, MakesValue mel) =>
String -> mel -> String -> String -> Int -> App TestUserList
createTestUsers String
domain mel
mel String
pid String
sid Int
nUpdates
        IntMap TestUserList
deletes <- Int -> TestUserList -> IntMap TestUserList
forall a. Int -> a -> IntMap a
IntMap.singleton Int
phase (TestUserList -> IntMap TestUserList)
-> App TestUserList -> App (IntMap TestUserList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> mel -> String -> String -> Int -> App TestUserList
forall mel.
(HasCallStack, MakesValue mel) =>
String -> mel -> String -> String -> Int -> App TestUserList
createTestUsers String
domain mel
mel String
pid String
sid Int
nDeletes
        pure TestUsersByOperations {IntMap TestUserList
updates :: IntMap TestUserList
deletes :: IntMap TestUserList
deletes :: IntMap TestUserList
updates :: IntMap TestUserList
..}

    tombstone :: String -> String -> Maybe String -> Value
    tombstone :: String -> String -> Maybe String -> Value
tombstone String
domain String
uid Maybe String
mTid =
      [Pair] -> Value
object
        ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ String
"accent_id" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
0 :: Int),
            String
"assets" String -> () -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (),
            String
"deleted" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
            String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid,
            String
"legalhold_status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"no_consent",
            String
"name" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"default",
            String
"picture" String -> () -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (),
            String
"qualified_id" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object [String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain, String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid],
            String
"searchable" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
            String
"supported_protocols" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"proteus"],
            String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"regular"
          ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> ([Pair] -> (String -> [Pair]) -> Maybe String -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
tid -> [String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tid]) Maybe String
mTid)

    scimUserIdsWithGetter :: (HasCallStack) => IntMap TestUserList -> [(String, String)]
    scimUserIdsWithGetter :: HasCallStack => IntMap TestUserList -> [(String, String)]
scimUserIdsWithGetter IntMap TestUserList
relevantSeedUsers =
      (IntMap (String, String) -> [(String, String)])
-> [IntMap (String, String)] -> [(String, String)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IntMap (String, String) -> [(String, String)]
forall a. IntMap a -> [a]
IntMap.elems ([IntMap (String, String)] -> [(String, String)])
-> ((TestUserList -> [(String, String)])
    -> [IntMap (String, String)])
-> (TestUserList -> [(String, String)])
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap TestUserList
-> (TestUserList -> [(String, String)])
-> [IntMap (String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for IntMap TestUserList
relevantSeedUsers ((TestUserList -> [(String, String)]) -> [(String, String)])
-> (TestUserList -> [(String, String)]) -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ \TestUserList
usersInPhase -> do
        (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (TestUserList
usersInPhase.scimUsersWithRichInfo.token,) (Map String (Value, String, Value) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
usersInPhase.scimUsersWithRichInfo.users)
          [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (TestUserList
usersInPhase.scimUsersWithoutRichInfo.token,) (Map String (Value, String, Value) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
usersInPhase.scimUsersWithoutRichInfo.users)
          [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (TestUserList
usersInPhase.pendingScimUsers.token,) (Map String (Value, String, Value) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
usersInPhase.pendingScimUsers.users)

    nonScimUserIds :: (HasCallStack) => Value -> IntMap TestUserList -> [(Value, Value)]
    nonScimUserIds :: HasCallStack => Value -> IntMap TestUserList -> [(Value, Value)]
nonScimUserIds Value
mel IntMap TestUserList
relevantSeedUsers = (IntMap (Value, Value) -> [(Value, Value)])
-> [IntMap (Value, Value)] -> [(Value, Value)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IntMap (Value, Value) -> [(Value, Value)]
forall a. IntMap a -> [a]
IntMap.elems ([IntMap (Value, Value)] -> [(Value, Value)])
-> ((TestUserList -> [(Value, Value)]) -> [IntMap (Value, Value)])
-> (TestUserList -> [(Value, Value)])
-> [(Value, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap TestUserList
-> (TestUserList -> [(Value, Value)]) -> [IntMap (Value, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for IntMap TestUserList
relevantSeedUsers ((TestUserList -> [(Value, Value)]) -> [(Value, Value)])
-> (TestUserList -> [(Value, Value)]) -> [(Value, Value)]
forall a b. (a -> b) -> a -> b
$ \TestUserList
usersInPhase -> do
      (Value -> (Value, Value)) -> [Value] -> [(Value, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (TestUserList
usersInPhase.scimUsersWithRichInfo.owner,) ((Value, String, Value) -> Value
forall a b c. (a, b, c) -> c
thd3 ((Value, String, Value) -> Value)
-> [(Value, String, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Value, String, Value) -> [(Value, String, Value)]
forall k a. Map k a -> [a]
Map.elems TestUserList
usersInPhase.scimUsersWithRichInfo.users)
        [(Value, Value)] -> [(Value, Value)] -> [(Value, Value)]
forall a. Semigroup a => a -> a -> a
<> (Value -> (Value, Value)) -> [Value] -> [(Value, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (TestUserList
usersInPhase.scimUsersWithoutRichInfo.owner,) ((Value, String, Value) -> Value
forall a b c. (a, b, c) -> c
thd3 ((Value, String, Value) -> Value)
-> [(Value, String, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Value, String, Value) -> [(Value, String, Value)]
forall k a. Map k a -> [a]
Map.elems TestUserList
usersInPhase.scimUsersWithoutRichInfo.users)
        [(Value, Value)] -> [(Value, Value)] -> [(Value, Value)]
forall a. Semigroup a => a -> a -> a
<> (Value -> (Value, Value)) -> [Value] -> [(Value, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (TestUserList
usersInPhase.passwordTeamUsers.owner,) ((Value, Maybe String) -> Value
forall a b. (a, b) -> a
fst ((Value, Maybe String) -> Value)
-> [(Value, Maybe String)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems TestUserList
usersInPhase.passwordTeamUsers.users)
        [(Value, Value)] -> [(Value, Value)] -> [(Value, Value)]
forall a. Semigroup a => a -> a -> a
<> (Value -> (Value, Value)) -> [Value] -> [(Value, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (Value
mel,) ((Value, Maybe String) -> Value
forall a b. (a, b) -> a
fst ((Value, Maybe String) -> Value)
-> [(Value, Maybe String)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems TestUserList
usersInPhase.personalUsersWithHandle)
        [(Value, Value)] -> [(Value, Value)] -> [(Value, Value)]
forall a. Semigroup a => a -> a -> a
<> (Value -> (Value, Value)) -> [Value] -> [(Value, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (Value
mel,) ((Value, Maybe String) -> Value
forall a b. (a, b) -> a
fst ((Value, Maybe String) -> Value)
-> [(Value, Maybe String)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems TestUserList
usersInPhase.personalUsersWithoutHandle)

    checkAllDeletionsWorked :: (HasCallStack) => String -> Value -> IntMap TestUserList -> Int -> App ()
    checkAllDeletionsWorked :: HasCallStack =>
String -> Value -> IntMap TestUserList -> Int -> App ()
checkAllDeletionsWorked String
domain Value
mel IntMap TestUserList
seedUsers Int
phase = do
      let deletedSoFar :: IntMap TestUserList
deletedSoFar = IntMap TestUserList -> IntSet -> IntMap TestUserList
forall a. IntMap a -> IntSet -> IntMap a
IntMap.restrictKeys IntMap TestUserList
seedUsers ([Int] -> IntSet
IntSet.fromList ([Int] -> IntSet) -> [Int] -> IntSet
forall a b. (a -> b) -> a -> b
$ [Int
1 .. Int
phase])
      Int -> [(String, String)] -> ((String, String) -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism (HasCallStack => IntMap TestUserList -> [(String, String)]
IntMap TestUserList -> [(String, String)]
scimUserIdsWithGetter IntMap TestUserList
deletedSoFar) (((String, String) -> App ()) -> App ())
-> ((String, String) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
token, String
uid) ->
        String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser String
domain String
token String
uid 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
404

      Int -> [(Value, Value)] -> ((Value, Value) -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism (HasCallStack => Value -> IntMap TestUserList -> [(Value, Value)]
Value -> IntMap TestUserList -> [(Value, Value)]
nonScimUserIds Value
mel IntMap TestUserList
deletedSoFar) (((Value, Value) -> App ()) -> App ())
-> ((Value, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(Value
getter, Value
user) -> do
        String
uid <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        Maybe String
mTid <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
user String
"team" App (Maybe Value)
-> (App (Maybe Value) -> App (Maybe String)) -> App (Maybe String)
forall a b. a -> (a -> b) -> b
& App (Maybe Value) -> App (Maybe String)
forall a. (HasCallStack, MakesValue a) => a -> App (Maybe String)
asStringM
        Value -> Value -> App Response
forall user target.
(HasCallStack, MakesValue user, MakesValue target) =>
user -> target -> App Response
getUser Value
getter ([Pair] -> Value
object [String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain, String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid]) App Response -> (Response -> App ()) -> App ()
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
          Response
resp.json Maybe Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String -> String -> Maybe String -> Value
tombstone String
domain String
uid Maybe String
mTid

      let bots :: [Value]
bots =
            (TestUserList -> [Value]) -> [TestUserList] -> [Value]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
              ( \TestUserList
testUsers ->
                  ((Value, Maybe String) -> Value)
-> [(Value, Maybe String)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, Maybe String) -> Value
forall a b. (a, b) -> a
fst (Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUsers.botsInTeamConvs.users)
                    [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> ((Value, Value) -> Value) -> [(Value, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, Value) -> Value
forall a b. (a, b) -> a
fst (Map String (Value, Value) -> [(Value, Value)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUsers.botsInPersonalConvs)
              )
              (IntMap TestUserList -> [TestUserList]
forall a. IntMap a -> [a]
IntMap.elems IntMap TestUserList
deletedSoFar)
      Int -> [Value] -> (Value -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism [Value]
bots ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
botUser -> do
        Value
botTombstone <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"status" String
"deleted" (Value -> App Value) -> App Value -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Bool -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"deleted" Bool
True Value
botUser
        Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
botUser App Response -> (Response -> App ()) -> App ()
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
          Response
resp.json Maybe Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
botTombstone

    checkUnaffectedUsers :: (HasCallStack) => String -> IntMap TestUserList -> IntMap TestUserList -> Int -> App ()
    checkUnaffectedUsers :: HasCallStack =>
String
-> IntMap TestUserList -> IntMap TestUserList -> Int -> App ()
checkUnaffectedUsers String
domain IntMap TestUserList
seedUsersToBeUpdated IntMap TestUserList
seedUsersToBeDeleted Int
phase = do
      let upcomingPhases :: IntSet
upcomingPhases = [Int] -> IntSet
IntSet.fromList [(Int
phase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) .. Int
5]
          usersNotYetDeleted :: IntMap TestUserList
usersNotYetDeleted = IntMap TestUserList -> IntSet -> IntMap TestUserList
forall a. IntMap a -> IntSet -> IntMap a
IntMap.restrictKeys IntMap TestUserList
seedUsersToBeDeleted IntSet
upcomingPhases
          usersNotYetUpdated :: IntMap TestUserList
usersNotYetUpdated = IntMap TestUserList -> IntSet -> IntMap TestUserList
forall a. IntMap a -> IntSet -> IntMap a
IntMap.restrictKeys IntMap TestUserList
seedUsersToBeUpdated IntSet
upcomingPhases
          existingUserLists :: [TestUserList]
existingUserLists = IntMap TestUserList -> [TestUserList]
forall a. IntMap a -> [a]
IntMap.elems IntMap TestUserList
usersNotYetDeleted [TestUserList] -> [TestUserList] -> [TestUserList]
forall a. Semigroup a => a -> a -> a
<> IntMap TestUserList -> [TestUserList]
forall a. IntMap a -> [a]
IntMap.elems IntMap TestUserList
usersNotYetUpdated
          existingScimUsers :: [(String, Value)]
existingScimUsers = (TestUserList -> [(String, Value)])
-> [TestUserList] -> [(String, Value)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TestUserList -> [(String, Value)]
extractScimUsers [TestUserList]
existingUserLists
          existingUsers :: [Value]
existingUsers = (TestUserList -> [Value]) -> [TestUserList] -> [Value]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TestUserList -> [Value]
extractTestUsers [TestUserList]
existingUserLists

      HasCallStack => String -> [(String, Value)] -> App ()
String -> [(String, Value)] -> App ()
checkScimUsers String
domain [(String, Value)]
existingScimUsers
      HasCallStack => [Value] -> App ()
[Value] -> App ()
checkUsers [Value]
existingUsers

    checkNewAndUpdatedUsers :: (HasCallStack) => String -> IntMap TestUserList -> IntMap TestUserList -> App ()
    checkNewAndUpdatedUsers :: HasCallStack =>
String -> IntMap TestUserList -> IntMap TestUserList -> App ()
checkNewAndUpdatedUsers String
domain IntMap TestUserList
newUsers IntMap TestUserList
updatedUsers = do
      let scimUsers :: [(String, Value)]
scimUsers =
            (TestUserList -> [(String, Value)])
-> IntMap TestUserList -> [(String, Value)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TestUserList -> [(String, Value)]
extractScimUsers IntMap TestUserList
newUsers
              [(String, Value)] -> [(String, Value)] -> [(String, Value)]
forall a. Semigroup a => a -> a -> a
<> (TestUserList -> [(String, Value)])
-> IntMap TestUserList -> [(String, Value)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TestUserList -> [(String, Value)]
extractScimUsers IntMap TestUserList
updatedUsers
          users :: [Value]
users =
            (TestUserList -> [Value]) -> IntMap TestUserList -> [Value]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TestUserList -> [Value]
extractTestUsers IntMap TestUserList
newUsers
              [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> (TestUserList -> [Value]) -> IntMap TestUserList -> [Value]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TestUserList -> [Value]
extractTestUsers IntMap TestUserList
updatedUsers
      HasCallStack => String -> [(String, Value)] -> App ()
String -> [(String, Value)] -> App ()
checkScimUsers String
domain [(String, Value)]
scimUsers
      HasCallStack => [Value] -> App ()
[Value] -> App ()
checkUsers [Value]
users

    checkScimUsers :: (HasCallStack) => String -> [(String, Value)] -> App ()
    checkScimUsers :: HasCallStack => String -> [(String, Value)] -> App ()
checkScimUsers String
domain [(String, Value)]
tokensAndUsers = do
      Int -> [(String, Value)] -> ((String, Value) -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism [(String, Value)]
tokensAndUsers (((String, Value) -> App ()) -> App ())
-> ((String, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
token, Value
scimUser) ->
        String -> Value -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"scimUser" Value
scimUser (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
          String
uid <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
          String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser String
domain String
token String
uid App Response -> (Response -> App ()) -> App ()
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
            Response
resp.json Maybe Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
scimUser

    checkUsers :: (HasCallStack) => [Value] -> App ()
    checkUsers :: HasCallStack => [Value] -> App ()
checkUsers [Value]
users =
      Int -> [Value] -> (Value -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism [Value]
users ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
user ->
        String -> Value -> App () -> App ()
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"user" Value
user (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
          Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
user App Response -> (Response -> App ()) -> App ()
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
            Response
resp.json Maybe Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
user

    extractScimUsers :: TestUserList -> [(String, Value)]
    extractScimUsers :: TestUserList -> [(String, Value)]
extractScimUsers TestUserList
testUserList =
      (Value -> (String, Value)) -> [Value] -> [(String, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (TestUserList
testUserList.scimUsersWithRichInfo.token,) ((Value, String, Value) -> Value
forall a b c. (a, b, c) -> a
fst3 ((Value, String, Value) -> Value)
-> [(Value, String, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Value, String, Value) -> [(Value, String, Value)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.scimUsersWithRichInfo.users)
        [(String, Value)] -> [(String, Value)] -> [(String, Value)]
forall a. Semigroup a => a -> a -> a
<> (Value -> (String, Value)) -> [Value] -> [(String, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (TestUserList
testUserList.scimUsersWithoutRichInfo.token,) ((Value, String, Value) -> Value
forall a b c. (a, b, c) -> a
fst3 ((Value, String, Value) -> Value)
-> [(Value, String, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Value, String, Value) -> [(Value, String, Value)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.scimUsersWithoutRichInfo.users)
        [(String, Value)] -> [(String, Value)] -> [(String, Value)]
forall a. Semigroup a => a -> a -> a
<> (Value -> (String, Value)) -> [Value] -> [(String, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (TestUserList
testUserList.pendingScimUsers.token,) ((Value, String, Value) -> Value
forall a b c. (a, b, c) -> a
fst3 ((Value, String, Value) -> Value)
-> [(Value, String, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Value, String, Value) -> [(Value, String, Value)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.pendingScimUsers.users)

    extractTestUsers :: TestUserList -> [Value]
    extractTestUsers :: TestUserList -> [Value]
extractTestUsers TestUserList
testUserList =
      ((Value, String, Value) -> Value)
-> [(Value, String, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, String, Value) -> Value
forall a b c. (a, b, c) -> c
thd3 (Map String (Value, String, Value) -> [(Value, String, Value)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.scimUsersWithRichInfo.users)
        [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> ((Value, String, Value) -> Value)
-> [(Value, String, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, String, Value) -> Value
forall a b c. (a, b, c) -> c
thd3 (Map String (Value, String, Value) -> [(Value, String, Value)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.scimUsersWithoutRichInfo.users)
        [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> ((Value, Maybe String) -> Value)
-> [(Value, Maybe String)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, Maybe String) -> Value
forall a b. (a, b) -> a
fst (Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.ssoUsers.users)
        [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> ((Value, Maybe String) -> Value)
-> [(Value, Maybe String)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, Maybe String) -> Value
forall a b. (a, b) -> a
fst (Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.passwordTeamUsers.users)
        [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> ((Value, Maybe String) -> Value)
-> [(Value, Maybe String)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, Maybe String) -> Value
forall a b. (a, b) -> a
fst (Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.personalUsersWithHandle)
        [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> ((Value, Maybe String) -> Value)
-> [(Value, Maybe String)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, Maybe String) -> Value
forall a b. (a, b) -> a
fst (Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.personalUsersWithoutHandle)
        [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> TestUserList -> [Value]
extractBots TestUserList
testUserList

    extractBots :: TestUserList -> [Value]
    extractBots :: TestUserList -> [Value]
extractBots TestUserList
testUserList =
      ((Value, Maybe String) -> Value)
-> [(Value, Maybe String)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, Maybe String) -> Value
forall a b. (a, b) -> a
fst (Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.botsInTeamConvs.users)
        [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> ((Value, Value) -> Value) -> [(Value, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value, Value) -> Value
forall a b. (a, b) -> a
fst (Map String (Value, Value) -> [(Value, Value)]
forall k a. Map k a -> [a]
Map.elems TestUserList
testUserList.botsInPersonalConvs)

    createTestUsers :: (HasCallStack, MakesValue mel) => String -> mel -> String -> String -> Int -> App TestUserList
    createTestUsers :: forall mel.
(HasCallStack, MakesValue mel) =>
String -> mel -> String -> String -> Int -> App TestUserList
createTestUsers String
domain mel
mel String
pid String
sid Int
n = Concurrently App TestUserList -> App TestUserList
forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently (Concurrently App TestUserList -> App TestUserList)
-> Concurrently App TestUserList -> App TestUserList
forall a b. (a -> b) -> a -> b
$ do
      TestScimUsers
scimUsersWithRichInfo <- App TestScimUsers -> Concurrently App TestScimUsers
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (App TestScimUsers -> Concurrently App TestScimUsers)
-> App TestScimUsers -> Concurrently App TestScimUsers
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Int -> Bool -> Bool -> App TestScimUsers
String -> Int -> Bool -> Bool -> App TestScimUsers
createScimUsers String
domain Int
n Bool
True Bool
True
      TestScimUsers
scimUsersWithoutRichInfo <- App TestScimUsers -> Concurrently App TestScimUsers
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (App TestScimUsers -> Concurrently App TestScimUsers)
-> App TestScimUsers -> Concurrently App TestScimUsers
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Int -> Bool -> Bool -> App TestScimUsers
String -> Int -> Bool -> Bool -> App TestScimUsers
createScimUsers String
domain Int
n Bool
False Bool
True
      TestScimUsers
pendingScimUsers <- App TestScimUsers -> Concurrently App TestScimUsers
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (App TestScimUsers -> Concurrently App TestScimUsers)
-> App TestScimUsers -> Concurrently App TestScimUsers
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Int -> Bool -> Bool -> App TestScimUsers
String -> Int -> Bool -> Bool -> App TestScimUsers
createScimUsers String
domain Int
n Bool
False Bool
False
      TestTeamUsers
ssoUsers <- App TestTeamUsers -> Concurrently App TestTeamUsers
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (App TestTeamUsers -> Concurrently App TestTeamUsers)
-> App TestTeamUsers -> Concurrently App TestTeamUsers
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Int -> App TestTeamUsers
String -> Int -> App TestTeamUsers
createSsoUsers String
domain Int
n
      TestTeamUsers
passwordTeamUsers <- App TestTeamUsers -> Concurrently App TestTeamUsers
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (App TestTeamUsers -> Concurrently App TestTeamUsers)
-> App TestTeamUsers -> Concurrently App TestTeamUsers
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Int -> App TestTeamUsers
String -> Int -> App TestTeamUsers
createPasswordTeamUsers String
domain Int
n
      Map String (Value, Maybe String)
personalUsersWithoutHandle <- App (Map String (Value, Maybe String))
-> Concurrently App (Map String (Value, Maybe String))
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (App (Map String (Value, Maybe String))
 -> Concurrently App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
-> Concurrently App (Map String (Value, Maybe String))
forall a b. (a -> b) -> a -> b
$ String
-> mel -> Int -> Bool -> App (Map String (Value, Maybe String))
forall mel.
(HasCallStack, MakesValue mel) =>
String
-> mel -> Int -> Bool -> App (Map String (Value, Maybe String))
createPersonalUsers String
domain mel
mel Int
n Bool
False
      Map String (Value, Maybe String)
personalUsersWithHandle <- App (Map String (Value, Maybe String))
-> Concurrently App (Map String (Value, Maybe String))
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (App (Map String (Value, Maybe String))
 -> Concurrently App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
-> Concurrently App (Map String (Value, Maybe String))
forall a b. (a -> b) -> a -> b
$ String
-> mel -> Int -> Bool -> App (Map String (Value, Maybe String))
forall mel.
(HasCallStack, MakesValue mel) =>
String
-> mel -> Int -> Bool -> App (Map String (Value, Maybe String))
createPersonalUsers String
domain mel
mel Int
n Bool
True
      TestTeamUsers
botsInTeamConvs <- App TestTeamUsers -> Concurrently App TestTeamUsers
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (App TestTeamUsers -> Concurrently App TestTeamUsers)
-> App TestTeamUsers -> Concurrently App TestTeamUsers
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
String -> String -> String -> Int -> App TestTeamUsers
String -> String -> String -> Int -> App TestTeamUsers
createTeamBots String
domain String
pid String
sid Int
n
      Map String (Value, Value)
botsInPersonalConvs <- App (Map String (Value, Value))
-> Concurrently App (Map String (Value, Value))
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (App (Map String (Value, Value))
 -> Concurrently App (Map String (Value, Value)))
-> App (Map String (Value, Value))
-> Concurrently App (Map String (Value, Value))
forall a b. (a -> b) -> a -> b
$ String
-> mel
-> Maybe String
-> String
-> String
-> Int
-> App (Map String (Value, Value))
forall user.
(HasCallStack, MakesValue user) =>
String
-> user
-> Maybe String
-> String
-> String
-> Int
-> App (Map String (Value, Value))
createConvsAndAddBot String
domain mel
mel Maybe String
forall a. Maybe a
Nothing String
pid String
sid Int
n
      pure TestUserList {Map String (Value, Maybe String)
Map String (Value, Value)
TestTeamUsers
TestScimUsers
scimUsersWithRichInfo :: TestScimUsers
scimUsersWithoutRichInfo :: TestScimUsers
pendingScimUsers :: TestScimUsers
ssoUsers :: TestTeamUsers
passwordTeamUsers :: TestTeamUsers
personalUsersWithoutHandle :: Map String (Value, Maybe String)
personalUsersWithHandle :: Map String (Value, Maybe String)
botsInTeamConvs :: TestTeamUsers
botsInPersonalConvs :: Map String (Value, Value)
scimUsersWithRichInfo :: TestScimUsers
scimUsersWithoutRichInfo :: TestScimUsers
pendingScimUsers :: TestScimUsers
ssoUsers :: TestTeamUsers
passwordTeamUsers :: TestTeamUsers
personalUsersWithoutHandle :: Map String (Value, Maybe String)
personalUsersWithHandle :: Map String (Value, Maybe String)
botsInTeamConvs :: TestTeamUsers
botsInPersonalConvs :: Map String (Value, Value)
..}

    getUnqualifiedUser :: String -> String -> App (Map String Value)
    getUnqualifiedUser :: String -> String -> App (Map String Value)
getUnqualifiedUser String
domain String
uid = do
      let quid :: Value
quid = [Pair] -> Value
object [String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain, String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid]
      String -> Value -> Map String Value
forall k a. k -> a -> Map k a
Map.singleton String
uid (Value -> Map String Value) -> App Value -> App (Map String Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
quid 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
200)

    createScimUsers :: (HasCallStack) => String -> Int -> Bool -> Bool -> App TestScimUsers
    createScimUsers :: HasCallStack => String -> Int -> Bool -> Bool -> App TestScimUsers
createScimUsers String
domain Int
n Bool
shouldCreateRichInfo Bool
shouldAcceptInvite = do
      (Value
owner, String
tid, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
      String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Response
resp -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
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 String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      Map String (Value, String, Value)
users <- ([Map String (Value, String, Value)]
 -> Map String (Value, String, Value))
-> App [Map String (Value, String, Value)]
-> App (Map String (Value, String, Value))
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map String (Value, String, Value)]
-> Map String (Value, String, Value)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (App [Map String (Value, String, Value)]
 -> App (Map String (Value, String, Value)))
-> (App (Map String (Value, String, Value))
    -> App [Map String (Value, String, Value)])
-> App (Map String (Value, String, Value))
-> App (Map String (Value, String, Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> App (Map String (Value, String, Value))
-> App [Map String (Value, String, Value)]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
16 Int
n (App (Map String (Value, String, Value))
 -> App (Map String (Value, String, Value)))
-> App (Map String (Value, String, Value))
-> App (Map String (Value, String, Value))
forall a b. (a -> b) -> a -> b
$ do
        Value
newScimUser0 <- App Value
randomScimUser
        Value
newScimUser <-
          if Bool
shouldCreateRichInfo
            then do
              String
richInfoKey <- Int -> App String
randomAlphaString Int
10
              String
richInfoValue <- Int -> App String
randomString Int
10
              (KeyMap Value -> KeyMap Value) -> Value -> App Value
forall a.
(HasCallStack, MakesValue a) =>
(KeyMap Value -> KeyMap Value) -> a -> App Value
modifyObject (Key -> Value -> KeyMap Value -> KeyMap Value
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert (String -> Key
forall a. IsString a => String -> a
fromString String
"urn:ietf:params:scim:schemas:extension:wire:1.0:User") ([Pair] -> Value
object [String
richInfoKey String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
richInfoValue]))
                (Value -> App Value) -> App Value -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [String] -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"schemas" [String
"urn:ietf:params:scim:schemas:core:2.0:User", String
"urn:ietf:params:scim:schemas:extension:wire:1.0:User"] Value
newScimUser0
            else Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
newScimUser0
        String
email <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value
newScimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails.0.value"
        Value
inactiveScimUser <- String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser String
domain String
tok Value
newScimUser 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
        String
uid <- Value
inactiveScimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        (Value
scimUser, Map String Value
userOrInv) <-
          if Bool
shouldAcceptInvite
            then do
              String -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser String
domain String
tid String
email
              Value
scimUser <- Value -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Value
owner String
tok String
uid 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
200
              (Value
scimUser,) (Map String Value -> (Value, Map String Value))
-> App (Map String Value) -> App (Value, Map String Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> App (Map String Value)
getUnqualifiedUser String
domain String
uid
            else (Map String Value -> (Value, Map String Value))
-> App (Map String Value) -> App (Value, Map String Value)
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value
inactiveScimUser,) (App (Map String Value) -> App (Value, Map String Value))
-> (Response -> App (Map String Value))
-> Response
-> App (Value, Map String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Map String Value) -> App Value -> App (Map String Value)
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Value -> Map String Value
forall k a. k -> a -> Map k a
Map.singleton String
uid) (App Value -> App (Map String Value))
-> (Response -> App Value) -> Response -> App (Map String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 (Response -> App (Value, Map String Value))
-> App Response -> App (Value, Map String Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
I.getInvitationByEmail String
domain String
email
        Map String (Value, String, Value)
-> App (Map String (Value, String, Value))
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map String (Value, String, Value)
 -> App (Map String (Value, String, Value)))
-> Map String (Value, String, Value)
-> App (Map String (Value, String, Value))
forall a b. (a -> b) -> a -> b
$ (Value
scimUser,String
defPassword,) (Value -> (Value, String, Value))
-> Map String Value -> Map String (Value, String, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Value
userOrInv
      pure $ Value
-> String -> Map String (Value, String, Value) -> TestScimUsers
TestScimUsers Value
owner String
tok Map String (Value, String, Value)
users

    deleteScimUsers :: (HasCallStack) => String -> Bool -> TestScimUsers -> App ()
    deleteScimUsers :: HasCallStack => String -> Bool -> TestScimUsers -> App ()
deleteScimUsers String
domain Bool
arePendingUsers TestScimUsers
testScimUsers = do
      Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket TestScimUsers
testScimUsers.owner ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsOwner -> do
        Int
-> Map String (Value, String, Value)
-> ((Value, String, Value) -> App ())
-> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism TestScimUsers
testScimUsers.users (((Value, String, Value) -> App ()) -> App ())
-> ((Value, String, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(Value
scimUser, String
_, Value
_) -> do
          String
uid <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
          String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
deleteScimUser String
domain TestScimUsers
testScimUsers.token String
uid 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
          String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser String
domain TestScimUsers
testScimUsers.token String
uid 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
404

        Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
arePendingUsers (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
          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 (Map String (Value, String, Value) -> Int
forall k a. Map k a -> Int
Map.size TestScimUsers
testScimUsers.users) Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isTeamMemberLeaveNotif WebSocket
wsOwner

    updatePendingScimUserAndCheck :: (HasCallStack) => String -> String -> (Value, String, Value) -> UserUpdate -> App (Value, String, Value)
    updatePendingScimUserAndCheck :: HasCallStack =>
String
-> String
-> (Value, String, Value)
-> UserUpdate
-> App (Value, String, Value)
updatePendingScimUserAndCheck String
domain String
token (Value
scimUser, String
pw, Value
inv) UserUpdate
update = do
      String
-> UserUpdate
-> App (Value, String, Value)
-> App (Value, String, Value)
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"update" UserUpdate
update (App (Value, String, Value) -> App (Value, String, Value))
-> (App (Value, String, Value) -> App (Value, String, Value))
-> App (Value, String, Value)
-> App (Value, String, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Value
-> App (Value, String, Value)
-> App (Value, String, Value)
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"scimUser" Value
scimUser (App (Value, String, Value) -> App (Value, String, Value))
-> App (Value, String, Value) -> App (Value, String, Value)
forall a b. (a -> b) -> a -> b
$ do
        String
uid <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        Value
updatedScimUser <- case UserUpdate
update of
          UpdatePassword String
_ -> do
            Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
scimUser
          UserUpdate
_ -> do
            let updateScimRecord :: Value -> App Value
updateScimRecord = case UserUpdate
update of
                  UpdateName String
newName -> String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"displayName" String
newName
                  UpdateEmail String
newEmail -> String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"emails" (Array -> Value
Array (Value -> Array
forall a. a -> Vector a
Vector.singleton ([Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail])))
                  UpdateHandle String
newHandle -> String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"userName" String
newHandle
            Value
updateScimReq <- String -> Bool -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"active" Bool
True (Value -> App Value) -> App Value -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> App Value
updateScimRecord Value
scimUser
            String -> String -> String -> Value -> App Response
forall domain conn.
(HasCallStack, MakesValue domain, MakesValue conn) =>
domain -> String -> String -> conn -> App Response
updateScimUser String
domain String
token String
uid Value
updateScimReq App Response -> (Response -> App Value) -> App Value
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
              case UserUpdate
update of
                UpdateName String
newName -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"displayName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newName
                UpdateEmail String
newEmail -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails.0.value" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
                UpdateHandle String
newHandle -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"userName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
              String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"expected a updated scim user" Response
resp.json
        (Value
updatedUserOrInv, String
newPassword) <- do
          case UserUpdate
update of
            UpdatePassword String
newPassword -> (Value, String) -> App (Value, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
inv, String
newPassword)
            UserUpdate
_ ->
              -- Changing email of a pending user doesn't generate a new
              -- invitation, perhaps this is a bug?
              -- Changing other things ofc doesn't generate a new invitation.
              (Value, String) -> App (Value, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
inv, String
pw)
        pure (Value
updatedScimUser, String
newPassword, Value
updatedUserOrInv)

    updateScimUserAndCheck :: (HasCallStack) => String -> String -> (Value, String, Value) -> UserUpdate -> App (Value, String, Value)
    updateScimUserAndCheck :: HasCallStack =>
String
-> String
-> (Value, String, Value)
-> UserUpdate
-> App (Value, String, Value)
updateScimUserAndCheck String
domain String
token (Value
scimUser, String
pw, Value
user) UserUpdate
update = do
      String
uid <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      Value
updatedScimUser <- case UserUpdate
update of
        UpdatePassword String
newPassword -> do
          Value -> String -> String -> App Response
forall user.
MakesValue user =>
user -> String -> String -> App Response
putPassword Value
user String
pw String
newPassword 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
          pure Value
scimUser
        UserUpdate
_ -> do
          Value
updateScimReq <- case UserUpdate
update of
            UpdateName String
newName -> String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"displayName" String
newName Value
scimUser
            UpdateEmail String
newEmail -> String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"emails" (Array -> Value
Array (Value -> Array
forall a. a -> Vector a
Vector.singleton ([Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail]))) Value
scimUser
            UpdateHandle String
newHandle -> String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"userName" String
newHandle Value
scimUser
          String -> String -> String -> Value -> App Response
forall domain conn.
(HasCallStack, MakesValue domain, MakesValue conn) =>
domain -> String -> String -> conn -> App Response
updateScimUser String
domain String
token String
uid Value
updateScimReq App Response -> (Response -> App Value) -> App Value
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
            case UserUpdate
update of
              UpdateName String
newName -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"displayName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newName
              UpdateEmail String
newEmail -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails.0.value" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
              UpdateHandle String
newHandle -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"userName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
            String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"expected a updated scim user" Response
resp.json
      (Value
updatedUserOrInv, String
newPassword) <- case UserUpdate
update of
        UpdatePassword String
newPassword -> do
          String
email <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails.0.value" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
          String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
login String
domain String
email String
newPassword 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
          pure (Value
user, String
newPassword)
        UpdateEmail String
newEmail -> do
          String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail String
domain String
newEmail
          Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
user App Response
-> (Response -> App (Value, String)) -> App (Value, String)
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
            Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
            (,String
pw) (Value -> (Value, String)) -> App Value -> App (Value, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"expected user data" Response
resp.json
        UserUpdate
_ -> do
          Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
user App Response
-> (Response -> App (Value, String)) -> App (Value, String)
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
            case UserUpdate
update of
              UpdateName String
newName -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newName
              UpdateHandle String
newHandle -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
            (,String
pw) (Value -> (Value, String)) -> App Value -> App (Value, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"expected user data" Response
resp.json
      pure (Value
updatedScimUser, String
newPassword, Value
updatedUserOrInv)

    updateScimUsers :: (HasCallStack) => String -> TestScimUsers -> [UserUpdate] -> App TestScimUsers
    updateScimUsers :: HasCallStack =>
String -> TestScimUsers -> [UserUpdate] -> App TestScimUsers
updateScimUsers String
domain TestScimUsers
testScimUsers [UserUpdate]
updates = do
      let usersWithUpdates :: [((Value, String, Value), UserUpdate)]
usersWithUpdates = ([(Value, String, Value)]
-> [UserUpdate] -> [((Value, String, Value), UserUpdate)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map String (Value, String, Value) -> [(Value, String, Value)]
forall k a. Map k a -> [a]
Map.elems TestScimUsers
testScimUsers.users) [UserUpdate]
updates)
      Map String (Value, String, Value)
updatedUsers <- ([Map String (Value, String, Value)]
 -> Map String (Value, String, Value))
-> App [Map String (Value, String, Value)]
-> App (Map String (Value, String, Value))
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map String (Value, String, Value)]
-> Map String (Value, String, Value)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (App [Map String (Value, String, Value)]
 -> App (Map String (Value, String, Value)))
-> ((((Value, String, Value), UserUpdate)
     -> App (Map String (Value, String, Value)))
    -> App [Map String (Value, String, Value)])
-> (((Value, String, Value), UserUpdate)
    -> App (Map String (Value, String, Value)))
-> App (Map String (Value, String, Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [((Value, String, Value), UserUpdate)]
-> (((Value, String, Value), UserUpdate)
    -> App (Map String (Value, String, Value)))
-> App [Map String (Value, String, Value)]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> t a -> (a -> m b) -> m (t b)
pooledForConcurrentlyN Int
parallelism [((Value, String, Value), UserUpdate)]
usersWithUpdates ((((Value, String, Value), UserUpdate)
  -> App (Map String (Value, String, Value)))
 -> App (Map String (Value, String, Value)))
-> (((Value, String, Value), UserUpdate)
    -> App (Map String (Value, String, Value)))
-> App (Map String (Value, String, Value))
forall a b. (a -> b) -> a -> b
$ \((Value
scimUser, String
pw, Value
user), UserUpdate
update) -> do
        String
uid <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        String
-> (Value, String, Value) -> Map String (Value, String, Value)
forall k a. k -> a -> Map k a
Map.singleton String
uid ((Value, String, Value) -> Map String (Value, String, Value))
-> App (Value, String, Value)
-> App (Map String (Value, String, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack =>
String
-> String
-> (Value, String, Value)
-> UserUpdate
-> App (Value, String, Value)
String
-> String
-> (Value, String, Value)
-> UserUpdate
-> App (Value, String, Value)
updateScimUserAndCheck String
domain TestScimUsers
testScimUsers.token (Value
scimUser, String
pw, Value
user) UserUpdate
update

      pure $ (TestScimUsers
testScimUsers {users = updatedUsers} :: TestScimUsers)

    updatePendingScimUsers :: (HasCallStack) => String -> TestScimUsers -> [PendingScimUpdate] -> App TestScimUsers
    updatePendingScimUsers :: HasCallStack =>
String -> TestScimUsers -> [PendingScimUpdate] -> App TestScimUsers
updatePendingScimUsers String
domain TestScimUsers
testScimUsers [PendingScimUpdate]
updates = do
      let usersWithUpdates :: [((Value, String, Value), PendingScimUpdate)]
usersWithUpdates = ([(Value, String, Value)]
-> [PendingScimUpdate]
-> [((Value, String, Value), PendingScimUpdate)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map String (Value, String, Value) -> [(Value, String, Value)]
forall k a. Map k a -> [a]
Map.elems TestScimUsers
testScimUsers.users) [PendingScimUpdate]
updates)
      Map String (Value, String, Value)
updatedUsers <- ([Map String (Value, String, Value)]
 -> Map String (Value, String, Value))
-> App [Map String (Value, String, Value)]
-> App (Map String (Value, String, Value))
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map String (Value, String, Value)]
-> Map String (Value, String, Value)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (App [Map String (Value, String, Value)]
 -> App (Map String (Value, String, Value)))
-> ((((Value, String, Value), PendingScimUpdate)
     -> App (Map String (Value, String, Value)))
    -> App [Map String (Value, String, Value)])
-> (((Value, String, Value), PendingScimUpdate)
    -> App (Map String (Value, String, Value)))
-> App (Map String (Value, String, Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [((Value, String, Value), PendingScimUpdate)]
-> (((Value, String, Value), PendingScimUpdate)
    -> App (Map String (Value, String, Value)))
-> App [Map String (Value, String, Value)]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> t a -> (a -> m b) -> m (t b)
pooledForConcurrentlyN Int
parallelism [((Value, String, Value), PendingScimUpdate)]
usersWithUpdates ((((Value, String, Value), PendingScimUpdate)
  -> App (Map String (Value, String, Value)))
 -> App (Map String (Value, String, Value)))
-> (((Value, String, Value), PendingScimUpdate)
    -> App (Map String (Value, String, Value)))
-> App (Map String (Value, String, Value))
forall a b. (a -> b) -> a -> b
$ \((Value
scimUser, String
pw, Value
inv), PendingScimUpdate
update) -> do
        String
uid <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        String
email <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        String
tid <- TestScimUsers
testScimUsers.owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        String
-> (Value, String, Value) -> Map String (Value, String, Value)
forall k a. k -> a -> Map k a
Map.singleton String
uid ((Value, String, Value) -> Map String (Value, String, Value))
-> App (Value, String, Value)
-> App (Map String (Value, String, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case PendingScimUpdate
update of
          PendingScimUpdate
RegisterPendingScimUser -> do
            String -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser String
domain String
tid String
email
            Value
updatedScimUser <- String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser String
domain TestScimUsers
testScimUsers.token String
uid 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
200
            let quid :: Value
quid = [Pair] -> Value
object [String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain, String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid]
            (Value -> (Value, String, Value))
-> App Value -> App (Value, String, Value)
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value
updatedScimUser,String
pw,) (App Value -> App (Value, String, Value))
-> (Response -> App Value)
-> Response
-> App (Value, String, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 (Response -> App (Value, String, Value))
-> App Response -> App (Value, String, Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
quid
          UpdatePendingScimUser UserUpdate
updateUser -> do
            HasCallStack =>
String
-> String
-> (Value, String, Value)
-> UserUpdate
-> App (Value, String, Value)
String
-> String
-> (Value, String, Value)
-> UserUpdate
-> App (Value, String, Value)
updatePendingScimUserAndCheck String
domain TestScimUsers
testScimUsers.token (Value
scimUser, String
pw, Value
inv) UserUpdate
updateUser
      pure (TestScimUsers
testScimUsers {users = updatedUsers} :: TestScimUsers)

    createSsoUsers :: (HasCallStack) => String -> Int -> App TestTeamUsers
    createSsoUsers :: HasCallStack => String -> Int -> App TestTeamUsers
createSsoUsers String
domain Int
n = do
      (Value
owner, String
tid, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
      Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
I.setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled" 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
      (Response
createIdpResp, (IdPMetadata
idpMeta, SignPrivCreds
privcreds)) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
      HasCallStack => Response -> App ()
Response -> App ()
assertSuccess Response
createIdpResp
      String
idpId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value -> App String) -> App Value -> App String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Response
createIdpResp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")

      Map String (Value, Maybe String)
users <- ([Map String (Value, Maybe String)]
 -> Map String (Value, Maybe String))
-> App [Map String (Value, Maybe String)]
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map String (Value, Maybe String)]
-> Map String (Value, Maybe String)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (App [Map String (Value, Maybe String)]
 -> App (Map String (Value, Maybe String)))
-> (App (Map String (Value, Maybe String))
    -> App [Map String (Value, Maybe String)])
-> App (Map String (Value, Maybe String))
-> App (Map String (Value, Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> App (Map String (Value, Maybe String))
-> App [Map String (Value, Maybe String)]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
16 Int
n (App (Map String (Value, Maybe String))
 -> App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> a -> b
$ do
        NameID
subject <- App NameID
nextSubject
        (Maybe String
mUid, SignedAuthnResponse
_) <- Maybe String
-> String
-> Bool
-> String
-> NameID
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
forall domain.
(MakesValue domain, HasCallStack) =>
Maybe String
-> domain
-> Bool
-> String
-> NameID
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSamlWithZHost Maybe String
forall a. Maybe a
Nothing String
domain Bool
True String
tid NameID
subject (String
idpId, (IdPMetadata
idpMeta, SignPrivCreds
privcreds))
        String
uid <- String -> Maybe String -> App String
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"user id not created by logging in with SAML" Maybe String
mUid
        (,Maybe String
forall a. Maybe a
Nothing) (Value -> (Value, Maybe String))
-> App (Map String Value) -> App (Map String (Value, Maybe String))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> String -> String -> App (Map String Value)
getUnqualifiedUser String
domain String
uid
      pure $ TestTeamUsers {Value
Map String (Value, Maybe String)
owner :: Value
users :: Map String (Value, Maybe String)
users :: Map String (Value, Maybe String)
owner :: Value
..}

    createPasswordTeamUsers :: (HasCallStack) => String -> Int -> App TestTeamUsers
    createPasswordTeamUsers :: HasCallStack => String -> Int -> App TestTeamUsers
createPasswordTeamUsers String
domain Int
n = do
      (Value
owner, String
_tid, [Value]
usersWithoutPassword) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
n

      Map String (Value, Maybe String)
users <- ([Map String (Value, Maybe String)]
 -> Map String (Value, Maybe String))
-> App [Map String (Value, Maybe String)]
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map String (Value, Maybe String)]
-> Map String (Value, Maybe String)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (App [Map String (Value, Maybe String)]
 -> App (Map String (Value, Maybe String)))
-> ((Value -> App (Map String (Value, Maybe String)))
    -> App [Map String (Value, Maybe String)])
-> (Value -> App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [Value]
-> (Value -> App (Map String (Value, Maybe String)))
-> App [Map String (Value, Maybe String)]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> t a -> (a -> m b) -> m (t b)
pooledForConcurrentlyN Int
parallelism [Value]
usersWithoutPassword ((Value -> App (Map String (Value, Maybe String)))
 -> App (Map String (Value, Maybe String)))
-> (Value -> App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> a -> b
$ \Value
user -> do
        String
p <- App String
randomPassword
        Value -> String -> String -> App Response
forall user.
MakesValue user =>
user -> String -> String -> App Response
putPassword Value
user String
defPassword String
p 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
        String
uid <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        pure $ String -> (Value, Maybe String) -> Map String (Value, Maybe String)
forall k a. k -> a -> Map k a
Map.singleton String
uid (Value
user, String -> Maybe String
forall a. a -> Maybe a
Just String
p)

      pure $ TestTeamUsers {Value
Map String (Value, Maybe String)
users :: Map String (Value, Maybe String)
owner :: Value
owner :: Value
users :: Map String (Value, Maybe String)
..}

    deleteTeamUsers :: (HasCallStack) => TestTeamUsers -> App ()
    deleteTeamUsers :: HasCallStack => TestTeamUsers -> App ()
deleteTeamUsers TestTeamUsers
team = do
      Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket TestTeamUsers
team.owner ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsOwner -> do
        String
tid <- TestTeamUsers
team.owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        Int
-> Map String (Value, Maybe String)
-> ((Value, Maybe String) -> App ())
-> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism TestTeamUsers
team.users (((Value, Maybe String) -> App ()) -> App ())
-> ((Value, Maybe String) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(Value
user, Maybe String
_) -> do
          String
uid <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
          String -> Value -> String -> App Response
forall owner member.
(HasCallStack, MakesValue owner, MakesValue member) =>
String -> owner -> member -> App Response
deleteTeamMember String
tid TestTeamUsers
team.owner String
uid 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 (Map String (Value, Maybe String) -> Int
forall k a. Map k a -> Int
Map.size TestTeamUsers
team.users) Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isTeamMemberLeaveNotif WebSocket
wsOwner

    getSelfWithAssertion :: (HasCallStack, MakesValue user) => user -> ((HasCallStack) => Response -> App ()) -> App (Map String Value)
    getSelfWithAssertion :: forall user.
(HasCallStack, MakesValue user) =>
user
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
getSelfWithAssertion user
user HasCallStack => Response -> App ()
assertion = do
      user -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf user
user App Response
-> (Response -> App (Map String Value)) -> App (Map String Value)
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
        HasCallStack => Response -> App ()
Response -> App ()
assertion Response
resp
        String -> Value -> Map String Value
forall k a. k -> a -> Map k a
Map.singleton (String -> Value -> Map String Value)
-> App String -> App (Value -> Map String Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString) App (Value -> Map String Value)
-> App Value -> App (Map String Value)
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"expected GET /self to return a JSON" Response
resp.json)

    checkUpdateUser :: (HasCallStack) => Map String (Value, Maybe String) -> [UserUpdate] -> App (Map String (Value, Maybe String))
    checkUpdateUser :: HasCallStack =>
Map String (Value, Maybe String)
-> [UserUpdate] -> App (Map String (Value, Maybe String))
checkUpdateUser Map String (Value, Maybe String)
users [UserUpdate]
updates = do
      ([Map String (Value, Maybe String)]
 -> Map String (Value, Maybe String))
-> App [Map String (Value, Maybe String)]
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map String (Value, Maybe String)]
-> Map String (Value, Maybe String)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (App [Map String (Value, Maybe String)]
 -> App (Map String (Value, Maybe String)))
-> ((((Value, Maybe String), UserUpdate)
     -> App (Map String (Value, Maybe String)))
    -> App [Map String (Value, Maybe String)])
-> (((Value, Maybe String), UserUpdate)
    -> App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [((Value, Maybe String), UserUpdate)]
-> (((Value, Maybe String), UserUpdate)
    -> App (Map String (Value, Maybe String)))
-> App [Map String (Value, Maybe String)]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> t a -> (a -> m b) -> m (t b)
pooledForConcurrentlyN Int
parallelism ([(Value, Maybe String)]
-> [UserUpdate] -> [((Value, Maybe String), UserUpdate)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map String (Value, Maybe String) -> [(Value, Maybe String)]
forall k a. Map k a -> [a]
Map.elems Map String (Value, Maybe String)
users) [UserUpdate]
updates) ((((Value, Maybe String), UserUpdate)
  -> App (Map String (Value, Maybe String)))
 -> App (Map String (Value, Maybe String)))
-> (((Value, Maybe String), UserUpdate)
    -> App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> a -> b
$ \((Value
user, Maybe String
mPassword), UserUpdate
update) ->
        String
-> Value
-> App (Map String (Value, Maybe String))
-> App (Map String (Value, Maybe String))
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"user" Value
user (App (Map String (Value, Maybe String))
 -> App (Map String (Value, Maybe String)))
-> (App (Map String (Value, Maybe String))
    -> App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
-> App (Map String (Value, Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> UserUpdate
-> App (Map String (Value, Maybe String))
-> App (Map String (Value, Maybe String))
forall a b. MakesValue a => String -> a -> App b -> App b
addJSONToFailureContext String
"update" UserUpdate
update (App (Map String (Value, Maybe String))
 -> App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> a -> b
$ do
          Map String Value
updatedUser <- case (UserUpdate
update, Maybe String
mPassword) of
            (UpdateName String
newName, Maybe String
_) -> do
              Value -> PutSelf -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> PutSelf -> App Response
putSelf Value
user PutSelf
forall a. Default a => a
def {name = Just newName} 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
              Value
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
forall user.
(HasCallStack, MakesValue user) =>
user
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
getSelfWithAssertion Value
user ((HasCallStack => Response -> App ()) -> App (Map String Value))
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
forall a b. (a -> b) -> a -> b
$ \Response
resp -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newName
            (UpdateEmail String
newEmail, Just String
pw) -> do
              String
oldEmail <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
              (String
cookie, String
token) <- App Response
-> (Response -> App (String, String)) -> App (String, String)
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
login Value
user String
oldEmail String
pw) ((Response -> App (String, String)) -> App (String, String))
-> (Response -> App (String, String)) -> App (String, String)
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
                Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
                String
token <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"access_token" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
                let cookie :: String
cookie = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Response -> Maybe String
getCookie String
"zuid" Response
resp
                pure (String
"zuid=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cookie, String
token)
              Value -> String -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> String -> App Response
updateEmail Value
user String
newEmail String
cookie String
token 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
              Value -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Value
user String
newEmail
              Value
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
forall user.
(HasCallStack, MakesValue user) =>
user
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
getSelfWithAssertion Value
user ((HasCallStack => Response -> App ()) -> App (Map String Value))
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
forall a b. (a -> b) -> a -> b
$ \Response
resp -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
            (UpdateEmail {}, Maybe String
Nothing) -> do
              String
uid <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
              pure $ String -> Value -> Map String Value
forall k a. k -> a -> Map k a
Map.singleton String
uid Value
user
            (UpdateHandle String
newHandle, Maybe String
_) -> do
              Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
putHandle Value
user String
newHandle 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
              Value
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
forall user.
(HasCallStack, MakesValue user) =>
user
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
getSelfWithAssertion Value
user ((HasCallStack => Response -> App ()) -> App (Map String Value))
-> (HasCallStack => Response -> App ()) -> App (Map String Value)
forall a b. (a -> b) -> a -> b
$ \Response
resp -> Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
            (UpdatePassword String
newPassword, Just String
oldPassword) -> do
              String
email <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
              Value -> String -> String -> App Response
forall user.
MakesValue user =>
user -> String -> String -> App Response
putPassword Value
user String
oldPassword String
newPassword 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
              Value -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
login Value
user String
email String
oldPassword 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
403
              Value -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
login Value
user String
email String
newPassword 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
              String
uid <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
              pure $ String -> Value -> Map String Value
forall k a. k -> a -> Map k a
Map.singleton String
uid Value
user
            (UpdatePassword {}, Maybe String
Nothing) -> do
              String
uid <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
              pure $ String -> Value -> Map String Value
forall k a. k -> a -> Map k a
Map.singleton String
uid Value
user
          pure $ (,Maybe String
mPassword) (Value -> (Value, Maybe String))
-> Map String Value -> Map String (Value, Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Value
updatedUser

    createPersonalUsers :: (HasCallStack, MakesValue mel) => String -> mel -> Int -> Bool -> App (Map String (Value, Maybe String))
    createPersonalUsers :: forall mel.
(HasCallStack, MakesValue mel) =>
String
-> mel -> Int -> Bool -> App (Map String (Value, Maybe String))
createPersonalUsers String
domain mel
mel Int
n Bool
claimHandle =
      ([Map String (Value, Maybe String)]
 -> Map String (Value, Maybe String))
-> App [Map String (Value, Maybe String)]
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map String (Value, Maybe String)]
-> Map String (Value, Maybe String)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (App [Map String (Value, Maybe String)]
 -> App (Map String (Value, Maybe String)))
-> (App (Map String (Value, Maybe String))
    -> App [Map String (Value, Maybe String)])
-> App (Map String (Value, Maybe String))
-> App (Map String (Value, Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> App (Map String (Value, Maybe String))
-> App [Map String (Value, Maybe String)]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
parallelism Int
n (App (Map String (Value, Maybe String))
 -> App (Map String (Value, Maybe String)))
-> App (Map String (Value, Maybe String))
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> a -> b
$ do
        Value
user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
        mel -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers mel
mel Value
user
        String
uid <- Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        if Bool
claimHandle
          then do
            String
hdl <- App String
randomHandle
            Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
putHandle Value
user String
hdl 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
            (Value -> (Value, Maybe String))
-> Map String Value -> Map String (Value, Maybe String)
forall a b. (a -> b) -> Map String a -> Map String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,String -> Maybe String
forall a. a -> Maybe a
Just String
defPassword) (Map String Value -> Map String (Value, Maybe String))
-> (Value -> Map String Value)
-> Value
-> Map String (Value, Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Map String Value
forall k a. k -> a -> Map k a
Map.singleton String
uid (Value -> Map String (Value, Maybe String))
-> App Value -> App (Map String (Value, Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"handle" String
hdl Value
user)
          else Map String (Value, Maybe String)
-> App (Map String (Value, Maybe String))
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map String (Value, Maybe String)
 -> App (Map String (Value, Maybe String)))
-> Map String (Value, Maybe String)
-> App (Map String (Value, Maybe String))
forall a b. (a -> b) -> a -> b
$ String -> (Value, Maybe String) -> Map String (Value, Maybe String)
forall k a. k -> a -> Map k a
Map.singleton String
uid (Value
user, String -> Maybe String
forall a. a -> Maybe a
Just String
defPassword)

    deletePersonalUsers :: (HasCallStack, MakesValue mel, ToWSConnect mel) => mel -> Map String (Value, Maybe String) -> App ()
    deletePersonalUsers :: forall mel.
(HasCallStack, MakesValue mel, ToWSConnect mel) =>
mel -> Map String (Value, Maybe String) -> App ()
deletePersonalUsers mel
mel Map String (Value, Maybe String)
users =
      mel -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket mel
mel ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
wsMel -> do
        Int
-> Map String (Value, Maybe String)
-> ((Value, Maybe String) -> App Response)
-> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism Map String (Value, Maybe String)
users (((Value, Maybe String) -> App Response) -> App ())
-> ((Value, Maybe String) -> App Response) -> App ()
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe String -> App Response)
-> (Value, Maybe String) -> App Response
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Value -> Maybe String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> App Response
deleteUserWithPassword
        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 (Map String (Value, Maybe String) -> Int
forall k a. Map k a -> Int
Map.size Map String (Value, Maybe String)
users) Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isDeleteUserNotif WebSocket
wsMel

    createConvsAndAddBot :: (HasCallStack, MakesValue user) => String -> user -> Maybe String -> String -> String -> Int -> App (Map String (Value, Value))
    createConvsAndAddBot :: forall user.
(HasCallStack, MakesValue user) =>
String
-> user
-> Maybe String
-> String
-> String
-> Int
-> App (Map String (Value, Value))
createConvsAndAddBot String
domain user
user Maybe String
tid String
pid String
sid Int
n = do
      ([Map String (Value, Value)] -> Map String (Value, Value))
-> App [Map String (Value, Value)]
-> App (Map String (Value, Value))
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map String (Value, Value)] -> Map String (Value, Value)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (App [Map String (Value, Value)]
 -> App (Map String (Value, Value)))
-> (App (Map String (Value, Value))
    -> App [Map String (Value, Value)])
-> App (Map String (Value, Value))
-> App (Map String (Value, Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> App (Map String (Value, Value))
-> App [Map String (Value, Value)]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
parallelism Int
n (App (Map String (Value, Value))
 -> App (Map String (Value, Value)))
-> App (Map String (Value, Value))
-> App (Map String (Value, Value))
forall a b. (a -> b) -> a -> b
$ do
        Value
conv <- user -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation user
user (CreateConv
defProteus {team = tid}) 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
        String
convId <- Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
        Value
addBotResp <- user -> String -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> String -> App Response
addBot user
user String
pid String
sid String
convId 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
        String
botId <- Value
addBotResp Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        (,Value
conv) (Value -> (Value, Value))
-> App (Map String Value) -> App (Map String (Value, Value))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> String -> String -> App (Map String Value)
getUnqualifiedUser String
domain String
botId

    createTeamBots :: (HasCallStack) => String -> String -> String -> Int -> App TestTeamUsers
    createTeamBots :: HasCallStack =>
String -> String -> String -> Int -> App TestTeamUsers
createTeamBots String
domain String
pid String
sid Int
n = do
      (Value
owner, String
tid, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
      Value -> String -> Value -> App Response
forall user tid update.
(HasCallStack, MakesValue user, MakesValue tid,
 MakesValue update) =>
user -> tid -> update -> App Response
postServiceWhitelist Value
owner String
tid ([Pair] -> Value
object [String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
sid, String
"provider" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
pid, String
"whitelisted" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True])
        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
      Value -> Map String (Value, Maybe String) -> TestTeamUsers
TestTeamUsers Value
owner (Map String (Value, Maybe String) -> TestTeamUsers)
-> (Map String (Value, Value) -> Map String (Value, Maybe String))
-> Map String (Value, Value)
-> TestTeamUsers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Value, Value) -> (Value, Maybe String))
-> Map String (Value, Value) -> Map String (Value, Maybe String)
forall a b. (a -> b) -> Map String a -> Map String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Value
x, Value
_) -> (Value
x, Maybe String
forall a. Maybe a
Nothing)) (Map String (Value, Value) -> TestTeamUsers)
-> App (Map String (Value, Value)) -> App TestTeamUsers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Value
-> Maybe String
-> String
-> String
-> Int
-> App (Map String (Value, Value))
forall user.
(HasCallStack, MakesValue user) =>
String
-> user
-> Maybe String
-> String
-> String
-> Int
-> App (Map String (Value, Value))
createConvsAndAddBot String
domain Value
owner (String -> Maybe String
forall a. a -> Maybe a
Just String
tid) String
pid String
sid Int
n

    deleteBotsTeam :: (HasCallStack) => TestTeamUsers -> String -> String -> App ()
    deleteBotsTeam :: HasCallStack => TestTeamUsers -> String -> String -> App ()
deleteBotsTeam TestTeamUsers
testTeam String
pid String
sid = do
      String
tid <- TestTeamUsers
testTeam.owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket TestTeamUsers
testTeam.owner ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
        Value -> String -> Value -> App Response
forall user tid update.
(HasCallStack, MakesValue user, MakesValue tid,
 MakesValue update) =>
user -> tid -> update -> App Response
postServiceWhitelist TestTeamUsers
testTeam.owner String
tid ([Pair] -> Value
object [String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
sid, String
"provider" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
pid, String
"whitelisted" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False]) 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 (Map String (Value, Maybe String) -> Int
forall k a. Map k a -> Int
Map.size TestTeamUsers
testTeam.users) Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvLeaveNotif WebSocket
ws

    deleteBotConvs :: (HasCallStack) => Value -> Map String (Value, Value) -> App ()
    deleteBotConvs :: HasCallStack => Value -> Map String (Value, Value) -> App ()
deleteBotConvs Value
mel Map String (Value, Value)
botConvs = do
      Int -> [(Value, Value)] -> ((Value, Value) -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism (Map String (Value, Value) -> [(Value, Value)]
forall k a. Map k a -> [a]
Map.elems Map String (Value, Value)
botConvs) (((Value, Value) -> App ()) -> App ())
-> ((Value, Value) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(Value
bot, Value
conv) -> do
        String
cid <- Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        String
bid <- Value
bot Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        Value -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
rmBotSelf Value
mel String
bid String
cid 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

-- | This test creates users in PG and Cassandra separately to simulate a
-- situation where there are users in both DBs. Then tries to index them into ES
-- to make sure the pagination over these users works.
testReindexingUsersDuringMigration :: (HasCallStack) => App ()
testReindexingUsersDuringMigration :: HasCallStack => App ()
testReindexingUsersDuringMigration = do
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)

  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
backend] -> do
    let domain :: String
domain = BackendResource
backend.berDomain
    -- Create users in cassandra using 'phase1Overrides'
    (Value
casSearcher, [Value]
casExistingUsers, [Value]
casDeletedUsers) <-
      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
backend ServiceOverrides
phase1Overrides)
        ((String -> App (Value, [Value], [Value]))
 -> App (Value, [Value], [Value]))
-> (String -> App (Value, [Value], [Value]))
-> App (Value, [Value], [Value])
forall a b. (a -> b) -> a -> b
$ \String
_ -> HasCallStack => String -> App (Value, [Value], [Value])
String -> App (Value, [Value], [Value])
setupUsers String
domain

    -- Create users in postgres using 'phase5Overrides'
    (Value
pgSearcher, [Value]
pgExistingUsers, [Value]
pgDeletedUsers) <-
      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
backend ServiceOverrides
phase5Overrides)
        ((String -> App (Value, [Value], [Value]))
 -> App (Value, [Value], [Value]))
-> (String -> App (Value, [Value], [Value]))
-> App (Value, [Value], [Value])
forall a b. (a -> b) -> a -> b
$ \String
_ -> HasCallStack => String -> App (Value, [Value], [Value])
String -> App (Value, [Value], [Value])
setupUsers String
domain

    -- Test that searching in the already existing index works with in
    -- 'phase2Overrides', which should work with data in cassandra and postgres
    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
backend ServiceOverrides
phase2Overrides) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App ()
I.refreshIndex String
domain
      HasCallStack => String -> Value -> [Value] -> [Value] -> App ()
String -> Value -> [Value] -> [Value] -> App ()
checkSearchWorks String
domain Value
casSearcher [Value]
casExistingUsers [Value]
casDeletedUsers
      HasCallStack => String -> Value -> [Value] -> [Value] -> App ()
String -> Value -> [Value] -> [Value] -> App ()
checkSearchWorks String
domain Value
pgSearcher [Value]
pgExistingUsers [Value]
pgDeletedUsers

    String
newIndex <- App String
HasCallStack => App String
createNewIndex
    let backendWithNewIndex :: BackendResource
backendWithNewIndex = BackendResource
backend {berElasticsearchIndex = newIndex}
    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
backendWithNewIndex ServiceOverrides
phase2Overrides) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      HasCallStack =>
BackendResource -> ServiceOverrides -> Int -> App ()
BackendResource -> ServiceOverrides -> Int -> App ()
reindexUsers BackendResource
backendWithNewIndex ServiceOverrides
phase2Overrides Int
5
      String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App ()
I.refreshIndex String
domain
      HasCallStack => String -> Value -> [Value] -> [Value] -> App ()
String -> Value -> [Value] -> [Value] -> App ()
checkSearchWorks String
domain Value
casSearcher [Value]
casExistingUsers [Value]
casDeletedUsers
      HasCallStack => String -> Value -> [Value] -> [Value] -> App ()
String -> Value -> [Value] -> [Value] -> App ()
checkSearchWorks String
domain Value
pgSearcher [Value]
pgExistingUsers [Value]
pgDeletedUsers
  where
    n :: Int
n = Int
5
    parallelism :: Int
parallelism = Int
16

    setupUsers :: (HasCallStack) => String -> App (Value, [Value], [Value])
    setupUsers :: HasCallStack => String -> App (Value, [Value], [Value])
setupUsers String
domain = do
      Value
searcher <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      [Value]
existingUsers <- Int -> Int -> App Value -> App [Value]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
parallelism Int
n (App Value -> App [Value]) -> App Value -> App [Value]
forall a b. (a -> b) -> a -> b
$ String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      [Value]
deletedUsers <- Int -> Int -> App Value -> App [Value]
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
parallelism Int
n (App Value -> App [Value]) -> App Value -> App [Value]
forall a b. (a -> b) -> a -> b
$ do
        Value
u <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
        Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
searcher Value
u
        pure Value
u
      Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
searcher ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
        Int -> [Value] -> (Value -> App Response) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism [Value]
deletedUsers Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
deleteUser
        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
isDeleteUserNotif WebSocket
ws
      pure (Value
searcher, [Value]
existingUsers, [Value]
deletedUsers)

    checkSearchWorks :: (HasCallStack) => String -> Value -> [Value] -> [Value] -> App ()
    checkSearchWorks :: HasCallStack => String -> Value -> [Value] -> [Value] -> App ()
checkSearchWorks String
domain Value
searcher [Value]
existingUsers [Value]
deletedUsers = do
      Int -> [Value] -> (Value -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism [Value]
existingUsers ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
u ->
        Value -> Value -> App Value -> String -> App ()
forall searcher domain searchee searchTerm.
(HasCallStack, MakesValue searcher, MakesValue domain,
 MakesValue searchee, MakesValue searchTerm) =>
searcher -> searchee -> searchTerm -> domain -> App ()
assertCanFind Value
searcher Value
u (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") String
domain

      Int -> [Value] -> (Value -> App ()) -> App ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
parallelism [Value]
deletedUsers ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
u ->
        Value -> Value -> App Value -> String -> App ()
forall searcher domain searchee searchTerm.
(HasCallStack, MakesValue searcher, MakesValue domain,
 MakesValue searchee, MakesValue searchTerm) =>
searcher -> searchee -> searchTerm -> domain -> App ()
assertCannotFind Value
searcher Value
u (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") String
domain

-- handleA: Alice and Anna have the same handle, but the handle claims table
-- supports Alice's claim. After the migration Bob loses their handle.
--
-- handleB: Bob and Bill also have the same handle, but the handle claims table
-- doesn't support any of their claims. After the migration both of them will
-- loose the claim.
--
-- handleC: Carl and Creed also have the same handle, Cassandra supports Carl's
-- claim, while Postgresql supports Creed's claim. In this case Creed gets to
-- keep their handle.
testMigrationOfUsersWithHandleDisputes :: (HasCallStack) => App ()
testMigrationOfUsersWithHandleDisputes :: HasCallStack => App ()
testMigrationOfUsersWithHandleDisputes = do
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  -- Between Alice and Anna
  String
handleA <- App String
randomHandle

  -- In user record for Bob and Bill
  String
handleB <- App String
randomHandle

  -- Between Carl and Creed
  String
handleC <- App String
randomHandle

  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
backend] -> do
    let domain :: String
domain = BackendResource
backend.berDomain
        brigKeyspace :: String
brigKeyspace = BackendResource
backend.berBrigKeyspace
    (Value
alice, Value
anna, Value
bob, Value
bill, Value
carl) <- 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
backend ServiceOverrides
phase1Overrides) ((String -> App (Value, Value, Value, Value, Value))
 -> App (Value, Value, Value, Value, Value))
-> (String -> App (Value, Value, Value, Value, Value))
-> App (Value, Value, Value, Value, Value)
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      Value
anna <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      Value
bob <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      Value
bill <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      Value
carl <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def

      Just UUID
annaId <- String -> Maybe UUID
UUID.fromString (String -> Maybe UUID) -> App String -> App (Maybe UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
anna Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
      Just UUID
bobId <- String -> Maybe UUID
UUID.fromString (String -> Maybe UUID) -> App String -> App (Maybe UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
      Just UUID
billId <- String -> Maybe UUID
UUID.fromString (String -> Maybe UUID) -> App String -> App (Maybe UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
bill Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)

      -- Claim handle correctly for alice
      Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
putHandle Value
alice String
handleA 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
      Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
putHandle Value
carl String
handleC 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

      -- Claim handle by hacking into the DB for others. There seems to be no
      -- other way of testing this edge case
      let PrepQuery W (Text, UUID) ()
assignHandleQuery :: PrepQuery W (Text, UUID) () = String -> PrepQuery W (Text, UUID) ()
forall a. IsString a => String -> a
fromString (String -> PrepQuery W (Text, UUID) ())
-> String -> PrepQuery W (Text, UUID) ()
forall a b. (a -> b) -> a -> b
$ String
"UPDATE " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
brigKeyspace String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".user SET handle = ? WHERE id = ?"
      PrepQuery W (Text, UUID) () -> QueryParams (Text, UUID) -> App ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Text, UUID) ()
assignHandleQuery (QueryParams (Text, UUID) -> App ())
-> QueryParams (Text, UUID) -> App ()
forall a b. (a -> b) -> a -> b
$ Consistency -> (Text, UUID) -> QueryParams (Text, UUID)
forall a. Consistency -> a -> QueryParams a
defQueryParams Consistency
LocalQuorum (String -> Text
Text.pack String
handleA, UUID
annaId)
      PrepQuery W (Text, UUID) () -> QueryParams (Text, UUID) -> App ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Text, UUID) ()
assignHandleQuery (QueryParams (Text, UUID) -> App ())
-> QueryParams (Text, UUID) -> App ()
forall a b. (a -> b) -> a -> b
$ Consistency -> (Text, UUID) -> QueryParams (Text, UUID)
forall a. Consistency -> a -> QueryParams a
defQueryParams Consistency
LocalQuorum (String -> Text
Text.pack String
handleB, UUID
bobId)
      PrepQuery W (Text, UUID) () -> QueryParams (Text, UUID) -> App ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Text, UUID) ()
assignHandleQuery (QueryParams (Text, UUID) -> App ())
-> QueryParams (Text, UUID) -> App ()
forall a b. (a -> b) -> a -> b
$ Consistency -> (Text, UUID) -> QueryParams (Text, UUID)
forall a. Consistency -> a -> QueryParams a
defQueryParams Consistency
LocalQuorum (String -> Text
Text.pack String
handleB, UUID
billId)

      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
handleA)
      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
anna (String -> Maybe String
forall a. a -> Maybe a
Just String
handleA)
      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
bob (String -> Maybe String
forall a. a -> Maybe a
Just String
handleB)
      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
bill (String -> Maybe String
forall a. a -> Maybe a
Just String
handleB)
      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
carl (String -> Maybe String
forall a. a -> Maybe a
Just String
handleC)

      pure (Value
alice, Value
anna, Value
bob, Value
bill, Value
carl)

    -- Start Phase 5 here so that we can claim the same handle for Dan as Doug
    -- but in Postgresql. The production scenario can only happen due to a race
    -- condition. This is just a more precise way of causing the DB
    -- inconsistency.
    Value
creed <- 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
backend ServiceOverrides
phase5Overrides) ((String -> App Value) -> App Value)
-> (String -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      Value
creed <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
putHandle Value
creed String
handleC 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
      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
creed (String -> Maybe String
forall a. a -> Maybe a
Just String
handleC)
      pure Value
creed

    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
backend ServiceOverrides
phase3Overrides) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      HasCallStack => String -> String -> App ()
String -> String -> App ()
waitForMigration String
domain String
userMigrationFinishedCounterName
      HasCallStack => String -> String -> App ()
String -> String -> App ()
assertMigrationSuccessful String
domain String
"^wire_users_migration_failed"

    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
backend ServiceOverrides
phase5Overrides) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
alice (String -> Maybe String
forall a. a -> Maybe a
Just String
handleA)
      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
anna Maybe String
forall a. Maybe a
Nothing

      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
bob Maybe String
forall a. Maybe a
Nothing
      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
bill Maybe String
forall a. Maybe a
Nothing

      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
carl Maybe String
forall a. Maybe a
Nothing
      HasCallStack => Value -> Maybe String -> App ()
Value -> Maybe String -> App ()
assertHandle Value
creed (String -> Maybe String
forall a. a -> Maybe a
Just String
handleC)

      -- handleA cannot be claimed
      Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
putHandle Value
anna String
handleA 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
409

      -- handleB can be claimed
      Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
putHandle Value
bob String
handleB 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

      -- handleC cannot be claimed
      Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
putHandle Value
carl String
handleC 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
409
  where
    assertHandle :: (HasCallStack) => Value -> Maybe String -> App ()
    assertHandle :: HasCallStack => Value -> Maybe String -> App ()
assertHandle Value
user Maybe String
expectedHandle = do
      Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
user App Response -> (Response -> App ()) -> App ()
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
        case Maybe String
expectedHandle of
          Just String
h ->
            Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
h
          Maybe String
Nothing ->
            case Response
resp.json of
              Just (Object KeyMap Value
o) -> KeyMap Value -> [Key]
forall v. KeyMap v -> [Key]
KM.keys KeyMap Value
o [Key] -> [Key] -> App ()
forall a. (Eq a, Show a, HasCallStack) => [a] -> [a] -> App ()
`shouldNotContain` [String -> Key
forall a. IsString a => String -> a
fromString String
"handle"]
              Maybe Value
_ -> String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"Unexpected body for getSelf"

testMigrationOfInvalidUsers :: (HasCallStack) => App ()
testMigrationOfInvalidUsers :: HasCallStack => App ()
testMigrationOfInvalidUsers = do
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)

  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
backend] -> do
    let domain :: String
domain = BackendResource
backend.berDomain
        brigKeyspace :: String
brigKeyspace = BackendResource
backend.berBrigKeyspace
    (Value
validUser, Value
noName, UUID
noNameId, Value
noActivated, UUID
noActivatedId) <- 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
backend ServiceOverrides
phase1Overrides) ((String -> App (Value, Value, UUID, Value, UUID))
 -> App (Value, Value, UUID, Value, UUID))
-> (String -> App (Value, Value, UUID, Value, UUID))
-> App (Value, Value, UUID, Value, UUID)
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      Value
validUser <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def

      Value
noName <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      Just UUID
noNameId <- String -> Maybe UUID
UUID.fromString (String -> Maybe UUID) -> App String -> App (Maybe UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
noName Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)

      Value
noActivated <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      Just UUID
noActivatedId <- String -> Maybe UUID
UUID.fromString (String -> Maybe UUID) -> App String -> App (Maybe UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
noActivated Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)

      -- Cause users to be invalid by poking into Cassandra
      let PrepQuery W (Identity UUID) ()
removeName :: PrepQuery W (Identity UUID) () = String -> PrepQuery W (Identity UUID) ()
forall a. IsString a => String -> a
fromString (String -> PrepQuery W (Identity UUID) ())
-> String -> PrepQuery W (Identity UUID) ()
forall a b. (a -> b) -> a -> b
$ String
"UPDATE " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
brigKeyspace String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".user SET name = NULL WHERE id = ?"
          PrepQuery W (Identity UUID) ()
removeActivated :: PrepQuery W (Identity UUID) () = String -> PrepQuery W (Identity UUID) ()
forall a. IsString a => String -> a
fromString (String -> PrepQuery W (Identity UUID) ())
-> String -> PrepQuery W (Identity UUID) ()
forall a b. (a -> b) -> a -> b
$ String
"UPDATE " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
brigKeyspace String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".user SET activated = NULL WHERE id = ?"
      PrepQuery W (Identity UUID) ()
-> QueryParams (Identity UUID) -> App ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity UUID) ()
removeName (QueryParams (Identity UUID) -> App ())
-> QueryParams (Identity UUID) -> App ()
forall a b. (a -> b) -> a -> b
$ Consistency -> Identity UUID -> QueryParams (Identity UUID)
forall a. Consistency -> a -> QueryParams a
defQueryParams Consistency
LocalQuorum (UUID -> Identity UUID
forall a. a -> Identity a
Identity UUID
noNameId)
      PrepQuery W (Identity UUID) ()
-> QueryParams (Identity UUID) -> App ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity UUID) ()
removeActivated (QueryParams (Identity UUID) -> App ())
-> QueryParams (Identity UUID) -> App ()
forall a b. (a -> b) -> a -> b
$ Consistency -> Identity UUID -> QueryParams (Identity UUID)
forall a. Consistency -> a -> QueryParams a
defQueryParams Consistency
LocalQuorum (UUID -> Identity UUID
forall a. a -> Identity a
Identity UUID
noActivatedId)

      Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
validUser 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
      Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
noName 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
500
      Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
noActivated 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
500

      pure (Value
validUser, Value
noName, UUID
noNameId, Value
noActivated, UUID
noActivatedId)

    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
backend ServiceOverrides
phase3Overrides) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      HasCallStack => String -> String -> App ()
String -> String -> App ()
waitForMigration String
domain String
userMigrationFinishedCounterName

    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
backend ServiceOverrides
phase5Overrides) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
validUser 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
      Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
noName 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
404
      Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
noActivated 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
404

    -- Delete invalid users from cassandra so they don't trip other tests. These
    -- other tests are usually reindexing the users, the reindex code doesn't
    -- deal with invalid users so well.
    let PrepQuery W (Identity UUID) ()
deleteUserRow :: PrepQuery W (Identity UUID) () = String -> PrepQuery W (Identity UUID) ()
forall a. IsString a => String -> a
fromString (String -> PrepQuery W (Identity UUID) ())
-> String -> PrepQuery W (Identity UUID) ()
forall a b. (a -> b) -> a -> b
$ String
"DELETE FROM " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
brigKeyspace String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".user WHERE id = ?"
    PrepQuery W (Identity UUID) ()
-> QueryParams (Identity UUID) -> App ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity UUID) ()
deleteUserRow (QueryParams (Identity UUID) -> App ())
-> QueryParams (Identity UUID) -> App ()
forall a b. (a -> b) -> a -> b
$ Consistency -> Identity UUID -> QueryParams (Identity UUID)
forall a. Consistency -> a -> QueryParams a
defQueryParams Consistency
LocalQuorum (UUID -> Identity UUID
forall a. a -> Identity a
Identity UUID
noNameId)
    PrepQuery W (Identity UUID) ()
-> QueryParams (Identity UUID) -> App ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity UUID) ()
deleteUserRow (QueryParams (Identity UUID) -> App ())
-> QueryParams (Identity UUID) -> App ()
forall a b. (a -> b) -> a -> b
$ Consistency -> Identity UUID -> QueryParams (Identity UUID)
forall a. Consistency -> a -> QueryParams a
defQueryParams Consistency
LocalQuorum (UUID -> Identity UUID
forall a. a -> Identity a
Identity UUID
noActivatedId)

-- * Test Helpers

data TestUsersByOperations = TestUsersByOperations
  { TestUsersByOperations -> IntMap TestUserList
updates :: IntMap TestUserList,
    TestUsersByOperations -> IntMap TestUserList
deletes :: IntMap TestUserList
  }
  deriving (Int -> TestUsersByOperations -> String -> String
[TestUsersByOperations] -> String -> String
TestUsersByOperations -> String
(Int -> TestUsersByOperations -> String -> String)
-> (TestUsersByOperations -> String)
-> ([TestUsersByOperations] -> String -> String)
-> Show TestUsersByOperations
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestUsersByOperations -> String -> String
showsPrec :: Int -> TestUsersByOperations -> String -> String
$cshow :: TestUsersByOperations -> String
show :: TestUsersByOperations -> String
$cshowList :: [TestUsersByOperations] -> String -> String
showList :: [TestUsersByOperations] -> String -> String
Show, TestUsersByOperations -> TestUsersByOperations -> Bool
(TestUsersByOperations -> TestUsersByOperations -> Bool)
-> (TestUsersByOperations -> TestUsersByOperations -> Bool)
-> Eq TestUsersByOperations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestUsersByOperations -> TestUsersByOperations -> Bool
== :: TestUsersByOperations -> TestUsersByOperations -> Bool
$c/= :: TestUsersByOperations -> TestUsersByOperations -> Bool
/= :: TestUsersByOperations -> TestUsersByOperations -> Bool
Eq, (forall x. TestUsersByOperations -> Rep TestUsersByOperations x)
-> (forall x. Rep TestUsersByOperations x -> TestUsersByOperations)
-> Generic TestUsersByOperations
forall x. Rep TestUsersByOperations x -> TestUsersByOperations
forall x. TestUsersByOperations -> Rep TestUsersByOperations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestUsersByOperations -> Rep TestUsersByOperations x
from :: forall x. TestUsersByOperations -> Rep TestUsersByOperations x
$cto :: forall x. Rep TestUsersByOperations x -> TestUsersByOperations
to :: forall x. Rep TestUsersByOperations x -> TestUsersByOperations
Generic)

instance Semigroup TestUsersByOperations where
  TestUsersByOperations
users1 <> :: TestUsersByOperations
-> TestUsersByOperations -> TestUsersByOperations
<> TestUsersByOperations
users2 =
    TestUsersByOperations
      { updates :: IntMap TestUserList
updates = TestUsersByOperations
users1.updates IntMap TestUserList -> IntMap TestUserList -> IntMap TestUserList
forall a. Semigroup a => a -> a -> a
<> TestUsersByOperations
users2.updates,
        deletes :: IntMap TestUserList
deletes = TestUsersByOperations
users1.deletes IntMap TestUserList -> IntMap TestUserList -> IntMap TestUserList
forall a. Semigroup a => a -> a -> a
<> TestUsersByOperations
users2.deletes
      }

instance Monoid TestUsersByOperations where
  mempty :: TestUsersByOperations
mempty = TestUsersByOperations {updates :: IntMap TestUserList
updates = IntMap TestUserList
forall a. Monoid a => a
mempty, deletes :: IntMap TestUserList
deletes = IntMap TestUserList
forall a. Monoid a => a
mempty}

instance ToJSON TestUsersByOperations

data TestUserList = TestUserList
  { TestUserList -> TestScimUsers
scimUsersWithRichInfo :: TestScimUsers,
    TestUserList -> TestScimUsers
scimUsersWithoutRichInfo :: TestScimUsers,
    TestUserList -> TestScimUsers
pendingScimUsers :: TestScimUsers,
    TestUserList -> TestTeamUsers
ssoUsers :: TestTeamUsers,
    TestUserList -> TestTeamUsers
passwordTeamUsers :: TestTeamUsers,
    TestUserList -> Map String (Value, Maybe String)
personalUsersWithoutHandle :: Map String (Value, Maybe String),
    TestUserList -> Map String (Value, Maybe String)
personalUsersWithHandle :: Map String (Value, Maybe String),
    TestUserList -> TestTeamUsers
botsInTeamConvs :: TestTeamUsers,
    -- UserId -> (User, Conv)
    TestUserList -> Map String (Value, Value)
botsInPersonalConvs :: Map String (Value, Value)
  }
  deriving (Int -> TestUserList -> String -> String
[TestUserList] -> String -> String
TestUserList -> String
(Int -> TestUserList -> String -> String)
-> (TestUserList -> String)
-> ([TestUserList] -> String -> String)
-> Show TestUserList
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestUserList -> String -> String
showsPrec :: Int -> TestUserList -> String -> String
$cshow :: TestUserList -> String
show :: TestUserList -> String
$cshowList :: [TestUserList] -> String -> String
showList :: [TestUserList] -> String -> String
Show, TestUserList -> TestUserList -> Bool
(TestUserList -> TestUserList -> Bool)
-> (TestUserList -> TestUserList -> Bool) -> Eq TestUserList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestUserList -> TestUserList -> Bool
== :: TestUserList -> TestUserList -> Bool
$c/= :: TestUserList -> TestUserList -> Bool
/= :: TestUserList -> TestUserList -> Bool
Eq)

data TestScimUsers = TestScimUsers
  { TestScimUsers -> Value
owner :: Value,
    TestScimUsers -> String
token :: String,
    -- | ScimUser, Password, UserOrInv
    TestScimUsers -> Map String (Value, String, Value)
users :: Map String (Value, String, Value)
  }
  deriving (Int -> TestScimUsers -> String -> String
[TestScimUsers] -> String -> String
TestScimUsers -> String
(Int -> TestScimUsers -> String -> String)
-> (TestScimUsers -> String)
-> ([TestScimUsers] -> String -> String)
-> Show TestScimUsers
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestScimUsers -> String -> String
showsPrec :: Int -> TestScimUsers -> String -> String
$cshow :: TestScimUsers -> String
show :: TestScimUsers -> String
$cshowList :: [TestScimUsers] -> String -> String
showList :: [TestScimUsers] -> String -> String
Show, TestScimUsers -> TestScimUsers -> Bool
(TestScimUsers -> TestScimUsers -> Bool)
-> (TestScimUsers -> TestScimUsers -> Bool) -> Eq TestScimUsers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestScimUsers -> TestScimUsers -> Bool
== :: TestScimUsers -> TestScimUsers -> Bool
$c/= :: TestScimUsers -> TestScimUsers -> Bool
/= :: TestScimUsers -> TestScimUsers -> Bool
Eq)

data TestTeamUsers = TestTeamUsers
  { TestTeamUsers -> Value
owner :: Value,
    -- | (user, maybe password)
    TestTeamUsers -> Map String (Value, Maybe String)
users :: Map String (Value, Maybe String)
  }
  deriving (Int -> TestTeamUsers -> String -> String
[TestTeamUsers] -> String -> String
TestTeamUsers -> String
(Int -> TestTeamUsers -> String -> String)
-> (TestTeamUsers -> String)
-> ([TestTeamUsers] -> String -> String)
-> Show TestTeamUsers
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestTeamUsers -> String -> String
showsPrec :: Int -> TestTeamUsers -> String -> String
$cshow :: TestTeamUsers -> String
show :: TestTeamUsers -> String
$cshowList :: [TestTeamUsers] -> String -> String
showList :: [TestTeamUsers] -> String -> String
Show, TestTeamUsers -> TestTeamUsers -> Bool
(TestTeamUsers -> TestTeamUsers -> Bool)
-> (TestTeamUsers -> TestTeamUsers -> Bool) -> Eq TestTeamUsers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestTeamUsers -> TestTeamUsers -> Bool
== :: TestTeamUsers -> TestTeamUsers -> Bool
$c/= :: TestTeamUsers -> TestTeamUsers -> Bool
/= :: TestTeamUsers -> TestTeamUsers -> Bool
Eq)

instance ToJSON TestUserList where
  toJSON :: TestUserList -> Value
toJSON TestUserList
userList = do
    [Pair] -> Value
object
      [ String -> String
forall a. IsString a => String -> a
fromString String
"scimUsersWithRichInfo" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Map String (Value, String, Value) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
userList.scimUsersWithRichInfo.users,
        String -> String
forall a. IsString a => String -> a
fromString String
"scimUsersWithoutRichInfo" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Map String (Value, String, Value) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
userList.scimUsersWithoutRichInfo.users,
        String -> String
forall a. IsString a => String -> a
fromString String
"pendingScimUsers" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Map String (Value, String, Value) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
userList.pendingScimUsers.users,
        String -> String
forall a. IsString a => String -> a
fromString String
"ssoUsers" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Map String (Value, Maybe String) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
userList.ssoUsers.users,
        String -> String
forall a. IsString a => String -> a
fromString String
"passwordTeamUsers" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Map String (Value, Maybe String) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
userList.passwordTeamUsers.users,
        String -> String
forall a. IsString a => String -> a
fromString String
"personalUsersWithoutHandle" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Map String (Value, Maybe String) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
userList.personalUsersWithoutHandle,
        String -> String
forall a. IsString a => String -> a
fromString String
"personalUsersWithHandle" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Map String (Value, Maybe String) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
userList.personalUsersWithHandle,
        String -> String
forall a. IsString a => String -> a
fromString String
"botsInTeamConvs" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Map String (Value, Maybe String) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
userList.botsInTeamConvs.users,
        String -> String
forall a. IsString a => String -> a
fromString String
"botsInPersonalConvs" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Map String (Value, Value) -> [String]
forall k a. Map k a -> [k]
Map.keys TestUserList
userList.botsInPersonalConvs
      ]

data UserUpdate
  = UpdateName String
  | UpdateHandle String
  | UpdateEmail String
  | UpdatePassword String
  deriving (Int -> UserUpdate -> String -> String
[UserUpdate] -> String -> String
UserUpdate -> String
(Int -> UserUpdate -> String -> String)
-> (UserUpdate -> String)
-> ([UserUpdate] -> String -> String)
-> Show UserUpdate
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UserUpdate -> String -> String
showsPrec :: Int -> UserUpdate -> String -> String
$cshow :: UserUpdate -> String
show :: UserUpdate -> String
$cshowList :: [UserUpdate] -> String -> String
showList :: [UserUpdate] -> String -> String
Show, UserUpdate -> UserUpdate -> Bool
(UserUpdate -> UserUpdate -> Bool)
-> (UserUpdate -> UserUpdate -> Bool) -> Eq UserUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserUpdate -> UserUpdate -> Bool
== :: UserUpdate -> UserUpdate -> Bool
$c/= :: UserUpdate -> UserUpdate -> Bool
/= :: UserUpdate -> UserUpdate -> Bool
Eq, (forall x. UserUpdate -> Rep UserUpdate x)
-> (forall x. Rep UserUpdate x -> UserUpdate) -> Generic UserUpdate
forall x. Rep UserUpdate x -> UserUpdate
forall x. UserUpdate -> Rep UserUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserUpdate -> Rep UserUpdate x
from :: forall x. UserUpdate -> Rep UserUpdate x
$cto :: forall x. Rep UserUpdate x -> UserUpdate
to :: forall x. Rep UserUpdate x -> UserUpdate
Generic)

instance Arbitrary UserUpdate where
  arbitrary :: Gen UserUpdate
arbitrary =
    [Gen UserUpdate] -> Gen UserUpdate
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ String -> UserUpdate
UpdateName (String -> UserUpdate) -> Gen String -> Gen UserUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryName,
        String -> UserUpdate
UpdateHandle (String -> UserUpdate) -> Gen String -> Gen UserUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryHandle,
        String -> UserUpdate
UpdateEmail (String -> UserUpdate) -> Gen String -> Gen UserUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryEmail,
        String -> UserUpdate
UpdatePassword (String -> UserUpdate) -> Gen String -> Gen UserUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryPassword
      ]

instance ToJSON UserUpdate

arbitraryNonPasswordUpdate :: Gen UserUpdate
arbitraryNonPasswordUpdate :: Gen UserUpdate
arbitraryNonPasswordUpdate =
  [Gen UserUpdate] -> Gen UserUpdate
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ String -> UserUpdate
UpdateName (String -> UserUpdate) -> Gen String -> Gen UserUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryName,
      String -> UserUpdate
UpdateHandle (String -> UserUpdate) -> Gen String -> Gen UserUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryHandle,
      String -> UserUpdate
UpdateEmail (String -> UserUpdate) -> Gen String -> Gen UserUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryEmail
    ]

data PendingScimUpdate
  = RegisterPendingScimUser
  | UpdatePendingScimUser UserUpdate
  deriving (Int -> PendingScimUpdate -> String -> String
[PendingScimUpdate] -> String -> String
PendingScimUpdate -> String
(Int -> PendingScimUpdate -> String -> String)
-> (PendingScimUpdate -> String)
-> ([PendingScimUpdate] -> String -> String)
-> Show PendingScimUpdate
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PendingScimUpdate -> String -> String
showsPrec :: Int -> PendingScimUpdate -> String -> String
$cshow :: PendingScimUpdate -> String
show :: PendingScimUpdate -> String
$cshowList :: [PendingScimUpdate] -> String -> String
showList :: [PendingScimUpdate] -> String -> String
Show, PendingScimUpdate -> PendingScimUpdate -> Bool
(PendingScimUpdate -> PendingScimUpdate -> Bool)
-> (PendingScimUpdate -> PendingScimUpdate -> Bool)
-> Eq PendingScimUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PendingScimUpdate -> PendingScimUpdate -> Bool
== :: PendingScimUpdate -> PendingScimUpdate -> Bool
$c/= :: PendingScimUpdate -> PendingScimUpdate -> Bool
/= :: PendingScimUpdate -> PendingScimUpdate -> Bool
Eq, (forall x. PendingScimUpdate -> Rep PendingScimUpdate x)
-> (forall x. Rep PendingScimUpdate x -> PendingScimUpdate)
-> Generic PendingScimUpdate
forall x. Rep PendingScimUpdate x -> PendingScimUpdate
forall x. PendingScimUpdate -> Rep PendingScimUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PendingScimUpdate -> Rep PendingScimUpdate x
from :: forall x. PendingScimUpdate -> Rep PendingScimUpdate x
$cto :: forall x. Rep PendingScimUpdate x -> PendingScimUpdate
to :: forall x. Rep PendingScimUpdate x -> PendingScimUpdate
Generic)

instance Arbitrary PendingScimUpdate where
  arbitrary :: Gen PendingScimUpdate
arbitrary =
    [Gen PendingScimUpdate] -> Gen PendingScimUpdate
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ PendingScimUpdate -> Gen PendingScimUpdate
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PendingScimUpdate
RegisterPendingScimUser,
        UserUpdate -> PendingScimUpdate
UpdatePendingScimUser (UserUpdate -> PendingScimUpdate)
-> Gen UserUpdate -> Gen PendingScimUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UserUpdate
arbitraryNonPasswordUpdate
      ]

instance ToJSON PendingScimUpdate

data PhaseUpdates = PhaseUpdates
  { PhaseUpdates -> [UserUpdate]
scimUsersWithRichInfo :: [UserUpdate],
    PhaseUpdates -> [UserUpdate]
scimUsersWithoutRichInfo :: [UserUpdate],
    PhaseUpdates -> [PendingScimUpdate]
pendingScimUsers :: [PendingScimUpdate],
    PhaseUpdates -> [UserUpdate]
ssoUsers :: [UserUpdate],
    PhaseUpdates -> [UserUpdate]
passwordTeamUsers :: [UserUpdate],
    PhaseUpdates -> [UserUpdate]
personalUsersWithoutHandle :: [UserUpdate],
    PhaseUpdates -> [UserUpdate]
personalUsersWithHandle :: [UserUpdate]
  }
  deriving (Int -> PhaseUpdates -> String -> String
[PhaseUpdates] -> String -> String
PhaseUpdates -> String
(Int -> PhaseUpdates -> String -> String)
-> (PhaseUpdates -> String)
-> ([PhaseUpdates] -> String -> String)
-> Show PhaseUpdates
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PhaseUpdates -> String -> String
showsPrec :: Int -> PhaseUpdates -> String -> String
$cshow :: PhaseUpdates -> String
show :: PhaseUpdates -> String
$cshowList :: [PhaseUpdates] -> String -> String
showList :: [PhaseUpdates] -> String -> String
Show, PhaseUpdates -> PhaseUpdates -> Bool
(PhaseUpdates -> PhaseUpdates -> Bool)
-> (PhaseUpdates -> PhaseUpdates -> Bool) -> Eq PhaseUpdates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhaseUpdates -> PhaseUpdates -> Bool
== :: PhaseUpdates -> PhaseUpdates -> Bool
$c/= :: PhaseUpdates -> PhaseUpdates -> Bool
/= :: PhaseUpdates -> PhaseUpdates -> Bool
Eq, (forall x. PhaseUpdates -> Rep PhaseUpdates x)
-> (forall x. Rep PhaseUpdates x -> PhaseUpdates)
-> Generic PhaseUpdates
forall x. Rep PhaseUpdates x -> PhaseUpdates
forall x. PhaseUpdates -> Rep PhaseUpdates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PhaseUpdates -> Rep PhaseUpdates x
from :: forall x. PhaseUpdates -> Rep PhaseUpdates x
$cto :: forall x. Rep PhaseUpdates x -> PhaseUpdates
to :: forall x. Rep PhaseUpdates x -> PhaseUpdates
Generic)

instance ToJSON PhaseUpdates

arbitraryPhaseUpdates :: Int -> Gen PhaseUpdates
arbitraryPhaseUpdates :: Int -> Gen PhaseUpdates
arbitraryPhaseUpdates Int
n = do
  [UserUpdate]
scimUsersWithRichInfo <- Int -> Gen UserUpdate -> Gen [UserUpdate]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen UserUpdate
forall a. Arbitrary a => Gen a
arbitrary
  [UserUpdate]
scimUsersWithoutRichInfo <- Int -> Gen UserUpdate -> Gen [UserUpdate]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen UserUpdate
forall a. Arbitrary a => Gen a
arbitrary
  [PendingScimUpdate]
pendingScimUsers <- Int -> Gen PendingScimUpdate -> Gen [PendingScimUpdate]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen PendingScimUpdate
forall a. Arbitrary a => Gen a
arbitrary
  [UserUpdate]
ssoUsers <- Int -> Gen UserUpdate -> Gen [UserUpdate]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen UserUpdate
arbitraryNonPasswordUpdate
  [UserUpdate]
passwordTeamUsers <- Int -> Gen UserUpdate -> Gen [UserUpdate]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen UserUpdate
forall a. Arbitrary a => Gen a
arbitrary
  [UserUpdate]
personalUsersWithoutHandle <- Int -> Gen UserUpdate -> Gen [UserUpdate]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen UserUpdate
forall a. Arbitrary a => Gen a
arbitrary
  [UserUpdate]
personalUsersWithHandle <- Int -> Gen UserUpdate -> Gen [UserUpdate]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen UserUpdate
forall a. Arbitrary a => Gen a
arbitrary
  pure PhaseUpdates {[PendingScimUpdate]
[UserUpdate]
scimUsersWithRichInfo :: [UserUpdate]
scimUsersWithoutRichInfo :: [UserUpdate]
pendingScimUsers :: [PendingScimUpdate]
ssoUsers :: [UserUpdate]
passwordTeamUsers :: [UserUpdate]
personalUsersWithoutHandle :: [UserUpdate]
personalUsersWithHandle :: [UserUpdate]
scimUsersWithRichInfo :: [UserUpdate]
scimUsersWithoutRichInfo :: [UserUpdate]
pendingScimUsers :: [PendingScimUpdate]
ssoUsers :: [UserUpdate]
passwordTeamUsers :: [UserUpdate]
personalUsersWithoutHandle :: [UserUpdate]
personalUsersWithHandle :: [UserUpdate]
..}

userMigrationFinishedCounterName :: String
userMigrationFinishedCounterName :: String
userMigrationFinishedCounterName = String
"^wire_users_migration_finished"

commonOverrides, phase1Overrides, phase2Overrides, phase3Overrides, phase4Overrides, phase5Overrides :: ServiceOverrides
commonOverrides :: ServiceOverrides
commonOverrides =
  ServiceOverrides
forall a. Default a => a
def
    { brigCfg =
        setField @_ @Int "optSettings.setUserMaxConnections" 500
          >=> setField @_ @Int "optSettings.setActivationTimeout" 3600
          >=> setField @_ @Int "optSettings.setVerificationTimeout" 3600
          >=> setField @_ @Int "optSettings.setTeamInvitationTimeout" 3600
          >=> setField @_ @Int "optSettings.setUserCookieRenewAge" 1209600
          >=> setField @_ @Int "postgresqlPool.size" 200
          >=> removeField "optSettings.setSuspendInactiveUsers"
    }
phase1Overrides :: ServiceOverrides
phase1Overrides =
  ServiceOverrides
commonOverrides
    ServiceOverrides -> ServiceOverrides -> ServiceOverrides
forall a. Semigroup a => a -> a -> a
<> ServiceOverrides
forall a. Default a => a
def
      { brigCfg = setField "postgresMigration.user" "cassandra",
        galleyCfg = setField "postgresMigration.user" "cassandra",
        backgroundWorkerCfg =
          setField "postgresMigration.user" "cassandra"
            >=> setField "migrateUsers" False
      }
phase2Overrides :: ServiceOverrides
phase2Overrides =
  ServiceOverrides
commonOverrides
    ServiceOverrides -> ServiceOverrides -> ServiceOverrides
forall a. Semigroup a => a -> a -> a
<> ServiceOverrides
forall a. Default a => a
def
      { brigCfg = setField "postgresMigration.user" "migration-to-postgresql",
        galleyCfg = setField "postgresMigration.user" "migration-to-postgresql",
        backgroundWorkerCfg =
          setField "postgresMigration.user" "migration-to-postgresql"
            >=> setField "migrateUsers" False
      }
phase3Overrides :: ServiceOverrides
phase3Overrides =
  ServiceOverrides
commonOverrides
    ServiceOverrides -> ServiceOverrides -> ServiceOverrides
forall a. Semigroup a => a -> a -> a
<> ServiceOverrides
forall a. Default a => a
def
      { brigCfg = setField "postgresMigration.user" "migration-to-postgresql",
        galleyCfg = setField "postgresMigration.user" "migration-to-postgresql",
        backgroundWorkerCfg =
          setField "postgresMigration.user" "migration-to-postgresql"
            >=> setField "migrateUsers" True
      }
phase4Overrides :: ServiceOverrides
phase4Overrides =
  ServiceOverrides
commonOverrides
    ServiceOverrides -> ServiceOverrides -> ServiceOverrides
forall a. Semigroup a => a -> a -> a
<> ServiceOverrides
forall a. Default a => a
def
      { brigCfg = setField "postgresMigration.user" "migration-to-postgresql",
        galleyCfg = setField "postgresMigration.user" "migration-to-postgresql",
        backgroundWorkerCfg =
          setField "postgresMigration.user" "migration-to-postgresql"
            >=> setField "migrateUsers" False
      }
phase5Overrides :: ServiceOverrides
phase5Overrides =
  ServiceOverrides
commonOverrides
    ServiceOverrides -> ServiceOverrides -> ServiceOverrides
forall a. Semigroup a => a -> a -> a
<> ServiceOverrides
forall a. Default a => a
def
      { brigCfg = setField "postgresMigration.user" "postgresql",
        galleyCfg = setField "postgresMigration.user" "postgresql",
        backgroundWorkerCfg =
          setField "postgresMigration.user" "postgresql"
            >=> setField "migrateUsers" 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)
    ]