{-# OPTIONS -Wno-ambiguous-fields #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 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.Search where

import qualified API.Brig as BrigP
import qualified API.BrigInternal as BrigI
import API.Common (defPassword)
import qualified API.Common as API
import API.Galley
import qualified API.Galley as Galley
import qualified API.GalleyInternal as GalleyI
import qualified Data.Set as Set
import GHC.Stack
import SetupHelpers
import Testlib.Assertions
import Testlib.Prelude

--------------------------------------------------------------------------------
-- LOCAL SEARCH

testSearchContactForExternalUsers :: (HasCallStack) => App ()
testSearchContactForExternalUsers :: HasCallStack => App ()
testSearchContactForExternalUsers = do
  owner <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def {BrigI.team = True}
  tid <- owner %. "team" & asString

  partner <- createTeamMember owner def {role = "partner"}
  tm1 <- createTeamMember owner def
  tm2 <- createTeamMember owner def

  -- a team member can search for contacts
  bindResponse (BrigP.searchContacts tm1 (owner %. "name") OwnDomain) $ \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- a partner is not allowed to search for contacts
  bindResponse (BrigP.searchContacts partner (owner %. "name") OwnDomain) $ \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

  -- a team member can see all other team members
  bindResponse (Galley.getTeamMembers tm1 tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response -> [Value] -> App ()
assertContainsUserIds Response
resp [Value
owner, Value
tm1, Value
tm2, Value
partner]

  -- an external partner should see the person who invited them
  bindResponse (Galley.getTeamMembers partner tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response -> [Value] -> App ()
assertContainsUserIds Response
resp [Value
owner, Value
partner]

  -- the team owner creates a conversation with the partner and another team member
  void $ postConversation owner (defProteus {qualifiedUsers = [tm1, partner], team = Just tid}) >>= getJSON 201

  -- now the external partner should still only see the person who invited them
  bindResponse (Galley.getTeamMembers partner tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response -> [Value] -> App ()
assertContainsUserIds Response
resp [Value
owner, Value
partner]
  where
    assertContainsUserIds :: Response -> [Value] -> App ()
    assertContainsUserIds :: Response -> [Value] -> App ()
assertContainsUserIds Response
resp [Value]
users = do
      members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      userIds <- for members (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"user")
      expected <- for users objId
      userIds `shouldMatchSet` expected

testEphemeralUsersSearch :: (HasCallStack) => App ()
testEphemeralUsersSearch :: HasCallStack => App ()
testEphemeralUsersSearch = do
  userEphemeral <- Domain -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Value
ephemeralUser Domain
OwnDomain
  [user1, user2] <- replicateM 2 $ randomUser OwnDomain def
  BrigI.refreshIndex OwnDomain

  -- user1 can find user2
  BrigP.searchContacts user1 (user2 %. "name") OwnDomain >>= \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
    quids <- for docs objId
    expected <- objId user2
    quids `shouldMatchSet` [expected]

  -- ephemeral user is not allowed to search for contacts
  BrigP.searchContacts userEphemeral (user2 %. "name") OwnDomain >>= \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
"insufficient-permissions"

--------------------------------------------------------------------------------
-- FEDERATION SEARCH

-- | Enumeration of the possible restrictions that can be applied to a federated user search
data Restriction = AllowAll | TeamAllowed | TeamNotAllowed
  deriving (Restriction -> Restriction -> Bool
(Restriction -> Restriction -> Bool)
-> (Restriction -> Restriction -> Bool) -> Eq Restriction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Restriction -> Restriction -> Bool
== :: Restriction -> Restriction -> Bool
$c/= :: Restriction -> Restriction -> Bool
/= :: Restriction -> Restriction -> Bool
Eq, Eq Restriction
Eq Restriction =>
(Restriction -> Restriction -> Ordering)
-> (Restriction -> Restriction -> Bool)
-> (Restriction -> Restriction -> Bool)
-> (Restriction -> Restriction -> Bool)
-> (Restriction -> Restriction -> Bool)
-> (Restriction -> Restriction -> Restriction)
-> (Restriction -> Restriction -> Restriction)
-> Ord Restriction
Restriction -> Restriction -> Bool
Restriction -> Restriction -> Ordering
Restriction -> Restriction -> Restriction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Restriction -> Restriction -> Ordering
compare :: Restriction -> Restriction -> Ordering
$c< :: Restriction -> Restriction -> Bool
< :: Restriction -> Restriction -> Bool
$c<= :: Restriction -> Restriction -> Bool
<= :: Restriction -> Restriction -> Bool
$c> :: Restriction -> Restriction -> Bool
> :: Restriction -> Restriction -> Bool
$c>= :: Restriction -> Restriction -> Bool
>= :: Restriction -> Restriction -> Bool
$cmax :: Restriction -> Restriction -> Restriction
max :: Restriction -> Restriction -> Restriction
$cmin :: Restriction -> Restriction -> Restriction
min :: Restriction -> Restriction -> Restriction
Ord, Int -> Restriction -> ShowS
[Restriction] -> ShowS
Restriction -> String
(Int -> Restriction -> ShowS)
-> (Restriction -> String)
-> ([Restriction] -> ShowS)
-> Show Restriction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Restriction -> ShowS
showsPrec :: Int -> Restriction -> ShowS
$cshow :: Restriction -> String
show :: Restriction -> String
$cshowList :: [Restriction] -> ShowS
showList :: [Restriction] -> ShowS
Show)

data FedUserSearchTestCase = FedUserSearchTestCase
  { FedUserSearchTestCase -> String
searchPolicy :: String,
    -- restriction settings of the calling backend
    FedUserSearchTestCase -> Restriction
restrictionD1D2 :: Restriction,
    -- restriction settings of the remote backend
    FedUserSearchTestCase -> Restriction
restrictionD2D1 :: Restriction,
    FedUserSearchTestCase -> Bool
exactHandleSearchExpectFound :: Bool,
    FedUserSearchTestCase -> Bool
fullSearchExpectFound :: Bool
  }
  deriving (FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
(FedUserSearchTestCase -> FedUserSearchTestCase -> Bool)
-> (FedUserSearchTestCase -> FedUserSearchTestCase -> Bool)
-> Eq FedUserSearchTestCase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
== :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
$c/= :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
/= :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
Eq, Eq FedUserSearchTestCase
Eq FedUserSearchTestCase =>
(FedUserSearchTestCase -> FedUserSearchTestCase -> Ordering)
-> (FedUserSearchTestCase -> FedUserSearchTestCase -> Bool)
-> (FedUserSearchTestCase -> FedUserSearchTestCase -> Bool)
-> (FedUserSearchTestCase -> FedUserSearchTestCase -> Bool)
-> (FedUserSearchTestCase -> FedUserSearchTestCase -> Bool)
-> (FedUserSearchTestCase
    -> FedUserSearchTestCase -> FedUserSearchTestCase)
-> (FedUserSearchTestCase
    -> FedUserSearchTestCase -> FedUserSearchTestCase)
-> Ord FedUserSearchTestCase
FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
FedUserSearchTestCase -> FedUserSearchTestCase -> Ordering
FedUserSearchTestCase
-> FedUserSearchTestCase -> FedUserSearchTestCase
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FedUserSearchTestCase -> FedUserSearchTestCase -> Ordering
compare :: FedUserSearchTestCase -> FedUserSearchTestCase -> Ordering
$c< :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
< :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
$c<= :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
<= :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
$c> :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
> :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
$c>= :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
>= :: FedUserSearchTestCase -> FedUserSearchTestCase -> Bool
$cmax :: FedUserSearchTestCase
-> FedUserSearchTestCase -> FedUserSearchTestCase
max :: FedUserSearchTestCase
-> FedUserSearchTestCase -> FedUserSearchTestCase
$cmin :: FedUserSearchTestCase
-> FedUserSearchTestCase -> FedUserSearchTestCase
min :: FedUserSearchTestCase
-> FedUserSearchTestCase -> FedUserSearchTestCase
Ord, Int -> FedUserSearchTestCase -> ShowS
[FedUserSearchTestCase] -> ShowS
FedUserSearchTestCase -> String
(Int -> FedUserSearchTestCase -> ShowS)
-> (FedUserSearchTestCase -> String)
-> ([FedUserSearchTestCase] -> ShowS)
-> Show FedUserSearchTestCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FedUserSearchTestCase -> ShowS
showsPrec :: Int -> FedUserSearchTestCase -> ShowS
$cshow :: FedUserSearchTestCase -> String
show :: FedUserSearchTestCase -> String
$cshowList :: [FedUserSearchTestCase] -> ShowS
showList :: [FedUserSearchTestCase] -> ShowS
Show)

testFederatedUserSearch :: (HasCallStack) => App ()
testFederatedUserSearch :: HasCallStack => App ()
testFederatedUserSearch = do
  let tcs :: [FedUserSearchTestCase]
tcs =
        [ -- no search
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"no_search" Restriction
AllowAll Restriction
AllowAll Bool
False Bool
False,
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"no_search" Restriction
TeamAllowed Restriction
TeamAllowed Bool
False Bool
False,
          -- exact handle search allow all/team allowed
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"exact_handle_search" Restriction
AllowAll Restriction
AllowAll Bool
True Bool
False,
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"exact_handle_search" Restriction
TeamAllowed Restriction
TeamAllowed Bool
True Bool
False,
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"exact_handle_search" Restriction
AllowAll Restriction
TeamAllowed Bool
True Bool
False,
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"exact_handle_search" Restriction
TeamAllowed Restriction
AllowAll Bool
True Bool
False,
          -- exact handle search team not allowed
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"exact_handle_search" Restriction
TeamNotAllowed Restriction
AllowAll Bool
False Bool
False,
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"exact_handle_search" Restriction
AllowAll Restriction
TeamNotAllowed Bool
False Bool
False,
          -- full search allow all/team allowed
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"full_search" Restriction
AllowAll Restriction
AllowAll Bool
True Bool
True,
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"full_search" Restriction
TeamAllowed Restriction
TeamAllowed Bool
True Bool
True,
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"full_search" Restriction
TeamAllowed Restriction
AllowAll Bool
True Bool
True,
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"full_search" Restriction
AllowAll Restriction
TeamAllowed Bool
True Bool
True,
          -- full search team not allowed
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"full_search" Restriction
TeamNotAllowed Restriction
AllowAll Bool
False Bool
False,
          String
-> Restriction
-> Restriction
-> Bool
-> Bool
-> FedUserSearchTestCase
FedUserSearchTestCase String
"full_search" Restriction
AllowAll Restriction
TeamNotAllowed Bool
False Bool
False
        ]
  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Default a => a
def, ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String
d1, String
d2] -> do
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> FedConn -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> App Response
BrigI.createFedConn String
d2 (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
d1 String
"full_search" Maybe [String]
forall a. Maybe a
Nothing)
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> FedConn -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> App Response
BrigI.createFedConn String
d1 (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
d2 String
"full_search" Maybe [String]
forall a. Maybe a
Nothing)
    [FedUserSearchTestCase]
-> (FedUserSearchTestCase -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FedUserSearchTestCase]
tcs (HasCallStack => String -> String -> FedUserSearchTestCase -> App ()
String -> String -> FedUserSearchTestCase -> App ()
federatedUserSearch String
d1 String
d2)

federatedUserSearch :: (HasCallStack) => String -> String -> FedUserSearchTestCase -> App ()
federatedUserSearch :: HasCallStack => String -> String -> FedUserSearchTestCase -> App ()
federatedUserSearch String
d1 String
d2 FedUserSearchTestCase
test = do
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> FedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
BrigI.updateFedConn String
d2 String
d1 (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
d1 FedUserSearchTestCase
test.searchPolicy (Restriction -> Maybe [String]
restriction FedUserSearchTestCase
test.restrictionD2D1))
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> FedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
BrigI.updateFedConn String
d1 String
d2 (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
d2 FedUserSearchTestCase
test.searchPolicy (Restriction -> Maybe [String]
restriction FedUserSearchTestCase
test.restrictionD1D2))

  u1 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
d1 CreateUser
forall a. Default a => a
def {BrigI.team = True}
  teamU1 <- u1 %. "team"
  u2 <- randomUser d2 def {BrigI.team = True}
  uidD2 <- objId u2
  team2 <- u2 %. "team"
  assertSuccess =<< GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled"

  addTeamRestriction d1 d2 team2 test.restrictionD1D2
  addTeamRestriction d2 d1 teamU1 test.restrictionD2D1

  u2Handle <- API.randomHandle
  bindResponse (BrigP.putHandle u2 u2Handle) $ assertSuccess
  BrigI.refreshIndex d2

  bindResponse (BrigP.searchContacts u1 u2Handle d2) $ \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
    case docs of
      [] ->
        Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FedUserSearchTestCase
test.exactHandleSearchExpectFound) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected a non empty result, but got an empty one, for test case " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FedUserSearchTestCase -> String
forall a. Show a => a -> String
show FedUserSearchTestCase
test
      Value
doc : [Value]
_ ->
        if FedUserSearchTestCase
test.exactHandleSearchExpectFound
          then Value
doc Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
uidD2
          else String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected an empty result, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
doc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for test case " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FedUserSearchTestCase -> String
forall a. Show a => a -> String
show FedUserSearchTestCase
test

  bindResponse (BrigP.searchContacts u1 (u2 %. "name") d2) $ \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
    case docs of
      [] -> Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FedUserSearchTestCase
test.fullSearchExpectFound) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected a non empty result, but got an empty one, for test case " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FedUserSearchTestCase -> String
forall a. Show a => a -> String
show FedUserSearchTestCase
test
      Value
doc : [Value]
_ ->
        if FedUserSearchTestCase
test.fullSearchExpectFound
          then Value
doc Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
uidD2
          else String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected an empty result, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
doc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for test case " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FedUserSearchTestCase -> String
forall a. Show a => a -> String
show FedUserSearchTestCase
test
  where
    restriction :: Restriction -> Maybe [String]
    restriction :: Restriction -> Maybe [String]
restriction = \case
      Restriction
AllowAll -> Maybe [String]
forall a. Maybe a
Nothing
      Restriction
TeamAllowed -> [String] -> Maybe [String]
forall a. a -> Maybe a
Just []
      Restriction
TeamNotAllowed -> [String] -> Maybe [String]
forall a. a -> Maybe a
Just []

    addTeamRestriction :: (MakesValue ownDomain, MakesValue remoteDomain, MakesValue remoteTeam) => ownDomain -> remoteDomain -> remoteTeam -> Restriction -> App ()
    addTeamRestriction :: forall ownDomain remoteDomain remoteTeam.
(MakesValue ownDomain, MakesValue remoteDomain,
 MakesValue remoteTeam) =>
ownDomain -> remoteDomain -> remoteTeam -> Restriction -> App ()
addTeamRestriction ownDomain
ownDomain remoteDomain
remoteDomain remoteTeam
remoteTeam = \case
      Restriction
AllowAll ->
        () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Restriction
TeamNotAllowed ->
        -- if the team is not allowed, the restriction was set to by team earlier and we do not need to do anything
        () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Restriction
TeamAllowed -> do
        ownDomain -> remoteDomain -> remoteTeam -> App ()
forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
BrigI.addFederationRemoteTeam ownDomain
ownDomain remoteDomain
remoteDomain remoteTeam
remoteTeam

testFederatedUserSearchNonTeamSearcher :: (HasCallStack) => App ()
testFederatedUserSearchNonTeamSearcher :: HasCallStack => App ()
testFederatedUserSearchNonTeamSearcher = do
  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Default a => a
def, ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String
d1, String
d2] -> do
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> FedConn -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> App Response
BrigI.createFedConn String
d2 (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
d1 String
"full_search" ([String] -> Maybe [String]
forall a. a -> Maybe a
Just []))
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> FedConn -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> App Response
BrigI.createFedConn String
d1 (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
d2 String
"full_search" Maybe [String]
forall a. Maybe a
Nothing)

    u1 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
d1 CreateUser
forall a. Default a => a
def
    u2 <- randomUser d2 def {BrigI.team = True}
    team2 <- u2 %. "team"
    assertSuccess =<< GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled"

    u2Handle <- API.randomHandle
    bindResponse (BrigP.putHandle u2 u2Handle) $ assertSuccess
    BrigI.refreshIndex d2

    bindResponse (BrigP.searchContacts u1 u2Handle d2) $ \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
      case docs of
        [] -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Value
doc : [Value]
_ ->
          String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected an empty result, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
doc

    bindResponse (BrigP.searchContacts u1 (u2 %. "name") d2) $ \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
      case docs of
        [] -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Value
doc : [Value]
_ ->
          String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected an empty result, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
doc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for test case "

testFederatedUserSearchForNonTeamUser :: (HasCallStack) => App ()
testFederatedUserSearchForNonTeamUser :: HasCallStack => App ()
testFederatedUserSearchForNonTeamUser = do
  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Default a => a
def, ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String
d1, String
d2] -> do
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> FedConn -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> App Response
BrigI.createFedConn String
d2 (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
d1 String
"full_search" Maybe [String]
forall a. Maybe a
Nothing)
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> FedConn -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> App Response
BrigI.createFedConn String
d1 (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
d2 String
"full_search" ([String] -> Maybe [String]
forall a. a -> Maybe a
Just []))

    u1 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
d1 CreateUser
forall a. Default a => a
def {BrigI.team = True}
    u2 <- randomUser d2 def

    u2Handle <- API.randomHandle
    bindResponse (BrigP.putHandle u2 u2Handle) $ assertSuccess
    BrigI.refreshIndex d2

    bindResponse (BrigP.searchContacts u1 u2Handle d2) $ \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
      case docs of
        [] -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Value
doc : [Value]
_ ->
          String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected an empty result, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
doc

    bindResponse (BrigP.searchContacts u1 (u2 %. "name") d2) $ \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
      case docs of
        [] -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Value
doc : [Value]
_ ->
          String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"Expected an empty result, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
doc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for test case "

--------------------------------------------------------------------------------
-- TEAM SEARCH

testSearchForTeamMembersWithRoles :: (HasCallStack) => App ()
testSearchForTeamMembersWithRoles :: HasCallStack => App ()
testSearchForTeamMembersWithRoles = do
  (owner, tid, m1 : m2 : m3 : m4 : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
5
  [ownerId, m1Id, m2Id, m3Id, m4Id] <- for [owner, m1, m2, m3, m4] objId

  BrigI.refreshIndex OwnDomain
  bindResponse (BrigP.searchTeamAll owner) $ \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
    length docs `shouldMatchInt` 5
    for_ docs $ \Value
doc -> do
      uid <- Value
doc 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
      if uid == ownerId
        then doc %. "role" `shouldMatch` "owner"
        else doc %. "role" `shouldMatch` "member"

  updateTeamMember tid owner m1 Owner >>= assertSuccess
  updateTeamMember tid owner m2 Member >>= assertSuccess
  updateTeamMember tid owner m3 Partner >>= assertSuccess
  updateTeamMember tid owner m4 Admin >>= assertSuccess

  let expectedRoles =
        [ (String
"owner", [String
ownerId, String
m1Id]),
          (String
"admin", [String
m4Id]),
          (String
"member", [String
m2Id]),
          (String
"partner", [String
m3Id])
        ]
      expectedUserToRoleMapping = [(String, [String])]
expectedRoles [(String, [String])]
-> ((String, [String]) -> [(String, String)]) -> [(String, String)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(String
role, [String]
uids) -> [(String
uid, String
role) | String
uid <- [String]
uids]
      toUidRoleTuple a
doc = (,) (String -> String -> (String, String))
-> App String -> App (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
doc a -> 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) App (String -> (String, String))
-> App String -> App (String, String)
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a
doc a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"role" 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)

  BrigI.refreshIndex OwnDomain
  bindResponse (BrigP.searchTeamAll owner) $ \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
    actual <- for docs toUidRoleTuple
    actual `shouldMatchSet` expectedUserToRoleMapping

  for_ expectedRoles $ \(String
role, [String]
expectedIds) -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> [(String, String)] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [(String, String)] -> App Response
BrigP.searchTeam Value
owner [(String
"frole", String
role)]) ((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
      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
      actual <- for docs toUidRoleTuple
      let expected = [(String
uid, String
role) | String
uid <- [String]
expectedIds]
      actual `shouldMatchSet` expected

  bindResponse (BrigP.searchTeam owner [("frole", "owner,admin,partner")]) $ \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
    length docs `shouldMatchInt` 4
    for_ docs $ \Value
doc -> do
      Value
doc Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldNotMatch` String
"member"

testTeamSearchEmailFilter :: (HasCallStack) => App ()
testTeamSearchEmailFilter :: HasCallStack => App ()
testTeamSearchEmailFilter = do
  (owner, _, mem : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- mark member as having an unverified email in addition to their verified one
  (cookie, token) <- do
    email <- mem %. "email" & asString
    BrigP.login OwnDomain email defPassword `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      tok <- Response
resp.json App 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 cookieVal = 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 ("zuid=" <> cookieVal, tok)
  newUnverified <- API.randomEmail
  BrigP.updateEmail mem newUnverified cookie token >>= assertSuccess

  BrigI.refreshIndex OwnDomain

  -- email=verified returns users with verified email and no unverified (owner only)
  BrigP.searchTeam owner [("email", "verified"), ("size", "100"), ("q", "")] `bindResponse` \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
    uids <- for docs objId
    ownerId <- objId owner
    uids `shouldMatchSet` [ownerId]

  -- email=unverified returns users with unverified email regardless of also having verified (member only)
  BrigP.searchTeam owner [("email", "unverified"), ("size", "100"), ("q", "")] `bindResponse` \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
    uids <- for docs objId
    memberId <- objId mem
    uids `shouldMatchSet` [memberId]

  -- omitting email returns all users
  BrigP.searchTeam owner [("size", "100"), ("q", "")] `bindResponse` \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
    uids <- for docs objId
    ownerId <- objId owner
    memberId <- objId mem
    uids `shouldMatchSet` [ownerId, memberId]

testTeamSearchUserIncludesUserGroups :: (HasCallStack) => App ()
testTeamSearchUserIncludesUserGroups :: HasCallStack => App ()
testTeamSearchUserIncludesUserGroups = do
  (owner, _team, mems) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
5
  [ownerId, mem1id, mem2id, mem3id, mem4id] <- for (owner : mems) ((%. "id") >=> asString)

  ug1 <- BrigP.createUserGroup owner (object ["name" .= "group 1", "members" .= [mem1id, mem2id]]) >>= getJSON 200 >>= objId
  ug2 <- BrigP.createUserGroup owner (object ["name" .= "group 2", "members" .= [mem2id, mem3id, mem4id]]) >>= getJSON 200 >>= objId
  ug3 <- BrigP.createUserGroup owner (object ["name" .= "group 3", "members" .= [mem2id, mem3id]]) >>= getJSON 200 >>= objId

  BrigI.refreshIndex OwnDomain

  bindResponse (BrigP.searchTeamAll owner) \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
    length docs `shouldMatchInt` 5
    actual <- for docs $ \Value
doc -> (,) (String -> [Value] -> (String, [Value]))
-> App String -> App ([Value] -> (String, [Value]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
doc 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) App ([Value] -> (String, [Value]))
-> App [Value] -> App (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
<*> (Value
doc Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"user_groups" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList)
    let expected = [(String
mem1id, [String
ug1]), (String
mem2id, [String
ug1, String
ug2, String
ug3]), (String
mem3id, [String
ug2, String
ug3]), (String
mem4id, [String
ug2]), (String
ownerId, [])]
    (fst <$> actual) `shouldMatchSet` (fst <$> expected)
    for_ actual $ \(String
uid, [Value]
ugs) -> do
      let expectedUgs :: [String]
expectedUgs = [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] (String -> [(String, [String])] -> Maybe [String]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
uid [(String, [String])]
expected)
      actualUgs <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
ugs Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      actualUgs `shouldMatchSet` expectedUgs

testUserSearchable :: App ()
testUserSearchable :: App ()
testUserSearchable = do
  -- Create team and all users who are part of this test
  (owner, tid, [u1, u2, u3]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4
  admin <- createTeamMember owner def {role = "admin"}
  let everyone = [Value
owner, Value
u1, Value
admin, Value
u2, Value
u3]
  everyone'sUidSet <- Set.fromList <$> mapM objId everyone

  -- All users are searchable by default
  assertBool "created users are searchable by default" . and =<< mapM (\Value
u -> Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"searchable" App Value -> (App Value -> App Bool) -> App Bool
forall a b. a -> (a -> b) -> b
& App Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
asBool) everyone

  -- Setting self to non-searchable won't work -- only admin can do it.
  u1id <- u1 %. "id" & asString
  BrigP.setUserSearchable u1 u1id False `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
"insufficient-permissions"

  BrigP.getUser u1 u1 `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
"searchable") App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True

  -- Team admin can set user to non-searchable.
  BrigP.setUserSearchable admin u1id False `bindResponse` \Response
resp -> Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  BrigP.getUser u1 u1 `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
"searchable") App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False

  -- Team owner can, too.
  BrigP.setUserSearchable owner u1id True `bindResponse` \Response
resp -> Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  BrigP.setUserSearchable owner u1id False `bindResponse` \Response
resp -> Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- By default created team members are found.
  u2id <- u2 %. "id" & asString
  BrigI.refreshIndex OwnDomain
  withFoundDocs u1 (u2 %. "name") $ \[Value]
docs -> do
    foundUids <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
docs Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
    assertBool "u1 must find u2 as they are searchable by default" $ u2id `elem` foundUids

  -- User set to non-searchable is not found by other team members.
  u3id <- u3 %. "id" & asString
  BrigP.setUserSearchable owner u3id False `bindResponse` \Response
resp -> Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  BrigI.refreshIndex OwnDomain
  withFoundDocs u1 (u3 %. "name") $ \[Value]
docs -> do
    foundUids <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
docs Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
    assertBool "u1 must not find u3 as they are set non-searchable" $ notElem u3id foundUids

  -- Even admin nor owner won't find non-searchable users via /search/contacts
  withFoundDocs admin (u3 %. "name") $ \[Value]
docs -> do
    foundUids <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
docs Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
    assertBool "Team admin won't find non-searchable user" $ notElem u3id foundUids
  withFoundDocs owner (u3 %. "name") $ \[Value]
docs -> do
    foundUids <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
docs Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
    assertBool "Team owner won't find non-searchable user from /search/contacts" $ notElem u3id foundUids

  -- Check for handle being available with HTTP HEAD still shows that the handle used by non-searchable users is not available
  u3handle <- API.randomHandle
  BrigP.putHandle u3 u3handle `bindResponse` assertSuccess
  BrigP.checkHandle u2 u3handle `bindResponse` \Response
resp -> Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200 -- (200 means "handle is taken", 404 would be "not found")

  -- Handle for POST /handles still works for non-searchable users
  u2handle <- API.randomHandle
  BrigP.putHandle u2 u2handle `bindResponse` assertSuccess
  BrigP.checkHandles u1 [u3handle, u2handle] `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    freeHandles <- Response
resp.json App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    assertBool "POST /handles filters all taken handles, even for regular members" $ null freeHandles

  -- Regular user can't find non-searchable team member by exact handle.
  withFoundDocs u1 u3handle $ \[Value]
docs -> do
    foundUids <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
docs Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
    assertBool "u1 must not find non-searchable u3 by exact handle" $ notElem u3id foundUids

  -- /teams/:tid/members, both admin and regular user get only searchable members
  searchableUsers'Uids <- mapM objId [owner, admin, u2]
  let findOnlySearchable Value
searcher =
        Value -> String -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> App Response
getTeamMembers Value
searcher String
tid 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
          docs <- 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
          foundUids <- mapM (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"user" 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) docs
          foundUids `shouldMatchSet` searchableUsers'Uids
  findOnlySearchable admin
  findOnlySearchable u1

  -- /teams/:tid/search also returns all users from team
  BrigP.searchTeam admin [] `bindResponse` \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
    foundUids <- mapM (\Value
m -> 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) docs
    foundUids `shouldMatchSet` everyone'sUidSet

  -- /teams/:tid/search?searchable=false gets only non-searchable members
  BrigP.searchTeam admin [("searchable", "false")] `bindResponse` \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
    foundUids <- mapM (\Value
m -> 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) docs
    foundUids `shouldMatchSet` [u1id, u3id]

  -- /teams/:tid/search?searchable=true gets only searchable users
  BrigP.searchTeam admin [("searchable", "true")] `bindResponse` \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
    foundUids <- mapM (\Value
m -> 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) docs
    ownerUid <- owner %. "id" & asString
    adminUid <- admin %. "id" & asString
    foundUids `shouldMatchSet` [ownerUid, adminUid, u2id]
  where
    -- Convenience wrapper around search contacts which applies `f` directly to document list.
    withFoundDocs ::
      (MakesValue user, MakesValue searchTerm) =>
      user ->
      searchTerm ->
      ([Value] -> App a) ->
      App a
    withFoundDocs :: forall user searchTerm a.
(MakesValue user, MakesValue searchTerm) =>
user -> searchTerm -> ([Value] -> App a) -> App a
withFoundDocs user
self searchTerm
term [Value] -> App a
f = do
      user -> searchTerm -> Domain -> App Response
forall user searchTerm domain.
(MakesValue user, MakesValue searchTerm, MakesValue domain) =>
user -> searchTerm -> domain -> App Response
BrigP.searchContacts user
self searchTerm
term Domain
OwnDomain App Response -> (Response -> App a) -> App a
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
        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
        f docs