{-# OPTIONS -Wno-ambiguous-fields #-}
-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2024 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Test.Teams where

import API.Brig
import qualified API.BrigInternal as I
import API.Common
import API.Galley (deleteTeamMember, getTeam, getTeamMembers, getTeamMembersCsv, getTeamNotifications)
import API.GalleyInternal (selectTeamMembers)
import qualified API.GalleyInternal as I
import API.Gundeck
import qualified API.Nginz as Nginz
import Control.Monad.Codensity (Codensity (runCodensity))
import Control.Monad.Extra (findM)
import Control.Monad.Reader (asks)
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Time.Clock
import Data.Time.Format
import Notifications
import SetupHelpers
import Testlib.JSON
import Testlib.Prelude
import Testlib.ResourcePool (acquireResources)

testInvitePersonalUserToTeam :: (HasCallStack) => App ()
testInvitePersonalUserToTeam :: HasCallStack => App ()
testInvitePersonalUserToTeam = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
testBackend] -> do
    let domain :: String
domain = BackendResource
testBackend.berDomain
    (owner, tid, tm) <- 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
testBackend ServiceOverrides
forall a. Default a => a
def) ((String -> App (Value, String, Value))
 -> App (Value, String, Value))
-> (String -> App (Value, String, Value))
-> App (Value, String, Value)
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      (owner, tid, tm : _) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
2
      pure (owner, tid, tm)

    runCodensity
      ( startDynamicBackend
          testBackend
          (def {galleyCfg = setField "settings.exposeInvitationURLsTeamAllowlist" [tid]})
      )
      $ \String
_ -> do
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
listInvitations Value
owner String
tid) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
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
          Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"invitations" App Value -> [()] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [()])

        ownerId <- Value
owner 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
        I.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" >>= assertSuccess
        user <- I.createUser domain def >>= getJSON 201
        uid <- user %. "id" >>= asString
        email <- user %. "email" >>= asString

        inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201
        checkListInvitations owner tid email
        code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
        inv %. "url" & asString >>= assertUrlContainsCode code
        bindResponse (getInvitationByCode user code) $ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          ownersEmail <- Value
owner 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
          resp.json %. "created_by_email" `shouldMatch` ownersEmail
        acceptTeamInvitation user code Nothing >>= assertStatus 400
        acceptTeamInvitation user code (Just "wrong-password") >>= assertStatus 403

        withWebSockets [owner, user, tm] $ \wss :: [WebSocket]
wss@[WebSocket
wsOwner, WebSocket
_, WebSocket
_] -> do
          Value -> String -> Maybe String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> Maybe String -> App Response
acceptTeamInvitation Value
user String
code (String -> Maybe String
forall a. a -> Maybe a
Just String
defPassword) 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

          -- When the team is smaller than fanout limit, all members get this
          -- notification.
          [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
            updateNotif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isUserUpdatedNotif WebSocket
ws
            updateNotif %. "payload.0.user.team" `shouldMatch` tid

          -- Admins get a team.member-join notif on the websocket for
          -- team-settings
          memberJobNotif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isTeamMemberJoinNotif WebSocket
wsOwner
          memberJobNotif %. "payload.0.team" `shouldMatch` tid
          memberJobNotif %. "payload.0.data.user" `shouldMatch` objId user

        bindResponse (getSelf user) $ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid

        -- a team member can now find the former personal user in the team
        bindResponse (getTeamMembers tm tid) $ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
          ids <- for members ((%. "user") >=> asString)
          ids `shouldContain` [uid]

        -- the former personal user can now see other team members
        bindResponse (getTeamMembers user tid) $ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
          ids <- for members ((%. "user") >=> asString)
          tmId <- tm %. "id" & asString
          ids `shouldContain` [ownerId]
          ids `shouldContain` [tmId]

        -- the former personal user can now search for the owner
        bindResponse (searchContacts user (owner %. "name") domain) $ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          documents <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"documents" App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
          ids <- for documents ((%. "id") >=> asString)
          ids `shouldContain` [ownerId]

        I.refreshIndex domain
        -- a team member can now search for the former personal user
        bindResponse (searchContacts tm (user %. "name") domain) $ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          document <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"documents" App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> 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
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
          document %. "id" `shouldMatch` uid
          document %. "team" `shouldMatch` tid
  where
    checkListInvitations :: Value -> String -> String -> App ()
    checkListInvitations :: Value -> String -> String -> App ()
checkListInvitations Value
owner String
tid String
email = do
      newUserEmail <- App String
randomEmail
      inv <- postInvitation owner (PostInvitation (Just newUserEmail) Nothing) >>= getJSON 201
      code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
      bindResponse (getInvitationByCode owner code) $ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"created_by_email" App (Maybe Value) -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe Value
forall a. Maybe a
Nothing :: Maybe Value)
      bindResponse (listInvitations owner tid) $ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        invitations <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"invitations" App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList

        -- personal user invitations have a different invitation URL than non-existing user invitations
        newUserInv <- invitations & findM (\Value
i -> (Value
i Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" 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) App String -> (String -> Bool) -> App Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
newUserEmail))
        newUserInvUrl <- newUserInv %. "url" & asString
        newUserInvUrl `shouldContainString` "/register"

        personalUserInv <- invitations & findM (\Value
i -> (Value
i Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" 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) App String -> (String -> Bool) -> App Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
email))
        personalUserInvUrl <- personalUserInv %. "url" & asString
        personalUserInvUrl `shouldContainString` "/accept-invitation"

    assertUrlContainsCode :: (HasCallStack) => String -> String -> App ()
    assertUrlContainsCode :: HasCallStack => String -> String -> App ()
assertUrlContainsCode String
code String
url = do
      queryParam <- String
url String -> (String -> App String) -> App String
forall a b. a -> (a -> b) -> b
& String -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString App String
-> (String -> Maybe (Maybe String)) -> App (Maybe (Maybe String))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> String -> Maybe (Maybe String)
getQueryParam String
"team-code"
      queryParam `shouldMatch` Just (Just code)

testInvitePersonalUserToLargeTeam :: (HasCallStack) => App ()
testInvitePersonalUserToLargeTeam :: HasCallStack => App ()
testInvitePersonalUserToLargeTeam = do
  teamSize <- Service -> App Value
readServiceConfig Service
Galley App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings.maxFanoutSize" App Value -> (App Value -> App Int) -> App Int
forall a b. a -> (a -> b) -> b
& App Value -> App Int
forall a. (HasCallStack, MakesValue a) => a -> App Int
asInt App Int -> (Int -> Int) -> App Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  (owner, tid, (alice : otherTeamMembers)) <- createTeam OwnDomain teamSize
  -- User to be invited to the team
  knut <- I.createUser OwnDomain def >>= getJSON 201

  -- Non team friends of knut
  dawn <- I.createUser OwnDomain def >>= getJSON 201
  eli <- I.createUser OtherDomain def >>= getJSON 201

  -- knut is also friends with alice, but not any other team members.
  traverse_ (connectTwoUsers knut) [alice, dawn, eli]

  addFailureContext ("tid: " <> tid) $ do
    let uids = [(String
"owner", Value
owner), (String
"alice", Value
alice), (String
"knut", Value
knut), (String
"dawn", Value
dawn), (String
"eli", Value
eli)]
    addUsersToFailureContext uids $ do
      lastTeamNotif <-
        getTeamNotifications owner Nothing `bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"notifications.-1.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

      knutEmail <- knut %. "email" >>= asString
      inv <- postInvitation owner (PostInvitation (Just knutEmail) Nothing) >>= getJSON 201
      code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString

      withWebSockets [owner, alice, dawn, eli, head otherTeamMembers] $ \[WebSocket
wsOwner, WebSocket
wsAlice, WebSocket
wsDawn, WebSocket
wsEli, WebSocket
wsOther] -> do
        Value -> String -> Maybe String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> Maybe String -> App Response
acceptTeamInvitation Value
knut String
code (String -> Maybe String
forall a. a -> Maybe a
Just String
defPassword) 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

        [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
wsAlice, WebSocket
wsDawn] ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
          notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isUserUpdatedNotif WebSocket
ws
          nPayload notif %. "user.id" `shouldMatch` (objId knut)
          nPayload notif %. "user.team" `shouldMatch` tid

        -- Admins get a team.member-join notif on the websocket for
        -- team-settings
        memberJobNotif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isTeamMemberJoinNotif WebSocket
wsOwner
        memberJobNotif %. "payload.0.team" `shouldMatch` tid
        memberJobNotif %. "payload.0.data.user" `shouldMatch` objId knut

        -- Other team members don't get notified on the websocket
        assertNoEvent 1 wsOther

        -- Remote users are not notified at all
        assertNoEvent 1 wsEli

      -- Other team members learn about knut via team notifications
      getTeamNotifications (head otherTeamMembers) (Just lastTeamNotif) `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        -- Ignore the first notif because it is always the notif matching the
        -- lastTeamNotif id.
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"notifications.1.payload.0.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"team.member-join"
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"notifications.1.payload.0.team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"notifications.1.payload.0.data.user" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
knut

testInvitePersonalUserToTeamMultipleInvitations :: (HasCallStack) => App ()
testInvitePersonalUserToTeamMultipleInvitations :: HasCallStack => App ()
testInvitePersonalUserToTeamMultipleInvitations = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  (owner2, _, _) <- createTeam OwnDomain 0
  user <- I.createUser OwnDomain def >>= getJSON 201
  email <- user %. "email" >>= asString
  inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201
  inv2 <- postInvitation owner2 (PostInvitation (Just email) Nothing) >>= getJSON 201
  code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
  acceptTeamInvitation user code (Just defPassword) >>= assertSuccess
  bindResponse (getSelf user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
  code2 <- I.getInvitationCode owner2 inv2 >>= getJSON 200 >>= (%. "code") & asString
  bindResponse (acceptTeamInvitation user code2 (Just defPassword)) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"cannot-join-multiple-teams"
  bindResponse (getSelf user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
  acceptTeamInvitation user code (Just defPassword) >>= assertStatus 400

testInvitePersonalUserToTeamEmailDomainForAnotherBackend :: (HasCallStack) => App ()
testInvitePersonalUserToTeamEmailDomainForAnotherBackend :: HasCallStack => App ()
testInvitePersonalUserToTeamEmailDomainForAnotherBackend = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  domain <- App String
randomDomain

  (owner, _, _) <- createTeam OwnDomain 0
  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  void $ I.createUser OwnDomain def {I.email = Just email} >>= getJSON 201

  I.domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain
  -- [customer admin] post no-registration config
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (mkDomainRedirectBackend version "https://example.com" "https://webapp.example.com")
    >>= assertStatus 200

  postInvitation owner (PostInvitation (Just email) Nothing) `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

testAcceptInvitePersonalUserToTeamEmailDomainForAnotherBackend :: (HasCallStack) => App ()
testAcceptInvitePersonalUserToTeamEmailDomainForAnotherBackend :: HasCallStack => App ()
testAcceptInvitePersonalUserToTeamEmailDomainForAnotherBackend = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  domain <- App String
randomDomain

  (owner, _, _) <- createTeam OwnDomain 0
  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  user <- I.createUser OwnDomain def {I.email = Just email} >>= getJSON 201
  inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201
  code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString

  I.domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain

  -- [customer admin] post no-registration config
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (mkDomainRedirectBackend version "https://example.com" "https://webapp.example.com")
    >>= assertStatus 200

  acceptTeamInvitation user code (Just defPassword) `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

testInvitePersonalUserToTeamLegacy :: (HasCallStack) => App ()
testInvitePersonalUserToTeamLegacy :: HasCallStack => App ()
testInvitePersonalUserToTeamLegacy = Int -> App () -> App ()
forall a. Int -> App a -> App a
withAPIVersion Int
6 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  user <- I.createUser OwnDomain def >>= getJSON 201

  -- inviting an existing user should fail
  do
    email <- user %. "email" >>= asString
    bindResponse (postInvitation owner (PostInvitation (Just email) Nothing)) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"email-exists"

  -- inviting a new user should succeed
  do
    email <- randomEmail
    bindResponse (postInvitation owner (PostInvitation (Just email) Nothing)) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      Response
resp.json App 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
email
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid

testInvitationTypesAreDistinct :: (HasCallStack) => Domain -> App ()
testInvitationTypesAreDistinct :: HasCallStack => Domain -> App ()
testInvitationTypesAreDistinct Domain
domain = do
  -- Test all domains here to make sure that enterprise login being disabled
  -- does not prevent user registration.

  -- We are only testing one direction because the other is not possible
  -- because the non-existing user cannot have a valid session
  (owner, _, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
domain Int
0
  user <- I.createUser domain def >>= getJSON 201
  email <- user %. "email" >>= asString
  inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201
  code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
  let body =
        AddUser
forall a. Default a => a
def
          { name = Just email,
            email = Just email,
            password = Just defPassword,
            teamCode = Just code
          }
  addUser domain body >>= assertStatus 409

testTeamUserCannotBeInvited :: (HasCallStack) => App ()
testTeamUserCannotBeInvited :: HasCallStack => App ()
testTeamUserCannotBeInvited = do
  (_, _, tm : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  (owner2, _, _) <- createTeam OwnDomain 0
  email <- tm %. "email" >>= asString
  postInvitation owner2 (PostInvitation (Just email) Nothing) >>= assertStatus 409

testUpgradePersonalToTeam :: (HasCallStack) => App ()
testUpgradePersonalToTeam :: HasCallStack => App ()
testUpgradePersonalToTeam = do
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  email <- alice %. "email" >>= asString
  let teamName = String
"wonderland"
  token <- Nginz.login OwnDomain email defPassword >>= getJSON 200 >>= (%. "access_token") & asString
  tid <- bindResponse (Nginz.upgradePersonalToTeam alice token teamName) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
teamName
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id"

  alice' <- getUser alice alice >>= getJSON 200
  alice' %. "team" `shouldMatch` tid

  team <- getTeam alice tid >>= getJSON 200
  team %. "name" `shouldMatch` teamName

  iTeam <- asString tid >>= I.getTeam alice >>= getJSON 200
  iTeam %. "team.name" `shouldMatch` teamName
  iTeam %. "status" `shouldMatch` "active"

  bindResponse (getTeamMembers alice tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    owner <- App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members") App [Value] -> ([Value] -> 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
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    owner %. "user" `shouldMatch` (alice %. "id")
    shouldBeNull $ owner %. "created_at"
    shouldBeNull $ owner %. "created_by"

  mem <- createTeamMember alice' def
  I.refreshIndex OwnDomain

  bindResponse (searchTeamAll alice') $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    docs <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"documents" App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    actualIds <- for docs ((%. "id") >=> asString)
    expectedIds <- for [alice', mem] ((%. "id") >=> asString)
    actualIds `shouldMatchSet` expectedIds

testUpgradePersonalToTeamAlreadyInATeam :: (HasCallStack) => App ()
testUpgradePersonalToTeamAlreadyInATeam :: HasCallStack => App ()
testUpgradePersonalToTeamAlreadyInATeam = do
  (alice, _, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0

  bindResponse (upgradePersonalToTeam alice "wonderland") $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"user-already-in-a-team"

testUpgradePersonalToTeamEmailDomainForAnotherBackend :: (HasCallStack) => App ()
testUpgradePersonalToTeamEmailDomainForAnotherBackend :: HasCallStack => App ()
testUpgradePersonalToTeamEmailDomainForAnotherBackend = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  domain <- App String
randomDomain
  let email = String
"alice@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  alice <- randomUser OwnDomain def {I.email = Just email}

  I.domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain

  -- [customer admin] post no-registration config
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (mkDomainRedirectBackend version "https://example.com" "https://webapp.example.com")
    >>= assertStatus 200

  bindResponse (upgradePersonalToTeam alice "wonderland") $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

-- for additional tests of the CSV download particularly with SCIM users, please refer to 'Test.Spar.Scim.UserSpec'
testTeamMemberCsvExport :: (HasCallStack) => App ()
testTeamMemberCsvExport :: HasCallStack => App ()
testTeamMemberCsvExport = do
  (owner, tid, members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
5

  modifiedMembers <- for
    ( zip
        ([0, 1, 2] <> repeat 0)
        (owner : members)
    )
    $ \(Int
n, Value
m) -> do
      handle <- App String
randomHandle
      putHandle m handle >>= assertSuccess
      clients <-
        replicateM n
          $ addClient m def
          >>= getJSON 201
          >>= (%. "id")
          >>= asString
      for_ (listToMaybe clients) $ \String
c ->
        Value -> GetNotifications -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> GetNotifications -> App Response
getNotifications Value
m GetNotifications
forall a. Default a => a
def {client = Just c}
      void $ I.putSSOId m def {I.scimExternalId = Just "foo"} >>= getBody 200
      setField "handle" handle m
        >>= setField "role" (if m == owner then "owner" else "member")
        >>= setField "num_clients" n

  memberMap :: Map.Map String Value <- fmap Map.fromList $ for (modifiedMembers) $ \Value
m -> do
    uid <- Value
m 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
    pure (uid, m)

  bindResponse (getTeamMembersCsv owner tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    let rows :: [ByteString]
rows = [ByteString] -> [ByteString]
forall a. Ord a => [a] -> [a]
sort ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
tail ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B8.lines (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Response
resp.body
    [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
rows Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
5
    [ByteString] -> (ByteString -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ByteString]
rows ((ByteString -> App ()) -> App ())
-> (ByteString -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \ByteString
row -> do
      let cols :: [ByteString]
cols = Char -> ByteString -> [ByteString]
B8.split Char
',' ByteString
row
      let uid :: String
uid = String -> String
forall a. Read a => String -> a
read (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
cols [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! Int
11
      let mem :: Value
mem = Map String Value
memberMap Map String Value -> String -> Value
forall k a. Ord k => Map k a -> k -> a
Map.! String
uid

      ownerId <- Value
owner 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
      let ownerMember = Map String Value
memberMap Map String Value -> String -> Value
forall k a. Ord k => Map k a -> k -> a
Map.! String
ownerId
      now <- formatTime defaultTimeLocale "%Y-%m-%d" <$> liftIO getCurrentTime
      numClients <- mem %. "num_clients" & asInt

      let parseField = String -> String
unquote (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Read a => String -> a
read (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B8.unpack (ByteString -> String) -> (Int -> ByteString) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString]
cols [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!!)

      parseField 0 `shouldMatch` (mem %. "name")
      parseField 1 `shouldMatch` (mem %. "handle")
      parseField 2 `shouldMatch` (mem %. "email")
      role <- mem %. "role" & asString
      parseField 3 `shouldMatch` role
      when (role /= "owner") $ do
        take 10 (parseField 4) `shouldMatch` now
        parseField 5 `shouldMatch` (ownerMember %. "handle")
      parseField 7 `shouldMatch` "wire"
      parseField 9 `shouldMatch` "foo"
      parseField 12 `shouldMatch` show numClients
      (if numClients > 0 then shouldNotMatch else shouldMatch)
        (parseField 13)
        ""
      parseField 14 `shouldMatch` "active"
  where
    unquote :: String -> String
    unquote :: String -> String
unquote (Char
'\'' : String
x) = String
x
    unquote String
x = String
x

testUpgradeGuestToTeamShouldFail :: (HasCallStack) => App ()
testUpgradeGuestToTeamShouldFail :: HasCallStack => App ()
testUpgradeGuestToTeamShouldFail = do
  guest <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
ephemeralUser Domain
OwnDomain

  upgradePersonalToTeam guest "wonderland" `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testDeleteTeamUserRatelimitingIsPropagated :: (HasCallStack) => App ()
testDeleteTeamUserRatelimitingIsPropagated :: HasCallStack => App ()
testDeleteTeamUserRatelimitingIsPropagated = do
  (owner, tid, mems) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
10
  -- this is eventually going to run into rate limiting of internal request `/i/users/:uid/reauthenticate`
  statusCodes <- for mems $ \Value
m -> do
    App Response -> (Response -> App Int) -> App Int
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> Value -> App Response
forall owner member.
(HasCallStack, MakesValue owner, MakesValue member) =>
String -> owner -> member -> App Response
deleteTeamMember String
tid Value
owner Value
m) ((Response -> App Int) -> App Int)
-> (Response -> App Int) -> App Int
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Int -> App Int
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
resp.status
  Set.fromList statusCodes `shouldMatchSet` ([202, 429] :: [Int])

testSelectTeamMembersByIds :: (HasCallStack) => App ()
testSelectTeamMembersByIds :: HasCallStack => App ()
testSelectTeamMembersByIds = do
  (owner, tid, mems) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
5
  uids <- for (owner : mems) ((%. "id") >=> asString)

  selectTeamMembers OwnDomain tid uids `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    tms <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length tms `shouldMatchInt` 5

testListUsersEmailVisibility :: (HasCallStack) => App ()
testListUsersEmailVisibility :: HasCallStack => App ()
testListUsersEmailVisibility = do
  let ServiceOverrides
overrides :: ServiceOverrides =
        ServiceOverrides
forall a. Default a => a
def {brigCfg = setField "optSettings.setEmailVisibility" "visible_to_self"}

  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
overrides ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
dom -> do
    (owner, _tid, mems) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
dom Int
5
    memQIds <- for mems objQidObject
    memEmails <- for mems ((%. "email") >=> asString)
    listUsers owner memQIds `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      returnedUsers <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"found" App Value -> (Value -> 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      returnedEmails <- for returnedUsers ((%. "email") >=> asString)
      returnedEmails `shouldMatchSet` memEmails