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

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

import API.Brig
import qualified API.BrigInternal as BrigI
import API.Galley
import API.GalleyInternal hiding (getConversation)
import qualified API.GalleyInternal as I
import Control.Applicative
import Control.Concurrent (threadDelay)
import Control.Monad.Codensity
import Control.Monad.Reader
import qualified Data.Aeson as Aeson
import qualified Data.Text as T
import GHC.Stack
import Notifications
import SetupHelpers hiding (deleteUser)
import Testlib.One2One (generateRemoteAndConvIdWithDomain)
import Testlib.Prelude
import Testlib.ResourcePool
import Testlib.VersionedFed

testFederatedConversation :: (HasCallStack) => App ()
testFederatedConversation :: HasCallStack => App ()
testFederatedConversation = do
  -- This test was created to verify that the false positive log message:
  -- "Attempt to send notification about conversation update to users not in the conversation"
  -- does not happen when a user is added to a conversation that is federated.
  -- Unfortunately, that can only be manually verified by looking at the logs.
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  conv <- postConversation alice defProteus >>= getJSON 201

  withWebSocket bob $ \WebSocket
bobWs -> do
    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
forall a. Default a => a
def {users = [bob]} App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
bobWs

  checkConvMembers conv alice [bob]
  retryT $ checkConvMembers conv bob [alice]
  where
    checkConvMembers :: (HasCallStack, MakesValue user) => Value -> user -> [Value] -> App ()
    checkConvMembers :: forall user.
(HasCallStack, MakesValue user) =>
Value -> user -> [Value] -> App ()
checkConvMembers Value
conv user
self [Value]
others =
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (user -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation user
self Value
conv) ((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
        mems <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
        for mems (%. "qualified_id") `shouldMatchSet` (for others (%. "qualified_id"))

testDynamicBackendsFullyConnectedWhenAllowAll :: (HasCallStack) => App ()
testDynamicBackendsFullyConnectedWhenAllowAll :: HasCallStack => App ()
testDynamicBackendsFullyConnectedWhenAllowAll = do
  -- The default setting is 'allowAll'
  [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, ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String]
dynDomains -> do
    [domainA, domainB, domainC] <- [String] -> App [String]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
dynDomains
    uidA <- randomUser domainA def {BrigI.team = True}
    uidB <- randomUser domainA def {BrigI.team = True}
    uidC <- randomUser domainA def {BrigI.team = True}
    assertConnected uidA domainB domainC
    assertConnected uidB domainA domainC
    assertConnected uidC domainA domainB
  where
    assertConnected :: (HasCallStack, MakesValue user) => user -> String -> String -> App ()
    assertConnected :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App ()
assertConnected user
u String
d String
d' =
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
        (user -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getFederationStatus user
u [String
d, String
d'])
        ((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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"fully-connected"

testDynamicBackendsNotFederating :: (HasCallStack) => App ()
testDynamicBackendsNotFederating :: HasCallStack => App ()
testDynamicBackendsNotFederating = do
  let overrides :: ServiceOverrides
overrides =
        ServiceOverrides
forall a. Default a => a
def
          { brigCfg =
              setField "optSettings.setFederationStrategy" "allowNone"
          }
  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
overrides, ServiceOverrides
overrides, ServiceOverrides
overrides] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String
domainA, String
domainB, String
domainC] -> do
    uidA <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def {BrigI.team = True}
    retryT
      $ bindResponse
        (getFederationStatus uidA [domainB, domainC])
      $ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"unreachable_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
domainB, String
domainC]

testDynamicBackendsFullyConnectedWhenAllowDynamic :: (HasCallStack) => App ()
testDynamicBackendsFullyConnectedWhenAllowDynamic :: HasCallStack => App ()
testDynamicBackendsFullyConnectedWhenAllowDynamic = do
  ((String, String, String) -> App ()) -> App ()
forall a.
HasCallStack =>
((String, String, String) -> App a) -> App a
withFederatingBackendsAllowDynamic (((String, String, String) -> App ()) -> App ())
-> ((String, String, String) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
domainA, String
domainB, String
domainC) -> do
    -- Allowing 'full_search' or any type of search is how we enable federation
    -- between backends when the federation strategy is 'allowDynamic'.
    [App Response] -> App ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
x (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
y String
"full_search" Maybe [String]
forall a. Maybe a
Nothing)
      | String
x <- [String
domainA, String
domainB, String
domainC],
        String
y <- [String
domainA, String
domainB, String
domainC],
        String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
y
      ]
    uidA <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def {BrigI.team = True}
    uidB <- randomUser domainB def {BrigI.team = True}
    uidC <- randomUser domainC def {BrigI.team = True}
    let assertConnected user
u String
d String
d' =
          App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
            (user -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getFederationStatus user
u [String
d, String
d'])
            ((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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"fully-connected"
    retryT $ assertConnected uidA domainB domainC
    retryT $ assertConnected uidB domainA domainC
    retryT $ assertConnected uidC domainA domainB

testDynamicBackendsNotFullyConnected :: (HasCallStack) => App ()
testDynamicBackendsNotFullyConnected :: HasCallStack => App ()
testDynamicBackendsNotFullyConnected = do
  ((String, String, String) -> App ()) -> App ()
forall a.
HasCallStack =>
((String, String, String) -> App a) -> App a
withFederatingBackendsAllowDynamic (((String, String, String) -> App ()) -> App ())
-> ((String, String, String) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
domainA, String
domainB, String
domainC) -> do
    -- A is connected to B and C, but B and C are not connected to each other
    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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainA (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainB 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainB (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainA 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainA (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainC 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainC (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainA String
"full_search" Maybe [String]
forall a. Maybe a
Nothing
    uidA <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def {BrigI.team = True}
    retryT
      $ bindResponse
        (getFederationStatus uidA [domainB, domainC])
      $ \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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"non-fully-connected"
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"not_connected" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
domainB, String
domainC]

testFederationStatus :: (HasCallStack) => StaticDomain -> App ()
testFederationStatus :: HasCallStack => StaticDomain -> App ()
testFederationStatus StaticDomain
domain = do
  uid <- 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}
  federatingRemoteDomain <- asString domain
  let invalidDomain = String
"c.example.com" -- Does not have any srv records
  bindResponse
    (getFederationStatus uid [])
    $ \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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"fully-connected"

  bindResponse
    (getFederationStatus uid [invalidDomain])
    $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"unreachable_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
invalidDomain]

  bindResponse
    (getFederationStatus uid [federatingRemoteDomain])
    $ \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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"fully-connected"

testCreateConversationFullyConnected :: (HasCallStack) => App ()
testCreateConversationFullyConnected :: HasCallStack => App ()
testCreateConversationFullyConnected = 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, ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String
domainA, String
domainB, String
domainC] -> do
    [u1, u2, u3] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [String
domainA, String
domainB, String
domainC]
    connectTwoUsers u1 u2
    connectTwoUsers u1 u3
    bindResponse (postConversation u1 (defProteus {qualifiedUsers = [u2, u3]})) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

testCreateConversationNonFullyConnected :: (HasCallStack) => App ()
testCreateConversationNonFullyConnected :: HasCallStack => App ()
testCreateConversationNonFullyConnected = do
  ((String, String, String) -> App ()) -> App ()
forall a.
HasCallStack =>
((String, String, String) -> App a) -> App a
withFederatingBackendsAllowDynamic (((String, String, String) -> App ()) -> App ())
-> ((String, String, String) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
domainA, String
domainB, String
domainC) -> do
    -- A is connected to B and C, but B and C are not connected to each other
    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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainA (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainB 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainB (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainA 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainA (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainC 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainC (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainA String
"full_search" Maybe [String]
forall a. Maybe a
Nothing
    IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)

    u1 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def
    u2 <- randomUser domainB def
    u3 <- randomUser domainC def
    connectTwoUsers u1 u2
    connectTwoUsers u1 u3

    bindResponse (postConversation u1 (defProteus {qualifiedUsers = [u2, u3]})) $ \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
"non_federating_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
domainB, String
domainC]

testAddMembersFullyConnectedProteus :: (HasCallStack) => App ()
testAddMembersFullyConnectedProteus :: HasCallStack => App ()
testAddMembersFullyConnectedProteus = 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, ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String
domainA, String
domainB, String
domainC] -> do
    [u1, u2, u3] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [String
domainA, String
domainB, String
domainC]
    connectTwoUsers u1 u2
    connectTwoUsers u1 u3
    -- create conversation with no users
    cid <- postConversation u1 (defProteus {qualifiedUsers = []}) >>= getJSON 201
    -- add members from remote backends
    members <- for [u2, u3] (%. "qualified_id")
    bindResponse (addMembers u1 cid def {users = members}) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      users <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.users" 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
      addedUsers <- forM users (%. "qualified_id")
      addedUsers `shouldMatchSet` members

testAddMembersNonFullyConnectedProteus :: (HasCallStack) => App ()
testAddMembersNonFullyConnectedProteus :: HasCallStack => App ()
testAddMembersNonFullyConnectedProteus = do
  ((String, String, String) -> App ()) -> App ()
forall a.
HasCallStack =>
((String, String, String) -> App a) -> App a
withFederatingBackendsAllowDynamic (((String, String, String) -> App ()) -> App ())
-> ((String, String, String) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
domainA, String
domainB, String
domainC) -> 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainA (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainB 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainB (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainA 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainA (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainC 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 qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
BrigI.createFedConn String
domainC (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
domainA String
"full_search" Maybe [String]
forall a. Maybe a
Nothing)
    IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000) -- wait for federation status to be updated

    -- add users
    u1 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def
    u2 <- randomUser domainB def
    u3 <- randomUser domainC def
    connectTwoUsers u1 u2
    connectTwoUsers u1 u3

    -- create conversation with no users
    cid <- postConversation u1 (defProteus {qualifiedUsers = []}) >>= getJSON 201
    -- add members from remote backends
    members <- for [u2, u3] (%. "qualified_id")
    bindResponse (addMembers u1 cid def {users = members}) $ \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
"non_federating_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
domainB, String
domainC]

testAddMember :: (HasCallStack) => App ()
testAddMember :: HasCallStack => App ()
testAddMember = 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
  aliceId <- alice %. "qualified_id"
  -- create conversation with no users
  cid <- postConversation alice defProteus >>= getJSON 201
  bob <- randomUser OwnDomain def
  bobId <- bob %. "qualified_id"
  let addMember = Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
cid AddMembers
forall a. Default a => a
def {role = Just "wire_member", users = [bobId]}
  bindResponse addMember $ \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
"not-connected"
  connectTwoUsers alice bob
  bindResponse addMember $ \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
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.member-join"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
alice
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
cid
    users <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.users" 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
    addedUsers <- forM users (%. "qualified_id")
    addedUsers `shouldMatchSet` [bobId]

  -- check that both users can see the conversation
  bindResponse (getConversation alice cid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    mems <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
    mem <- assertOne mems
    mem %. "qualified_id" `shouldMatch` bobId
    mem %. "conversation_role" `shouldMatch` "wire_member"

  bindResponse (getConversation bob cid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    mems <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
    mem <- assertOne mems
    mem %. "qualified_id" `shouldMatch` aliceId
    mem %. "conversation_role" `shouldMatch` "wire_admin"

testAddMemberV1 :: (HasCallStack) => Domain -> App ()
testAddMemberV1 :: HasCallStack => Domain -> App ()
testAddMemberV1 Domain
domain = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
domain]
  conv <- postConversation alice defProteus >>= getJSON 201
  bobId <- bob %. "qualified_id"
  let opts =
        AddMembers
forall a. Default a => a
def
          { version = Just 1,
            role = Just "wire_member",
            users = [bobId]
          }
  bindResponse (addMembers alice conv opts) $ \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
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.member-join"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
alice
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
conv
    users <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.users" 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
    traverse (%. "qualified_id") users `shouldMatchSet` [bobId]

testConvWithUnreachableRemoteUsers :: (HasCallStack) => StaticDomain -> App ()
testConvWithUnreachableRemoteUsers :: HasCallStack => StaticDomain -> App ()
testConvWithUnreachableRemoteUsers StaticDomain
domain = do
  ([alice, alex, bob, charlie, dylan], domains) <-
    [ServiceOverrides]
-> ([String] -> App ([Value], [String])) -> App ([Value], [String])
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 ([Value], [String])) -> App ([Value], [String]))
-> ([String] -> App ([Value], [String])) -> App ([Value], [String])
forall a b. (a -> b) -> a -> b
$ \[String]
domains -> do
      own <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain 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
      other <- make domain & asString
      users@(alice : others) <- createUsers $ [own, own, other] <> domains
      forM_ others $ connectTwoUsers alice
      pure (users, domains)

  let newConv = CreateConv
defProteus {qualifiedUsers = [alex, bob, charlie, dylan]}
  bindResponse (postConversation alice newConv) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"unreachable_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String]
domains

  convs <- getAllConvs alice >>= asList
  regConvs <- filterM (\Value
c -> Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool) -> App Int -> App (Int -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
c Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" 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 -> Bool) -> App Int -> App Bool
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> App Int
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0) convs
  regConvs `shouldMatch` ([] :: [Value])

testAddUserWithUnreachableRemoteUsers :: (HasCallStack) => StaticDomain -> App ()
testAddUserWithUnreachableRemoteUsers :: HasCallStack => StaticDomain -> App ()
testAddUserWithUnreachableRemoteUsers StaticDomain
domain = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  own <- make OwnDomain & asString
  other <- make domain & asString
  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
cDom] -> do
    ([alex, bobId, bradId, chrisId], conv) <- 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
cDom ServiceOverrides
forall a. Monoid a => a
mempty) ((String -> App ([Value], Value)) -> App ([Value], Value))
-> (String -> App ([Value], Value)) -> App ([Value], Value)
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      [alice, alex, bob, brad, charlie, chris] <-
        [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
own, String
own, String
other, String
other, BackendResource
cDom.berDomain, BackendResource
cDom.berDomain]

      let newConv = CreateConv
defProteus {qualifiedUsers = [alex, charlie]}
      conv <- postConversation alice newConv >>= getJSON 201
      [bobId, bradId, chrisId] <- forM [bob, brad, chris] (%. "qualified_id")
      pure ([alex, bobId, bradId, chrisId], conv)

    bindResponse (addMembers alex conv def {users = [bobId]}) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
      Response
resp.jsonBody Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"unreachable_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [BackendResource
cDom.berDomain]

    runCodensity (startDynamicBackend cDom mempty) $ \String
_ ->
      App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alex Value
conv AddMembers
forall a. Default a => a
def {users = [bobId]} App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200

    -- even though backend C is unreachable, we know B/domain and C
    -- federate because Bob joined when C was reachable, hence it is OK to add
    -- brad from B to the conversation.
    void $ addMembers alex conv def {users = [bradId]} >>= getBody 200

    -- assert an unreachable user cannot be added
    bindResponse (addMembers alex conv def {users = [chrisId]}) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
      Response
resp.jsonBody Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"unreachable_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [BackendResource
cDom.berDomain]

testAddUnreachableUserFromFederatingBackend :: (HasCallStack) => StaticDomain -> App ()
testAddUnreachableUserFromFederatingBackend :: HasCallStack => StaticDomain -> App ()
testAddUnreachableUserFromFederatingBackend StaticDomain
domain = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
cDom] -> do
    (alice, chadId, conv) <- 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
cDom ServiceOverrides
forall a. Monoid a => a
mempty) ((String -> App (Value, Value, Value))
 -> App (Value, Value, Value))
-> (String -> App (Value, Value, Value))
-> App (Value, Value, Value)
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      ownDomain <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain 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
      otherDomain <- make domain & asString
      [alice, bob, charlie, chad] <-
        createAndConnectUsers [ownDomain, otherDomain, cDom.berDomain, cDom.berDomain]

      conv <- withWebSockets [bob, charlie] $ \[WebSocket]
wss -> do
        conv <-
          Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [bob, charlie]})
            App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
        forM_ wss $ awaitMatch isMemberJoinNotif
        pure conv
      chadId <- chad %. "qualified_id"
      pure (alice, chadId, conv)

    bindResponse (addMembers alice conv def {users = [chadId]}) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
      Response
resp.jsonBody Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"unreachable_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [BackendResource
cDom.berDomain]

testAddUnreachable :: (HasCallStack) => App ()
testAddUnreachable :: HasCallStack => App ()
testAddUnreachable = do
  ([alex, charlie], [charlieDomain, dylanDomain], conv) <-
    [ServiceOverrides]
-> ([String] -> App ([Value], [String], Value))
-> App ([Value], [String], Value)
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 ([Value], [String], Value))
 -> App ([Value], [String], Value))
-> ([String] -> App ([Value], [String], Value))
-> App ([Value], [String], Value)
forall a b. (a -> b) -> a -> b
$ \[String]
domains -> do
      own <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain 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
      [alice, alex, charlie, dylan] <- createUsers $ [own, own] <> domains
      forM_ [alex, charlie, dylan] $ connectTwoUsers alice

      let newConv = CreateConv
defProteus {qualifiedUsers = [alex, dylan]}
      conv <- postConversation alice newConv >>= getJSON 201
      connectTwoUsers alex charlie
      pure ([alex, charlie], domains, conv)

  charlieId <- charlie %. "qualified_id"
  bindResponse (addMembers alex conv def {users = [charlieId]}) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
    -- All of the domains that are in the conversation, or will be in the conversation,
    -- need to be reachable so we can check that the graph for those domains is fully connected.
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"unreachable_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
charlieDomain, String
dylanDomain]

testGetOneOnOneConvInStatusSentFromRemote :: (HasCallStack) => StaticDomain -> App ()
testGetOneOnOneConvInStatusSentFromRemote :: HasCallStack => StaticDomain -> App ()
testGetOneOnOneConvInStatusSentFromRemote StaticDomain
domain = do
  d1User <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let shouldBeLocal = Bool
True
  (d2Usr, d2ConvId) <- generateRemoteAndConvIdWithDomain domain (not shouldBeLocal) d1User
  bindResponse (postConnection d1User d2Usr) $ \Response
r -> do
    Response
r.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
    Response
r.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"sent"
  bindResponse (listConversationIds d1User def) $ \Response
r -> do
    Response
r.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    convIds <- Response
r.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversations" 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
    filter ((==) d2ConvId) convIds `shouldMatch` [d2ConvId]
  bindResponse (getConnections d1User) $ \Response
r -> do
    qConvIds <- Response
r.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"connections" 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 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) -> [Value] -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation")
    filter ((==) d2ConvId) qConvIds `shouldMatch` [d2ConvId]
  resp <- getConversation d1User d2ConvId
  resp.status `shouldMatchInt` 200

testAddingUserNonFullyConnectedFederation :: (HasCallStack) => StaticDomain -> App ()
testAddingUserNonFullyConnectedFederation :: HasCallStack => StaticDomain -> App ()
testAddingUserNonFullyConnectedFederation StaticDomain
domain = do
  let overrides :: ServiceOverrides
overrides =
        ServiceOverrides
forall a. Default a => a
def
          { brigCfg =
              setField "optSettings.setFederationStrategy" "allowDynamic"
          }
  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
overrides] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String
dynBackend] -> do
    own <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OwnDomain
    other <- asString domain

    -- Ensure that dynamic backend only federates with own domain, but not other
    -- domain.
    void $ BrigI.createFedConn dynBackend (BrigI.FedConn own "full_search" Nothing)

    alice <- randomUser own def
    bob <- randomUser other def
    charlie <- randomUser dynBackend def
    -- We use retryT here so the dynamic federated connection changes can take
    -- some time to be propagated. Remove after fixing https://wearezeta.atlassian.net/browse/WPB-3797
    mapM_ (retryT . connectTwoUsers alice) [bob, charlie]

    let newConv = CreateConv
defProteus {qualifiedUsers = []}
    conv <- postConversation alice newConv >>= getJSON 201

    bobId <- bob %. "qualified_id"
    charlieId <- charlie %. "qualified_id"
    bindResponse (addMembers alice conv def {users = [bobId, charlieId]}) $ \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
"non_federating_backends" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
other, String
dynBackend]

testMultiIngressGuestLinks :: (HasCallStack) => App ()
testMultiIngressGuestLinks :: HasCallStack => App ()
testMultiIngressGuestLinks = do
  do
    configuredURI <- Service -> App Value
readServiceConfig Service
Galley App Value -> (App Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& (App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings.conversationCodeURI") App Value -> (App Value -> App Text) -> App Text
forall a b. a -> (a -> b) -> b
& App Value -> App Text
forall a. (HasCallStack, MakesValue a) => a -> App Text
asText

    (user, _, _) <- createTeam OwnDomain 1
    conv <- postConversation user (allowGuests defProteus) >>= getJSON 201

    bindResponse (postConversationCode user conv Nothing Nothing) $ \Response
resp -> do
      res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
      res %. "type" `shouldMatch` "conversation.code-update"
      guestLink <- res %. "data.uri" & asText
      assertBool "guestlink incorrect" $ configuredURI `T.isPrefixOf` guestLink

    bindResponse (getConversationCode user conv Nothing) $ \Response
resp -> do
      res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
      guestLink <- res %. "uri" & asText
      assertBool "guestlink incorrect" $ configuredURI `T.isPrefixOf` guestLink

    bindResponse (getConversationCode user conv (Just "red.example.com")) $ \Response
resp -> do
      res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
      guestLink <- res %. "uri" & asText
      assertBool "guestlink incorrect" $ configuredURI `T.isPrefixOf` guestLink

  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ( ServiceOverrides
forall a. Default a => a
def
        { galleyCfg = \Value
conf ->
            Value
conf
              Value -> (Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"settings.conversationCodeURI" Value
Null
              App Value -> (App Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> Value -> App Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField
                String
"settings.multiIngress"
                ( [Pair] -> Value
object
                    [ String
"red.example.com" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://red.example.com",
                      String
"blue.example.com" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://blue.example.com"
                    ]
                )
        }
    )
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      (user, _, _) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
      conv <- postConversation user (allowGuests defProteus) >>= getJSON 201

      bindResponse (postConversationCode user conv Nothing (Just "red.example.com")) $ \Response
resp -> do
        res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
        res %. "type" `shouldMatch` "conversation.code-update"
        guestLink <- res %. "data.uri" & asText
        assertBool "guestlink incorrect" $ (fromString "https://red.example.com") `T.isPrefixOf` guestLink

      bindResponse (getConversationCode user conv (Just "red.example.com")) $ \Response
resp -> do
        res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
        guestLink <- res %. "uri" & asText
        assertBool "guestlink incorrect" $ (fromString "https://red.example.com") `T.isPrefixOf` guestLink

      bindResponse (getConversationCode user conv (Just "blue.example.com")) $ \Response
resp -> do
        res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
        guestLink <- res %. "uri" & asText
        assertBool "guestlink incorrect" $ (fromString "https://blue.example.com") `T.isPrefixOf` guestLink

      bindResponse (getConversationCode user conv Nothing) $ \Response
resp -> do
        res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
403 Response
resp
        res %. "label" `shouldMatch` "access-denied"

      bindResponse (getConversationCode user conv (Just "unknown.example.com")) $ \Response
resp -> do
        res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
403 Response
resp
        res %. "label" `shouldMatch` "access-denied"

testAddUserWhenOtherBackendOffline :: (HasCallStack) => App ()
testAddUserWhenOtherBackendOffline :: HasCallStack => App ()
testAddUserWhenOtherBackendOffline = do
  ([alice, alex], conv) <-
    [ServiceOverrides]
-> ([String] -> App ([Value], Value)) -> App ([Value], Value)
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Default a => a
def] (([String] -> App ([Value], Value)) -> App ([Value], Value))
-> ([String] -> App ([Value], Value)) -> App ([Value], Value)
forall a b. (a -> b) -> a -> b
$ \[String]
domains -> do
      own <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain 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
      [alice, alex, charlie] <- createUsers $ [own, own] <> domains
      forM_ [alex, charlie] $ connectTwoUsers alice

      let newConv = CreateConv
defProteus {qualifiedUsers = [charlie]}
      conv <- postConversation alice newConv >>= getJSON 201
      pure ([alice, alex], conv)
  bindResponse (addMembers alice conv def {users = [alex]}) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

testSynchroniseUserRemovalNotification :: (HasCallStack) => StaticDomain -> App ()
testSynchroniseUserRemovalNotification :: HasCallStack => StaticDomain -> App ()
testSynchroniseUserRemovalNotification StaticDomain
domain = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  ownDomain <- make OwnDomain
  otherDomain <- make domain
  [alice, bob] <- createAndConnectUsers [ownDomain, otherDomain]
  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
dynBackend] -> do
    (conv, charlie) <-
      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
dynBackend ServiceOverrides
forall a. Monoid a => a
mempty) ((String -> App (Value, Value)) -> App (Value, Value))
-> (String -> App (Value, Value)) -> App (Value, Value)
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
        charlie <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser BackendResource
dynBackend.berDomain CreateUser
forall a. Default a => a
def
        mapM_ (connectTwoUsers charlie) [alice, bob]
        conv <-
          postConversation alice (defProteus {qualifiedUsers = [bob, charlie]})
            >>= getJSON 201
        pure (conv, charlie)

    let newConvName = String
"The new conversation name"
    bindResponse (changeConversationName alice conv newConvName) $ \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    bindResponse (removeMember alice conv charlie) $ \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    runCodensity (startDynamicBackend dynBackend mempty) $ \String
_ -> do
      nameNotif <- Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
charlie Maybe Value
noValue Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvNameChangeNotif
      nameNotif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv
      nameNotif %. "payload.0.data.name" `shouldMatch` newConvName
      leaveNotif <- awaitNotification charlie noValue isConvLeaveNotif
      leaveNotif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv

testConvRenaming :: (HasCallStack) => App ()
testConvRenaming :: HasCallStack => App ()
testConvRenaming = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  conv <-
    postConversation alice (defProteus {qualifiedUsers = [bob]})
      >>= getJSON 201
  let newConvName = String
"The new conversation name"
  withWebSockets [alice, bob] $ \[WebSocket]
wss -> do
    [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
      App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall user conv name.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue name) =>
user -> conv -> name -> App Response
changeConversationName Value
alice Value
conv String
newConvName App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
      nameNotif <- 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
isConvNameChangeNotif WebSocket
ws
      nameNotif %. "payload.0.data.name" `shouldMatch` newConvName
      nameNotif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv

testNewConversationReceiptMode :: (HasCallStack) => ConversationProtocol -> App ()
testNewConversationReceiptMode :: HasCallStack => ConversationProtocol -> App ()
testNewConversationReceiptMode ConversationProtocol
proto = 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
  conv <- postConversation alice (defConv proto) {receiptMode = Just 11} >>= getJSON 201
  let expectedReceiptMode = case ConversationProtocol
proto of
        ConversationProtocol
ConversationProtocolProteus -> Int
11
        ConversationProtocol
ConversationProtocolMLS -> Int
0
  conv %. "receipt_mode" `shouldMatchInt` expectedReceiptMode

testConversationReceiptModeUpdate :: (HasCallStack) => ConversationProtocol -> App ()
testConversationReceiptModeUpdate :: HasCallStack => ConversationProtocol -> App ()
testConversationReceiptModeUpdate ConversationProtocol
proto = 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
  conv <- postConversation alice (defConv proto) {receiptMode = Just 11} >>= getJSON 201
  receiptMode <- bindResponse (updateReceiptMode alice conv (12 :: Int)) $ \Response
resp -> case ConversationProtocol
proto of
    ConversationProtocol
ConversationProtocolProteus -> 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
"data.receipt_mode" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
12
      Int -> App Int
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
12
    ConversationProtocol
ConversationProtocolMLS -> 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
"mls-receipts-not-allowed"
      Int -> App Int
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0

  bindResponse (getConversation alice conv) $ \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
"receipt_mode" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
receiptMode

testReceiptModeWithRemotesOk :: (HasCallStack) => App ()
testReceiptModeWithRemotesOk :: HasCallStack => App ()
testReceiptModeWithRemotesOk = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  conv <-
    postConversation alice (defProteus {qualifiedUsers = [bob]})
      >>= getJSON 201
  withWebSockets [alice, bob] $ \[WebSocket]
wss -> do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> Int -> App Response
forall user conv name.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue name) =>
user -> conv -> name -> App Response
updateReceiptMode Value
alice Value
conv (Int
43 :: Int) App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
    [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
      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
isReceiptModeUpdateNotif WebSocket
ws
      notif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv
      notif %. "payload.0.qualified_from" `shouldMatch` objQidObject alice
      notif %. "payload.0.data.receipt_mode" `shouldMatchInt` 43

testReceiptModeWithRemotesUnreachable :: (HasCallStack) => App ()
testReceiptModeWithRemotesUnreachable :: HasCallStack => App ()
testReceiptModeWithRemotesUnreachable = do
  ownDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OwnDomain
  alice <- randomUser ownDomain def
  conv <- startDynamicBackends [mempty] $ \[String
dynBackend] -> do
    bob <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynBackend CreateUser
forall a. Default a => a
def
    connectTwoUsers alice bob
    postConversation alice (defProteus {qualifiedUsers = [bob]})
      >>= getJSON 201
  withWebSocket alice $ \WebSocket
ws -> do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> Int -> App Response
forall user conv name.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue name) =>
user -> conv -> name -> App Response
updateReceiptMode Value
alice Value
conv (Int
43 :: Int) App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
    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
isReceiptModeUpdateNotif WebSocket
ws
    notif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv
    notif %. "payload.0.qualified_from" `shouldMatch` objQidObject alice
    notif %. "payload.0.data.receipt_mode" `shouldMatchInt` 43

testDeleteLocalMember :: (HasCallStack) => App ()
testDeleteLocalMember :: HasCallStack => App ()
testDeleteLocalMember = do
  [alice, alex, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain]
  connectTwoUsers alice alex
  connectTwoUsers alice bob
  conv <-
    postConversation alice (defProteus {qualifiedUsers = [alex, bob]})
      >>= getJSON 201
  bindResponse (removeMember alice conv alex) $ \Response
resp -> do
    r <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
    r %. "type" `shouldMatch` "conversation.member-leave"
    r %. "qualified_conversation" `shouldMatch` objQidObject conv
    r %. "qualified_from" `shouldMatch` objQidObject alice
    r %. "data.qualified_user_ids.0" `shouldMatch` objQidObject alex
  -- Now that Alex is gone, try removing her once again
  bindResponse (removeMember alice conv alex) $ \Response
r -> do
    Response
r.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204
    Response
r.jsonBody Maybe Value -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (forall a. Maybe a
Nothing @Aeson.Value)

testDeleteRemoteMember :: (HasCallStack) => App ()
testDeleteRemoteMember :: HasCallStack => App ()
testDeleteRemoteMember = do
  [alice, alex, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain]
  connectTwoUsers alice alex
  connectTwoUsers alice bob
  conv <-
    postConversation alice (defProteus {qualifiedUsers = [alex, bob]})
      >>= getJSON 201
  bindResponse (removeMember alice conv bob) $ \Response
resp -> do
    r <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
    r %. "type" `shouldMatch` "conversation.member-leave"
    r %. "qualified_conversation" `shouldMatch` objQidObject conv
    r %. "qualified_from" `shouldMatch` objQidObject alice
    r %. "data.qualified_user_ids.0" `shouldMatch` objQidObject bob
  -- Now that Bob is gone, try removing him once again
  bindResponse (removeMember alice conv bob) $ \Response
r -> do
    Response
r.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204
    Response
r.jsonBody Maybe Value -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (forall a. Maybe a
Nothing @Aeson.Value)

testDeleteRemoteMemberRemoteUnreachable :: (HasCallStack) => App ()
testDeleteRemoteMemberRemoteUnreachable :: HasCallStack => App ()
testDeleteRemoteMemberRemoteUnreachable = do
  [alice, bob, bart] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OtherDomain, Domain
OtherDomain]
  conv <- startDynamicBackends [mempty] $ \[String
dynBackend] -> do
    charlie <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynBackend CreateUser
forall a. Default a => a
def
    connectTwoUsers alice bob
    connectTwoUsers alice bart
    connectTwoUsers alice charlie
    postConversation
      alice
      (defProteus {qualifiedUsers = [bob, bart, charlie]})
      >>= getJSON 201
  void $ withWebSockets [alice, bob] $ \[WebSocket]
wss -> do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> Value -> App Response
forall user conv name.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue name) =>
user -> conv -> name -> App Response
removeMember Value
alice Value
conv Value
bob App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
    [WebSocket] -> (WebSocket -> App ()) -> App [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [WebSocket]
wss ((WebSocket -> App ()) -> App [()])
-> (WebSocket -> App ()) -> App [()]
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
      leaveNotif <- 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
isConvLeaveNotif WebSocket
ws
      leaveNotif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv
      leaveNotif %. "payload.0.qualified_from" `shouldMatch` objQidObject alice
      leaveNotif %. "payload.0.data.qualified_user_ids.0" `shouldMatch` objQidObject bob
  -- Now that Bob is gone, try removing him once again
  bindResponse (removeMember alice conv bob) $ \Response
r -> do
    Response
r.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204
    Response
r.jsonBody Maybe Value -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (forall a. Maybe a
Nothing @Aeson.Value)

testDeleteTeamConversationWithRemoteMembers :: (HasCallStack) => App ()
testDeleteTeamConversationWithRemoteMembers :: HasCallStack => App ()
testDeleteTeamConversationWithRemoteMembers = do
  (alice, team, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  conv <- postConversation alice (defProteus {team = Just team}) >>= getJSON 201
  bob <- randomUser OtherDomain def
  connectTwoUsers alice bob
  mem <- bob %. "qualified_id"
  void $ addMembers alice conv def {users = [mem]} >>= getBody 200

  void $ withWebSockets [alice, bob] $ \[WebSocket]
wss -> do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> Value -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
String -> conv -> user -> App Response
deleteTeamConversation String
team Value
conv Value
alice App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
    [WebSocket] -> (WebSocket -> App ()) -> App [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [WebSocket]
wss ((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
isConvDeleteNotif WebSocket
ws
      notif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv
      notif %. "payload.0.qualified_from" `shouldMatch` objQidObject alice

testDeleteTeamConversationWithUnreachableRemoteMembers :: (HasCallStack) => App ()
testDeleteTeamConversationWithUnreachableRemoteMembers :: HasCallStack => App ()
testDeleteTeamConversationWithUnreachableRemoteMembers = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  (alice, team, _) <- createTeam OwnDomain 1
  conv <- postConversation alice (defProteus {team = Just team}) >>= getJSON 201

  let assertNotification :: (HasCallStack, MakesValue n) => n -> App ()
      assertNotification n
notif = do
        n
notif n -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.qualified_conversation" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
conv
        n
notif n -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.qualified_from" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
alice

  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
dynBackend] -> do
    bob <- 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
dynBackend ServiceOverrides
forall a. Monoid a => a
mempty) ((String -> App Value) -> App Value)
-> (String -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      bob <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser BackendResource
dynBackend.berDomain CreateUser
forall a. Default a => a
def
      connectTwoUsers alice bob
      mem <- bob %. "qualified_id"
      void $ addMembers alice conv def {users = [mem]} >>= getBody 200
      pure bob
    withWebSocket alice $ \WebSocket
ws -> do
      App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> Value -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
String -> conv -> user -> App Response
deleteTeamConversation String
team Value
conv Value
alice App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
      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
isConvDeleteNotif WebSocket
ws
      assertNotification notif
    void $ runCodensity (startDynamicBackend dynBackend mempty) $ \String
_ -> do
      notif <- Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
bob Maybe Value
noValue Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvDeleteNotif
      assertNotification notif

testDeleteTeamMemberLimitedEventFanout :: (HasCallStack) => App ()
testDeleteTeamMemberLimitedEventFanout :: HasCallStack => App ()
testDeleteTeamMemberLimitedEventFanout = do
  -- Alex will get removed from the team
  (alice, team, [alex, alison]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  ana <- createTeamMember alice def {role = "admin"}
  [amy, bob] <- for [OwnDomain, OtherDomain] $ flip randomUser def
  forM_ [amy, bob] $ connectTwoUsers alice
  [aliceId, alexId, amyId, alisonId, anaId, bobId] <- do
    forM [alice, alex, amy, alison, ana, bob] (%. "qualified_id")
  let nc =
        ( CreateConv
defProteus
            { qualifiedUsers =
                [alexId, amyId, alisonId, anaId, bobId],
              team = Just team
            }
        )
  conv <- postConversation alice nc >>= getJSON 201
  memsBefore <- getMembers team aliceId

  -- Only the team admins will get the team-level event about Alex being removed
  -- from the team
  assertSuccess =<< setTeamFeatureStatus OwnDomain team "limitedEventFanout" "enabled"

  withWebSockets [alice, amy, bob, alison, ana]
    $ \[WebSocket
wsAlice, WebSocket
wsAmy, WebSocket
wsBob, WebSocket
wsAlison, WebSocket
wsAna] -> do
      App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> Value -> App Response
forall owner member.
(HasCallStack, MakesValue owner, MakesValue member) =>
String -> owner -> member -> App Response
deleteTeamMember String
team Value
alice Value
alex App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
202

      memsAfter <- String -> Value -> App [Value]
forall {user} {tid}.
(MakesValue user, MakesValue tid) =>
tid -> user -> App [Value]
getMembers String
team Value
aliceId
      memsAfter `shouldNotMatch` memsBefore

      assertConvUserDeletedNotif wsAmy alexId
      assertConvUserDeletedNotif wsAlison alexId

      alexUId <- alex %. "id"
      do
        n <- awaitMatch isTeamMemberLeaveNotif wsAlice
        nPayload n %. "data.user" `shouldMatch` alexUId
        assertConvUserDeletedNotif wsAlice alexId
      do
        n <- awaitMatch isTeamMemberLeaveNotif wsAna
        nPayload n %. "data.user" `shouldMatch` alexUId
        assertConvUserDeletedNotif wsAna alexId
      do
        bindResponse (getConversation bob conv) $ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          mems <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
          memIds <- forM mems (%. "qualified_id")
          memIds `shouldMatchSet` [aliceId, alisonId, amyId, anaId]
        assertConvUserDeletedNotif wsBob alexId
  where
    getMembers :: tid -> user -> App [Value]
getMembers tid
tid user
usr = App Response -> (Response -> App [Value]) -> App [Value]
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (user -> tid -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getTeamMembers user
usr tid
tid) ((Response -> App [Value]) -> App [Value])
-> (Response -> App [Value]) -> App [Value]
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
      ms <- 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
      forM ms $ (%. "user")

-- The test relies on the default value for the 'limitedEventFanout' flag, which
-- is disabled by default. The counterpart test
-- 'testDeleteTeamMemberLimitedEventFanout' enables the flag and tests the
-- limited fanout.
testDeleteTeamMemberFullEventFanout :: (HasCallStack) => App ()
testDeleteTeamMemberFullEventFanout :: HasCallStack => App ()
testDeleteTeamMemberFullEventFanout = do
  (alice, team, [alex, alison]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  [amy, bob] <- for [OwnDomain, OtherDomain] $ flip randomUser def
  forM_ [amy, bob] $ connectTwoUsers alice
  [aliceId, alexId, alisonId, amyId, bobId] <-
    forM [alice, alex, alison, amy, bob] (%. "qualified_id")
  let nc = (CreateConv
defProteus {qualifiedUsers = [alexId, alisonId, amyId, bobId], team = Just team})
  conv <- postConversation alice nc >>= getJSON 201
  withWebSockets [alice, alison, amy, bob] $ \[WebSocket
wsAlice, WebSocket
wsAlison, WebSocket
wsAmy, WebSocket
wsBob] -> do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> Value -> App Response
forall owner member.
(HasCallStack, MakesValue owner, MakesValue member) =>
String -> owner -> member -> App Response
deleteTeamMember String
team Value
alice Value
alex App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
202
    alexUId <- Value
alex Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
    do
      n <- awaitMatch isTeamMemberLeaveNotif wsAlice
      nPayload n %. "data.user" `shouldMatch` alexUId
    do
      t <- awaitMatch isTeamMemberLeaveNotif wsAlison
      nPayload t %. "data.user" `shouldMatch` alexUId
      assertConvUserDeletedNotif wsAlison alexId

    assertConvUserDeletedNotif wsAmy alexId

    do
      bindResponse (getConversation bob conv) $ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        mems <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
        memIds <- forM mems (%. "qualified_id")
        memIds `shouldMatchSet` [aliceId, alisonId, amyId]
      assertConvUserDeletedNotif wsBob alexId

testLeaveConversationSuccess :: (HasCallStack) => App ()
testLeaveConversationSuccess :: HasCallStack => App ()
testLeaveConversationSuccess = do
  [alice, bob, chad, dee] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain, Domain
OtherDomain]
  [aClient, bClient] <- forM [alice, bob] $ \Value
user ->
    App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
user AddClient
forall a. Default a => a
def) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  startDynamicBackends [def] $ \[String
dynDomain] -> do
    eve <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynDomain CreateUser
forall a. Default a => a
def
    eClient <- objId $ bindResponse (addClient eve def) $ getJSON 201
    forM_ [bob, chad, dee, eve] $ connectTwoUsers alice
    conv <-
      postConversation
        alice
        ( defProteus
            { qualifiedUsers = [bob, chad, dee, eve]
            }
        )
        >>= getJSON 201
    void $ removeMember chad conv chad >>= getBody 200
    assertLeaveNotification chad conv alice aClient chad
    assertLeaveNotification chad conv bob bClient chad
    assertLeaveNotification chad conv eve eClient chad

testOnUserDeletedConversations :: (HasCallStack) => App ()
testOnUserDeletedConversations :: HasCallStack => App ()
testOnUserDeletedConversations = do
  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String
dynDomain] -> do
    [ownDomain, otherDomain] <- [Domain] -> (Domain -> App String) -> App [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Domain
OwnDomain, Domain
OtherDomain] Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
    [alice, alex, bob, bart, chad] <- createUsers [ownDomain, ownDomain, otherDomain, otherDomain, dynDomain]
    forM_ [alex, bob, bart, chad] $ connectTwoUsers alice
    bobId <- bob %. "qualified_id"
    ooConvId <-
      getOne2OneConversation alice bobId Established >>= (%. "qualified_id")

    mainConvBefore <-
      postConversation alice (defProteus {qualifiedUsers = [alex, bob, bart, chad]})
        >>= getJSON 201

    void $ withWebSocket alex $ \WebSocket
ws -> do
      App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
deleteUser Value
bob App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
      n <- 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
isConvLeaveNotif WebSocket
ws
      n %. "payload.0.qualified_from" `shouldMatch` bobId
      n %. "payload.0.qualified_conversation" `shouldMatch` (mainConvBefore %. "qualified_id")

      do
        -- Bob is not in the one-to-one conversation with Alice any more
        conv <- getConversation alice ooConvId >>= getJSON 200
        shouldBeEmpty $ conv %. "members.others"
      do
        -- Bob is not in the main conversation any more
        mainConvAfter <- getConversation alice (mainConvBefore %. "qualified_id") >>= getJSON 200
        mems <- mainConvAfter %. "members.others" & asList
        memIds <- for mems (%. "qualified_id")
        expectedIds <- for [alex, bart, chad] (%. "qualified_id")
        memIds `shouldMatchSet` expectedIds

testUpdateConversationByRemoteAdmin :: (HasCallStack) => App ()
testUpdateConversationByRemoteAdmin :: HasCallStack => App ()
testUpdateConversationByRemoteAdmin = do
  [alice, bob, charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OtherDomain, Domain
OtherDomain]
  connectTwoUsers alice bob
  connectTwoUsers alice charlie
  conv <-
    postConversation alice (defProteus {qualifiedUsers = [bob, charlie]})
      >>= getJSON 201
  void $ updateRole alice bob "wire_admin" (conv %. "qualified_id") >>= getBody 200
  void $ withWebSockets [alice, bob, charlie] $ \[WebSocket]
wss -> do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> Int -> App Response
forall user conv name.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue name) =>
user -> conv -> name -> App Response
updateReceiptMode Value
bob Value
conv (Int
41 :: Int) App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
200
    [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss ((WebSocket -> App Value) -> App ())
-> (WebSocket -> App Value) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> 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
isReceiptModeUpdateNotif WebSocket
ws

testGuestCreatesConversation :: (HasCallStack) => App ()
testGuestCreatesConversation :: HasCallStack => App ()
testGuestCreatesConversation = 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 {BrigI.activate = False}
  bindResponse (postConversation alice defProteus) $ \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
"operation-denied"

testGuestLinksSuccess :: (HasCallStack) => App ()
testGuestLinksSuccess :: HasCallStack => App ()
testGuestLinksSuccess = do
  (user, _, tm : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  conv <- postConversation user (allowGuests defProteus) >>= getJSON 201
  (k, v) <- bindResponse (postConversationCode user conv Nothing Nothing) $ \Response
resp -> do
    res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
    k <- res %. "data.key" & asString
    v <- res %. "data.code" & asString
    pure (k, v)
  bindResponse (getJoinCodeConv tm k v) $ \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
"id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
conv App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId)

testGuestLinksExpired :: (HasCallStack) => App ()
testGuestLinksExpired :: HasCallStack => App ()
testGuestLinksExpired = do
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def {galleyCfg = setField "settings.guestLinkTTLSeconds" (1 :: Int)}
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      (user, _, tm : _) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
2
      conv <- postConversation user (allowGuests defProteus) >>= getJSON 201
      (k, v) <- bindResponse (postConversationCode user conv Nothing Nothing) $ \Response
resp -> do
        res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
        (,) <$> asString (res %. "data.key") <*> asString (res %. "data.code")
      -- let's wait a little longer than 1 second for the guest link to expire
      liftIO $ threadDelay (1_100_000)
      bindResponse (getJoinCodeConv tm k v) $ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testConversationWithLegacyFed :: (HasCallStack) => AnyFedDomain -> App ()
testConversationWithLegacyFed :: HasCallStack => AnyFedDomain -> App ()
testConversationWithLegacyFed AnyFedDomain
domain = 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
  bob <- randomUser domain def
  withAPIVersion 4 $ connectTwoUsers alice bob

  conv <-
    postConversation alice (defProteus {qualifiedUsers = [bob]})
      >>= getJSON 201

  withWebSocket bob $ \WebSocket
ws -> do
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> String -> App Response
forall user conv name.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue name) =>
user -> conv -> name -> App Response
changeConversationName Value
alice Value
conv String
"foobar" App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvNameChangeNotif WebSocket
ws

testConversationWithoutFederation :: (HasCallStack) => App ()
testConversationWithoutFederation :: HasCallStack => App ()
testConversationWithoutFederation = ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
  (ServiceOverrides
forall a. Default a => a
def {galleyCfg = removeField "federator" >=> removeField "rabbitmq"})
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    [alice, bob] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
domain, String
domain]
    void $ postConversation alice (defProteus {qualifiedUsers = [bob]}) >>= getJSON 201

testPostConvWithUnreachableRemoteUsers :: App ()
testPostConvWithUnreachableRemoteUsers :: App ()
testPostConvWithUnreachableRemoteUsers = do
  [alice, alex] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  resourcePool <- asks resourcePool
  runCodensity (acquireResources 2 resourcePool) $ \[BackendResource
unreachableBackend, BackendResource
reachableBackend] -> do
    Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
reachableBackend ServiceOverrides
forall a. Monoid a => a
mempty) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      unreachableUsers <- 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
unreachableBackend ServiceOverrides
forall a. Monoid a => a
mempty) ((String -> App [Value]) -> App [Value])
-> (String -> App [Value]) -> App [Value]
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
        let downDomain :: String
downDomain = BackendResource
unreachableBackend.berDomain
        ownDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OwnDomain
        otherDomain <- asString OtherDomain
        void $ BrigI.createFedConn downDomain (BrigI.FedConn ownDomain "full_search" Nothing)
        void $ BrigI.createFedConn downDomain (BrigI.FedConn otherDomain "full_search" Nothing)
        users <- replicateM 3 (randomUser downDomain def)
        for_ users $ \Value
user -> do
          [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
user]
          [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alex, Value
user]
        -- creating the conv here would work.
        pure users

      reachableUsers <- replicateM 2 (randomUser reachableBackend.berDomain def)
      for_ reachableUsers $ \Value
user -> do
        [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
user]
        [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alex, Value
user]

      withWebSockets [alice, alex] $ \[WebSocket
wssAlice, WebSocket
wssAlex] -> do
        -- unreachableBackend is still allocated, but the backend is down.  creating the conv here doesn't work.
        let payload :: CreateConv
payload = CreateConv
defProteus {name = Just "some chat", qualifiedUsers = [alex] <> reachableUsers <> unreachableUsers}
        Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
payload App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
533

        convs <- Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
getAllConvs Value
alice
        for_ convs $ \Value
conv -> Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldNotMatchInt` Int
0
        assertNoEvent 2 wssAlice
        assertNoEvent 2 wssAlex

testNoFederationWithProteus :: (HasCallStack) => App ()
testNoFederationWithProteus :: HasCallStack => App ()
testNoFederationWithProteus = do
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ( ServiceOverrides
forall a. Default a => a
def
        { galleyCfg = \Value
conf ->
            Value
conf Value -> (Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> [String] -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"settings.federationProtocols" [String
"mls"]
        }
    )
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      charlieDomain <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain
      [alice, alex, arnold, bob] <- createAndConnectUsers [domain, domain, domain, charlieDomain]

      do
        conv <- postConversation alice defProteus {qualifiedUsers = [alex]} >>= getJSON 201
        bindResponse (addMembers alice conv def {users = [bob]}) $ \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
"federation-disabled-for-protocol"
        void $ addMembers alice conv def {users = [arnold]} >>= getJSON 200

      bindResponse (postConversation alice defProteus {qualifiedUsers = [bob]}) $ \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
"federation-disabled-for-protocol"

      void $ postConversation bob defProteus {qualifiedUsers = [alice]} >>= getJSON 201

testGetConversationInternal :: (HasCallStack) => App ()
testGetConversationInternal :: HasCallStack => App ()
testGetConversationInternal = 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
2
  conv <- postConversation owner (defProteus {team = Just tid, qualifiedUsers = mems}) >>= getJSON 201
  I.getConversation conv `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
"qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
conv
    members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
    memberIds <- for members (%. "qualified_id")
    memberIds `shouldMatchSet` (for (owner : mems) (%. "qualified_id"))
    lookupField resp.json "members.self" `shouldMatch` (Nothing @Value)

testGetSelfMember :: (HasCallStack) => App ()
testGetSelfMember :: HasCallStack => App ()
testGetSelfMember = do
  [alice, bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  conv <-
    postConversation alice (defProteus {qualifiedUsers = [bob], newUsersRole = "wire_member"})
      >>= getJSON 201
  bindResponse (getSelfMember alice conv) $ \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
"conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_admin"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"hidden" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"hidden_ref" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"otr_archived" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"otr_archived_ref" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"otr_muted_ref" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"otr_muted_status" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"service" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status_ref" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"0.0"

  bindResponse (getSelfMember bob conv) $ \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
"conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_member"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"hidden" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"hidden_ref" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"otr_archived" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"otr_archived_ref" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"otr_muted_ref" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"otr_muted_status" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"service" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status_ref" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"0.0"

testReplaceMembers :: (HasCallStack) => App ()
testReplaceMembers :: HasCallStack => App ()
testReplaceMembers = do
  [alice, bob, charlie, dylan] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  conv <- postConversation alice (defProteus {qualifiedUsers = [bob, charlie]}) >>= getJSON 201

  -- Replace members: remove bob, add dylan, keep charlie
  [charlieId, dylanId] <- for [charlie, dylan] (%. "qualified_id")
  bindResponse (replaceMembers alice conv def {users = [charlieId, dylanId]}) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- Verify conversation members
  bindResponse (getConversation dylan conv) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    mems <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
    memIds <- forM mems (%. "qualified_id")
    memIds `shouldMatchSet` [charlieId]

testReplaceMembersUnchanged :: (HasCallStack) => App ()
testReplaceMembersUnchanged :: HasCallStack => App ()
testReplaceMembersUnchanged = do
  [alice, bob, charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  conv <- postConversation alice (defProteus {qualifiedUsers = [bob, charlie]}) >>= getJSON 201

  -- Replace members with the same set
  [bobId, charlieId] <- for [bob, charlie] (%. "qualified_id")
  bindResponse (replaceMembers alice conv def {users = [bobId, charlieId]}) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

testReplaceMembersEmptyConversation :: (HasCallStack) => App ()
testReplaceMembersEmptyConversation :: HasCallStack => App ()
testReplaceMembersEmptyConversation = do
  [alice, bob, charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  conv <- postConversation alice defProteus >>= getJSON 201

  -- Start with empty conversation, add members via replace
  [bobId, charlieId] <- for [bob, charlie] (%. "qualified_id")
  bindResponse (replaceMembers alice conv def {users = [bobId, charlieId]}) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- Verify conversation members
  bindResponse (getConversation charlie conv) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    mems <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
    memIds <- forM mems (%. "qualified_id")
    memIds `shouldMatchSet` [bobId]

testReplaceMembersPermissionDenied :: (HasCallStack) => App ()
testReplaceMembersPermissionDenied :: HasCallStack => App ()
testReplaceMembersPermissionDenied = do
  [alice, bob, charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OwnDomain]
  conv <- postConversation alice (defProteus {qualifiedUsers = [bob, charlie], newUsersRole = "wire_member"}) >>= getJSON 201

  -- Try to replace members as non-admin bob (who has wire_member role)
  charlieId <- charlie %. "qualified_id"
  bindResponse (replaceMembers bob conv def {users = [charlieId]}) $ \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
"action-denied"

testReplaceMembersConvNotFound :: (HasCallStack) => App ()
testReplaceMembersConvNotFound :: HasCallStack => App ()
testReplaceMembersConvNotFound = 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
  bob <- randomUser OwnDomain def
  connectTwoUsers alice bob

  -- Create a fake conversation ID
  domain <- objDomain alice
  let fakeConv = [Pair] -> Value
object [String
"qualified_id" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object [String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"00000000-0000-0000-0000-000000000000" :: String), String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
domain]]

  bobId <- bob %. "qualified_id"
  bindResponse (replaceMembers alice fakeConv def {users = [bobId]}) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404
    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
"no-conversation"

testReplaceMembersConvNotFoundOtherDomain :: (HasCallStack) => App ()
testReplaceMembersConvNotFoundOtherDomain :: HasCallStack => App ()
testReplaceMembersConvNotFoundOtherDomain = 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
  bob <- randomUser OwnDomain def
  connectTwoUsers alice bob

  -- Create a fake conversation ID
  let fakeConv = [Pair] -> Value
object [String
"qualified_id" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object [String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"00000000-0000-0000-0000-000000000000" :: String), String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"other.example.com" :: String)]]

  bobId <- bob %. "qualified_id"
  bindResponse (replaceMembers alice fakeConv def {users = [bobId]}) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
422
    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
"federation-not-implemented"