{-# 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.
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus 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

  Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
bob ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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. MakesValue a => a -> App Bool
isMemberJoinNotif WebSocket
bobWs

  Value -> Value -> [Value] -> App ()
forall user.
(HasCallStack, MakesValue user) =>
Value -> user -> [Value] -> App ()
checkConvMembers Value
conv Value
alice [Value
bob]
  App () -> App ()
forall a. App a -> App a
retryT (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> [Value] -> App ()
forall user.
(HasCallStack, MakesValue user) =>
Value -> user -> [Value] -> App ()
checkConvMembers Value
conv Value
bob [Value
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
        [Value]
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
        [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
mems (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 ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
others (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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
    [String
domainA, String
domainB, String
domainC] <- [String] -> App [String]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
dynDomains
    Value
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}
    Value
uidB <- 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}
    Value
uidC <- 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}
    Value -> String -> String -> App ()
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App ()
assertConnected Value
uidA String
domainB String
domainC
    Value -> String -> String -> App ()
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App ()
assertConnected Value
uidB String
domainA String
domainC
    Value -> String -> String -> App ()
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App ()
assertConnected Value
uidC String
domainA String
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
    Value
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}
    App () -> App ()
forall a. App a -> App a
retryT
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
        (Value -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getFederationStatus Value
uidA [String
domainB, String
domainC])
      ((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
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
      ]
    Value
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}
    Value
uidB <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainB CreateUser
forall a. Default a => a
def {BrigI.team = True}
    Value
uidC <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainC CreateUser
forall a. Default a => a
def {BrigI.team = True}
    let assertConnected :: 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"
    App () -> App ()
forall a. App a -> App a
retryT (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> App ()
forall {user}.
MakesValue user =>
user -> String -> String -> App ()
assertConnected Value
uidA String
domainB String
domainC
    App () -> App ()
forall a. App a -> App a
retryT (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> App ()
forall {user}.
MakesValue user =>
user -> String -> String -> App ()
assertConnected Value
uidB String
domainA String
domainC
    App () -> App ()
forall a. App a -> App a
retryT (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> App ()
forall {user}.
MakesValue user =>
user -> String -> String -> App ()
assertConnected Value
uidC String
domainA String
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
    Value
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}
    App () -> App ()
forall a. App a -> App a
retryT
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
        (Value -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getFederationStatus Value
uidA [String
domainB, String
domainC])
      ((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
"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
  Value
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}
  String
federatingRemoteDomain <- StaticDomain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString StaticDomain
domain
  let invalidDomain :: String
invalidDomain = String
"c.example.com" -- Does not have any srv records
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    (Value -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getFederationStatus Value
uid [])
    ((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"

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    (Value -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getFederationStatus Value
uid [String
invalidDomain])
    ((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
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]

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    (Value -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getFederationStatus Value
uid [String
federatingRemoteDomain])
    ((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"

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
    [Value
u1, Value
u2, Value
u3] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [String
domainA, String
domainB, String
domainC]
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
u1 Value
u2
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
u1 Value
u3
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
u1 (CreateConv
defProteus {qualifiedUsers = [u2, u3]})) ((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
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)

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

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
u1 (CreateConv
defProteus {qualifiedUsers = [u2, u3]})) ((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
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
    [Value
u1, Value
u2, Value
u3] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [String
domainA, String
domainB, String
domainC]
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
u1 Value
u2
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
u1 Value
u3
    -- create conversation with no users
    Value
cid <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
u1 (CreateConv
defProteus {qualifiedUsers = []}) 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
    -- add members from remote backends
    [Value]
members <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
u2, Value
u3] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
u1 Value
cid AddMembers
forall a. Default a => a
def {users = members}) ((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
      [Value]
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
      [Value]
addedUsers <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
users (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      [Value]
addedUsers [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value]
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
    Value
u1 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def
    Value
u2 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainB CreateUser
forall a. Default a => a
def
    Value
u3 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainC CreateUser
forall a. Default a => a
def
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
u1 Value
u2
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
u1 Value
u3

    -- create conversation with no users
    Value
cid <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
u1 (CreateConv
defProteus {qualifiedUsers = []}) 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
    -- add members from remote backends
    [Value]
members <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
u2, Value
u3] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
u1 Value
cid AddMembers
forall a. Default a => a
def {users = members}) ((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
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
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
aliceId <- Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  -- create conversation with no users
  Value
cid <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus 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
  Value
bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
bobId <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  let addMember :: App Response
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]}
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse App Response
addMember ((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
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"
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse App Response
addMember ((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
"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
    [Value]
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
    [Value]
addedUsers <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
users (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    [Value]
addedUsers [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value
bobId]

  -- check that both users can see the conversation
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
cid) ((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
    [Value]
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
    Value
mem <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
mems
    Value
mem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
bobId
    Value
mem 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"

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
cid) ((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
    [Value]
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
    Value
mem <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
mems
    Value
mem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
aliceId
    Value
mem 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"

testAddMemberV1 :: (HasCallStack) => Domain -> App ()
testAddMemberV1 :: HasCallStack => Domain -> App ()
testAddMemberV1 Domain
domain = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
domain]
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus 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
  Value
bobId <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  let opts :: AddMembers
opts =
        AddMembers
forall a. Default a => a
def
          { version = Just 1,
            role = Just "wire_member",
            users = [bobId]
          }
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
opts) ((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
"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
    [Value]
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
    (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_id") [Value]
users App [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value
bobId]

testConvWithUnreachableRemoteUsers :: (HasCallStack) => StaticDomain -> App ()
testConvWithUnreachableRemoteUsers :: HasCallStack => StaticDomain -> App ()
testConvWithUnreachableRemoteUsers StaticDomain
domain = do
  ([Value
alice, Value
alex, Value
bob, Value
charlie, Value
dylan], [String]
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
      String
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
      String
other <- StaticDomain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make StaticDomain
domain 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
      users :: [Value]
users@(Value
alice : [Value]
others) <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers ([String] -> App [Value]) -> [String] -> App [Value]
forall a b. (a -> b) -> a -> b
$ [String
own, String
own, String
other] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
domains
      [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value]
others ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice
      ([Value], [String]) -> App ([Value], [String])
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value]
users, [String]
domains)

  let newConv :: CreateConv
newConv = CreateConv
defProteus {qualifiedUsers = [alex, bob, charlie, dylan]}
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
newConv) ((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
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

  [Value]
convs <- Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
getAllConvs Value
alice 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
  [Value]
regConvs <- (Value -> App Bool) -> [Value] -> App [Value]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
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) [Value]
convs
  [Value]
regConvs [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])

testAddUserWithUnreachableRemoteUsers :: (HasCallStack) => StaticDomain -> App ()
testAddUserWithUnreachableRemoteUsers :: HasCallStack => StaticDomain -> App ()
testAddUserWithUnreachableRemoteUsers StaticDomain
domain = do
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  String
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
  String
other <- StaticDomain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make StaticDomain
domain 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
  Codensity App [BackendResource]
-> forall b. ([BackendResource] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
1 ResourcePool BackendResource
resourcePool) (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
cDom] -> do
    ([Value
alex, Value
bobId, Value
bradId, Value
chrisId], Value
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
      [Value
alice, Value
alex, Value
bob, Value
brad, Value
charlie, Value
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
newConv = CreateConv
defProteus {qualifiedUsers = [alex, charlie]}
      Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
newConv 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
      [Value
bobId, Value
bradId, Value
chrisId] <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value
bob, Value
brad, Value
chris] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
      ([Value], Value) -> App ([Value], Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value
alex, Value
bobId, Value
bradId, Value
chrisId], Value
conv)

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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]}) ((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
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]

    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 ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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.
    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 = [bradId]} 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

    -- assert an unreachable user cannot be added
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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 = [chrisId]}) ((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
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 BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  Codensity App [BackendResource]
-> forall b. ([BackendResource] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
1 ResourcePool BackendResource
resourcePool) (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
cDom] -> do
    (Value
alice, Value
chadId, Value
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
      String
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
      String
otherDomain <- StaticDomain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make StaticDomain
domain App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      [Value
alice, Value
bob, Value
charlie, Value
chad] <-
        [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
ownDomain, String
otherDomain, BackendResource
cDom.berDomain, BackendResource
cDom.berDomain]

      Value
conv <- [Value] -> ([WebSocket] -> App Value) -> App Value
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
bob, Value
charlie] (([WebSocket] -> App Value) -> App Value)
-> ([WebSocket] -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \[WebSocket]
wss -> do
        Value
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
        [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [WebSocket]
wss ((WebSocket -> App Value) -> App ())
-> (WebSocket -> 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. MakesValue a => a -> App Bool
isMemberJoinNotif
        Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
conv
      Value
chadId <- Value
chad Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
      (Value, Value, Value) -> App (Value, Value, Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
alice, Value
chadId, Value
conv)

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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 = [chadId]}) ((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
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
  ([Value
alex, Value
charlie], [String
charlieDomain, String
dylanDomain], Value
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
      String
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
      [Value
alice, Value
alex, Value
charlie, Value
dylan] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers ([String] -> App [Value]) -> [String] -> App [Value]
forall a b. (a -> b) -> a -> b
$ [String
own, String
own] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
domains
      [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value
alex, Value
charlie, Value
dylan] ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice

      let newConv :: CreateConv
newConv = CreateConv
defProteus {qualifiedUsers = [alex, dylan]}
      Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
newConv 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
      Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alex Value
charlie
      ([Value], [String], Value) -> App ([Value], [String], Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value
alex, Value
charlie], [String]
domains, Value
conv)

  Value
charlieId <- Value
charlie Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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 = [charlieId]}) ((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
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
  Value
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
shouldBeLocal = Bool
True
  (Value
d2Usr, Value
d2ConvId) <- StaticDomain -> Bool -> Value -> App (Value, Value)
forall domain a.
(MakesValue domain, MakesValue a) =>
domain -> Bool -> a -> App (Value, Value)
generateRemoteAndConvIdWithDomain StaticDomain
domain (Bool -> Bool
not Bool
shouldBeLocal) Value
d1User
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
d1User Value
d2Usr) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ListConversationIds -> App Response
forall user.
MakesValue user =>
user -> ListConversationIds -> App Response
listConversationIds Value
d1User ListConversationIds
forall a. Default a => a
def) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
r -> do
    Response
r.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
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
    (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(==) Value
d2ConvId) [Value]
convIds [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value
d2ConvId]
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getConnections Value
d1User) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
r -> do
    [Value]
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")
    (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(==) Value
d2ConvId) [Value]
qConvIds [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value
d2ConvId]
  Response
resp <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
d1User Value
d2ConvId
  Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
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
    String
own <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OwnDomain
    String
other <- StaticDomain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString StaticDomain
domain

    -- Ensure that dynamic backend only federates with own domain, but not other
    -- domain.
    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
dynBackend (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
own String
"full_search" Maybe [String]
forall a. Maybe a
Nothing)

    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
own CreateUser
forall a. Default a => a
def
    Value
bob <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
other CreateUser
forall a. Default a => a
def
    Value
charlie <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynBackend CreateUser
forall a. Default a => a
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
    (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (App () -> App ()
forall a. App a -> App a
retryT (App () -> App ()) -> (Value -> App ()) -> Value -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice) [Value
bob, Value
charlie]

    let newConv :: CreateConv
newConv = CreateConv
defProteus {qualifiedUsers = []}
    Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
newConv 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

    Value
bobId <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
    Value
charlieId <- Value
charlie Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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 = [bobId, charlieId]}) ((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
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
    Text
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

    (Value
user, String
_, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
    Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
user (CreateConv -> CreateConv
allowGuests CreateConv
defProteus) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> Maybe String -> App Response
postConversationCode Value
user Value
conv Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
      Value
res 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.code-update"
      Text
guestLink <- Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.uri" 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
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"guestlink incorrect" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Text
configuredURI Text -> Text -> Bool
`T.isPrefixOf` Text
guestLink

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> App Response
getConversationCode Value
user Value
conv Maybe String
forall a. Maybe a
Nothing) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
      Text
guestLink <- Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"uri" 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
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"guestlink incorrect" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Text
configuredURI Text -> Text -> Bool
`T.isPrefixOf` Text
guestLink

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> App Response
getConversationCode Value
user Value
conv (String -> Maybe String
forall a. a -> Maybe a
Just String
"red.example.com")) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
      Text
guestLink <- Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"uri" 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
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"guestlink incorrect" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Text
configuredURI Text -> Text -> Bool
`T.isPrefixOf` Text
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
      (Value
user, String
_, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
      Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
user (CreateConv -> CreateConv
allowGuests CreateConv
defProteus) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> Maybe String -> App Response
postConversationCode Value
user Value
conv Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
"red.example.com")) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
        Value
res 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.code-update"
        Text
guestLink <- Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.uri" 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
        HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"guestlink incorrect" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ (String -> Text
forall a. IsString a => String -> a
fromString String
"https://red.example.com") Text -> Text -> Bool
`T.isPrefixOf` Text
guestLink

      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> App Response
getConversationCode Value
user Value
conv (String -> Maybe String
forall a. a -> Maybe a
Just String
"red.example.com")) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
        Text
guestLink <- Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"uri" 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
        HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"guestlink incorrect" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ (String -> Text
forall a. IsString a => String -> a
fromString String
"https://red.example.com") Text -> Text -> Bool
`T.isPrefixOf` Text
guestLink

      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> App Response
getConversationCode Value
user Value
conv (String -> Maybe String
forall a. a -> Maybe a
Just String
"blue.example.com")) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
        Text
guestLink <- Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"uri" 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
        HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"guestlink incorrect" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ (String -> Text
forall a. IsString a => String -> a
fromString String
"https://blue.example.com") Text -> Text -> Bool
`T.isPrefixOf` Text
guestLink

      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> App Response
getConversationCode Value
user Value
conv Maybe String
forall a. Maybe a
Nothing) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
403 Response
resp
        Value
res 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
"access-denied"

      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> App Response
getConversationCode Value
user Value
conv (String -> Maybe String
forall a. a -> Maybe a
Just String
"unknown.example.com")) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
403 Response
resp
        Value
res 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
"access-denied"

testAddUserWhenOtherBackendOffline :: (HasCallStack) => App ()
testAddUserWhenOtherBackendOffline :: HasCallStack => App ()
testAddUserWhenOtherBackendOffline = do
  ([Value
alice, Value
alex], Value
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
      String
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
      [Value
alice, Value
alex, Value
charlie] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers ([String] -> App [Value]) -> [String] -> App [Value]
forall a b. (a -> b) -> a -> b
$ [String
own, String
own] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
domains
      [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value
alex, Value
charlie] ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice

      let newConv :: CreateConv
newConv = CreateConv
defProteus {qualifiedUsers = [charlie]}
      Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
newConv 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
      ([Value], Value) -> App ([Value], Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value
alice, Value
alex], Value
conv)
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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 = [alex]}) ((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

testSynchroniseUserRemovalNotification :: (HasCallStack) => StaticDomain -> App ()
testSynchroniseUserRemovalNotification :: HasCallStack => StaticDomain -> App ()
testSynchroniseUserRemovalNotification StaticDomain
domain = do
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  Value
ownDomain <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain
  Value
otherDomain <- StaticDomain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make StaticDomain
domain
  [Value
alice, Value
bob] <- [Value] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Value
ownDomain, Value
otherDomain]
  Codensity App [BackendResource]
-> forall b. ([BackendResource] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
1 ResourcePool BackendResource
resourcePool) (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
dynBackend] -> do
    (Value
conv, Value
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
        Value
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
        (Value -> App ()) -> [Value] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
charlie) [Value
alice, Value
bob]
        Value
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
        (Value, Value) -> App (Value, Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
conv, Value
charlie)

    let newConvName :: String
newConvName = String
"The new conversation name"
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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
charlie) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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 ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      Value
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
      Value
nameNotif Value -> 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
      Value
nameNotif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newConvName
      Value
leaveNotif <- 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. MakesValue a => a -> App Bool
isConvLeaveNotif
      Value
leaveNotif Value -> 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

testConvRenaming :: (HasCallStack) => App ()
testConvRenaming :: HasCallStack => App ()
testConvRenaming = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  Value
conv <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [bob]})
      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
  let newConvName :: String
newConvName = String
"The new conversation name"
  [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
bob] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[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
      Value
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
      Value
nameNotif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newConvName
      Value
nameNotif Value -> 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

testNewConversationReceiptMode :: (HasCallStack) => ConversationProtocol -> App ()
testNewConversationReceiptMode :: HasCallStack => ConversationProtocol -> App ()
testNewConversationReceiptMode ConversationProtocol
proto = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (ConversationProtocol -> CreateConv
defConv ConversationProtocol
proto) {receiptMode = Just 11} 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
  let expectedReceiptMode :: Int
expectedReceiptMode = case ConversationProtocol
proto of
        ConversationProtocol
ConversationProtocolProteus -> Int
11
        ConversationProtocol
ConversationProtocolMLS -> Int
0
  Value
conv 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
expectedReceiptMode

testConversationReceiptModeUpdate :: (HasCallStack) => ConversationProtocol -> App ()
testConversationReceiptModeUpdate :: HasCallStack => ConversationProtocol -> App ()
testConversationReceiptModeUpdate ConversationProtocol
proto = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (ConversationProtocol -> CreateConv
defConv ConversationProtocol
proto) {receiptMode = Just 11} 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
  Int
receiptMode <- App Response -> (Response -> App Int) -> App Int
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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
12 :: Int)) ((Response -> App Int) -> App Int)
-> (Response -> App Int) -> App Int
forall a b. (a -> b) -> a -> b
$ \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

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice 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
    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
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  Value
conv <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [bob]})
      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
  [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
bob] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[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
      Value
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
      Value
notif Value -> 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
      Value
notif Value -> 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
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.receipt_mode" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
43

testReceiptModeWithRemotesUnreachable :: (HasCallStack) => App ()
testReceiptModeWithRemotesUnreachable :: HasCallStack => App ()
testReceiptModeWithRemotesUnreachable = do
  String
ownDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OwnDomain
  Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
ownDomain CreateUser
forall a. Default a => a
def
  Value
conv <- [ServiceOverrides] -> ([String] -> App Value) -> App Value
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [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
dynBackend] -> do
    Value
bob <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynBackend CreateUser
forall a. Default a => a
def
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [bob]})
      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
  Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
alice ((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 -> 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
    Value
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
    Value
notif Value -> 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
    Value
notif Value -> 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
    Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.receipt_mode" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
43

testDeleteLocalMember :: (HasCallStack) => App ()
testDeleteLocalMember :: HasCallStack => App ()
testDeleteLocalMember = do
  [Value
alice, Value
alex, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain]
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
alex
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  Value
conv <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [alex, bob]})
      App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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
alex) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Value
r <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
    Value
r 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-leave"
    Value
r 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
    Value
r 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
    Value
r Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.qualified_user_ids.0" 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
alex
  -- Now that Alex is gone, try removing her once again
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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
alex) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  [Value
alice, Value
alex, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain]
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
alex
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  Value
conv <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [alex, bob]})
      App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Value
r <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp
    Value
r 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-leave"
    Value
r 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
    Value
r 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
    Value
r Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.qualified_user_ids.0" 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
bob
  -- Now that Bob is gone, try removing him once again
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  [Value
alice, Value
bob, Value
bart] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OtherDomain, Domain
OtherDomain]
  Value
conv <- [ServiceOverrides] -> ([String] -> App Value) -> App Value
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [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
dynBackend] -> do
    Value
charlie <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynBackend CreateUser
forall a. Default a => a
def
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bart
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
charlie
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation
      Value
alice
      (CreateConv
defProteus {qualifiedUsers = [bob, bart, 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
  App [()] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [()] -> App ()) -> App [()] -> App ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ([WebSocket] -> App [()]) -> App [()]
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
bob] (([WebSocket] -> App [()]) -> App [()])
-> ([WebSocket] -> App [()]) -> App [()]
forall a b. (a -> b) -> a -> b
$ \[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
      Value
leaveNotif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isConvLeaveNotif WebSocket
ws
      Value
leaveNotif Value -> 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
      Value
leaveNotif Value -> 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
      Value
leaveNotif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.qualified_user_ids.0" 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
bob
  -- Now that Bob is gone, try removing him once again
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  (Value
alice, String
team, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {team = Just team}) 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
  Value
bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OtherDomain CreateUser
forall a. Default a => a
def
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  Value
mem <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  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
alice Value
conv AddMembers
forall a. Default a => a
def {users = [mem]} 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

  App [()] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [()] -> App ()) -> App [()] -> App ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ([WebSocket] -> App [()]) -> App [()]
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
bob] (([WebSocket] -> App [()]) -> App [()])
-> ([WebSocket] -> App [()]) -> App [()]
forall a b. (a -> b) -> a -> b
$ \[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
      Value
notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isConvDeleteNotif WebSocket
ws
      Value
notif Value -> 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
      Value
notif Value -> 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

testDeleteTeamConversationWithUnreachableRemoteMembers :: (HasCallStack) => App ()
testDeleteTeamConversationWithUnreachableRemoteMembers :: HasCallStack => App ()
testDeleteTeamConversationWithUnreachableRemoteMembers = do
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  (Value
alice, String
team, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {team = Just team}) 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

  let assertNotification :: (HasCallStack, MakesValue n) => n -> App ()
      assertNotification :: forall n. (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

  Codensity App [BackendResource]
-> forall b. ([BackendResource] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
1 ResourcePool BackendResource
resourcePool) (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
dynBackend] -> do
    Value
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
      Value
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
      Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
      Value
mem <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
      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
alice Value
conv AddMembers
forall a. Default a => a
def {users = [mem]} 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
      Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
bob
    Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
alice ((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
$ 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
      Value
notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isConvDeleteNotif WebSocket
ws
      Value -> App ()
forall n. (HasCallStack, MakesValue n) => n -> App ()
assertNotification Value
notif
    App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ 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 ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      Value
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. MakesValue a => a -> App Bool
isConvDeleteNotif
      Value -> App ()
forall n. (HasCallStack, MakesValue n) => n -> App ()
assertNotification Value
notif

testDeleteTeamMemberLimitedEventFanout :: (HasCallStack) => App ()
testDeleteTeamMemberLimitedEventFanout :: HasCallStack => App ()
testDeleteTeamMemberLimitedEventFanout = do
  -- Alex will get removed from the team
  (Value
alice, String
team, [Value
alex, Value
alison]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  Value
ana <- Value -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
alice CreateTeamMember
forall a. Default a => a
def {role = "admin"}
  [Value
amy, Value
bob] <- [Domain] -> (Domain -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Domain
OwnDomain, Domain
OtherDomain] ((Domain -> App Value) -> App [Value])
-> (Domain -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ (Domain -> CreateUser -> App Value)
-> CreateUser -> Domain -> App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser CreateUser
forall a. Default a => a
def
  [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value
amy, Value
bob] ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice
  [Value
aliceId, Value
alexId, Value
amyId, Value
alisonId, Value
anaId, Value
bobId] <- do
    [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value
alice, Value
alex, Value
amy, Value
alison, Value
ana, Value
bob] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
  let nc :: CreateConv
nc =
        ( CreateConv
defProteus
            { qualifiedUsers =
                [alexId, amyId, alisonId, anaId, bobId],
              team = Just team
            }
        )
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
nc 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
  [Value]
memsBefore <- String -> Value -> App [Value]
forall {user} {tid}.
(MakesValue user, MakesValue tid) =>
tid -> user -> App [Value]
getMembers String
team Value
aliceId

  -- Only the team admins will get the team-level event about Alex being removed
  -- from the team
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Domain -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Domain
OwnDomain String
team String
"limitedEventFanout" String
"enabled"

  [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
amy, Value
bob, Value
alison, Value
ana]
    (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[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

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

      WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsAmy Value
alexId
      WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsAlison Value
alexId

      Value
alexUId <- Value
alex Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
      do
        Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isTeamMemberLeaveNotif WebSocket
wsAlice
        Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.user" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
alexUId
        WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsAlice Value
alexId
      do
        Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isTeamMemberLeaveNotif WebSocket
wsAna
        Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.user" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
alexUId
        WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsAna Value
alexId
      do
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob 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
          [Value]
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
          [Value]
memIds <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
mems (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
          [Value]
memIds [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value
aliceId, Value
alisonId, Value
amyId, Value
anaId]
        WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsBob Value
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
      [Value]
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
      [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
ms ((Value -> App Value) -> App [Value])
-> (Value -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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
  (Value
alice, String
team, [Value
alex, Value
alison]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  [Value
amy, Value
bob] <- [Domain] -> (Domain -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Domain
OwnDomain, Domain
OtherDomain] ((Domain -> App Value) -> App [Value])
-> (Domain -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ (Domain -> CreateUser -> App Value)
-> CreateUser -> Domain -> App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser CreateUser
forall a. Default a => a
def
  [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value
amy, Value
bob] ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice
  [Value
aliceId, Value
alexId, Value
alisonId, Value
amyId, Value
bobId] <-
    [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value
alice, Value
alex, Value
alison, Value
amy, Value
bob] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
  let nc :: CreateConv
nc = (CreateConv
defProteus {qualifiedUsers = [alexId, alisonId, amyId, bobId], team = Just team})
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
nc 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
  [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
alison, Value
amy, Value
bob] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[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
    Value
alexUId <- Value
alex Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
    do
      Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isTeamMemberLeaveNotif WebSocket
wsAlice
      Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.user" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
alexUId
    do
      Value
t <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isTeamMemberLeaveNotif WebSocket
wsAlison
      Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
t App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.user" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
alexUId
      WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsAlison Value
alexId

    WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsAmy Value
alexId

    do
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob 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
        [Value]
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
        [Value]
memIds <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
mems (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
        [Value]
memIds [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value
aliceId, Value
alisonId, Value
amyId]
      WebSocket -> Value -> App ()
forall leaverId.
MakesValue leaverId =>
WebSocket -> leaverId -> App ()
assertConvUserDeletedNotif WebSocket
wsBob Value
alexId

testLeaveConversationSuccess :: (HasCallStack) => App ()
testLeaveConversationSuccess :: HasCallStack => App ()
testLeaveConversationSuccess = do
  [Value
alice, Value
bob, Value
chad, Value
dee] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OwnDomain, Domain
OtherDomain, Domain
OtherDomain]
  [String
aClient, String
bClient] <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value
alice, Value
bob] ((Value -> App String) -> App [String])
-> (Value -> App String) -> App [String]
forall a b. (a -> b) -> a -> b
$ \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
  [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
    Value
eve <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynDomain CreateUser
forall a. Default a => a
def
    String
eClient <- 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
eve 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
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value
bob, Value
chad, Value
dee, Value
eve] ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice
    Value
conv <-
      Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation
        Value
alice
        ( CreateConv
defProteus
            { qualifiedUsers = [bob, chad, dee, eve]
            }
        )
        App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
    App 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
chad Value
conv Value
chad 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
    Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
chad Value
conv Value
alice String
aClient Value
chad
    Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
chad Value
conv Value
bob String
bClient Value
chad
    Value -> Value -> Value -> String -> Value -> App ()
forall fromUser conv user kickedUser.
(HasCallStack, MakesValue fromUser, MakesValue conv,
 MakesValue user, MakesValue kickedUser) =>
fromUser -> conv -> user -> String -> kickedUser -> App ()
assertLeaveNotification Value
chad Value
conv Value
eve String
eClient Value
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
    [String
ownDomain, String
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
    [Value
alice, Value
alex, Value
bob, Value
bart, Value
chad] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [String
ownDomain, String
ownDomain, String
otherDomain, String
otherDomain, String
dynDomain]
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value
alex, Value
bob, Value
bart, Value
chad] ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice
    Value
bobId <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
    Value
ooConvId <-
      HasCallStack => Value -> Value -> One2OneConvState -> App Value
Value -> Value -> One2OneConvState -> App Value
getOne2OneConversation Value
alice Value
bobId One2OneConvState
Established 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 -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")

    Value
mainConvBefore <-
      Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [alex, bob, bart, chad]})
        App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

    App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
alex ((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 -> 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
      Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isConvLeaveNotif WebSocket
ws
      Value
n Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.qualified_from" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
bobId
      Value
n Value -> 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
mainConvBefore Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")

      do
        -- Bob is not in the one-to-one conversation with Alice any more
        Value
conv <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
ooConvId 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 a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others"
      do
        -- Bob is not in the main conversation any more
        Value
mainConvAfter <- Value -> App Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice (Value
mainConvBefore Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
        [Value]
mems <- Value
mainConvAfter 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
        [Value]
memIds <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
mems (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
        [Value]
expectedIds <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value
alex, Value
bart, Value
chad] (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
        [Value]
memIds [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value]
expectedIds

testUpdateConversationByRemoteAdmin :: (HasCallStack) => App ()
testUpdateConversationByRemoteAdmin :: HasCallStack => App ()
testUpdateConversationByRemoteAdmin = do
  [Value
alice, Value
bob, Value
charlie] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [Domain
OwnDomain, Domain
OtherDomain, Domain
OtherDomain]
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
charlie
  Value
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
  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 Value -> App Response
forall callerUser targetUser roleUpdate qcnv.
(HasCallStack, MakesValue callerUser, MakesValue targetUser,
 MakesValue roleUpdate, MakesValue qcnv) =>
callerUser -> targetUser -> roleUpdate -> qcnv -> App Response
updateRole Value
alice Value
bob String
"wire_admin" (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") 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
  App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
bob, Value
charlie] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[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
  Value
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}
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus) ((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
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
  (Value
user, String
_, Value
tm : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
user (CreateConv -> CreateConv
allowGuests CreateConv
defProteus) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  (String
k, String
v) <- App Response
-> (Response -> App (String, String)) -> App (String, String)
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> Maybe String -> App Response
postConversationCode Value
user Value
conv Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) ((Response -> App (String, String)) -> App (String, String))
-> (Response -> App (String, String)) -> App (String, String)
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
    String
k <- Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.key" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
    String
v <- Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.code" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
    (String, String) -> App (String, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
k, String
v)
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
getJoinCodeConv Value
tm String
k String
v) ((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
"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
      (Value
user, String
_, Value
tm : [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
2
      Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
user (CreateConv -> CreateConv
allowGuests CreateConv
defProteus) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
      (String
k, String
v) <- App Response
-> (Response -> App (String, String)) -> App (String, String)
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Maybe String -> Maybe String -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> Maybe String -> App Response
postConversationCode Value
user Value
conv Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) ((Response -> App (String, String)) -> App (String, String))
-> (Response -> App (String, String)) -> App (String, String)
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Value
res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
        (,) (String -> String -> (String, String))
-> App String -> App (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.key") App (String -> (String, String))
-> App String -> App (String, String)
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"data.code")
      -- let's wait a little longer than 1 second for the guest link to expire
      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
1_100_000)
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
getJoinCodeConv Value
tm String
k String
v) ((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
404

testConversationWithLegacyFed :: (HasCallStack) => AnyFedDomain -> App ()
testConversationWithLegacyFed :: HasCallStack => AnyFedDomain -> App ()
testConversationWithLegacyFed AnyFedDomain
domain = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
bob <- AnyFedDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser AnyFedDomain
domain CreateUser
forall a. Default a => a
def
  Int -> App () -> App ()
forall a. Int -> App a -> App a
withAPIVersion Int
4 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob

  Value
conv <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [bob]})
      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

  Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
bob ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    [Value
alice, Value
bob] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
domain, String
domain]
    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 -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [bob]}) 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

testPostConvWithUnreachableRemoteUsers :: App ()
testPostConvWithUnreachableRemoteUsers :: App ()
testPostConvWithUnreachableRemoteUsers = do
  [Value
alice, Value
alex] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  Codensity App [BackendResource]
-> forall b. ([BackendResource] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
2 ResourcePool BackendResource
resourcePool) (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[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
      [Value]
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
        String
ownDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OwnDomain
        String
otherDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OtherDomain
        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
downDomain (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
ownDomain 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
downDomain (String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
otherDomain String
"full_search" Maybe [String]
forall a. Maybe a
Nothing)
        [Value]
users <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
downDomain CreateUser
forall a. Default a => a
def)
        [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
users ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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.
        [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
users

      [Value]
reachableUsers <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser BackendResource
reachableBackend.berDomain CreateUser
forall a. Default a => a
def)
      [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
reachableUsers ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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]

      [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
alex] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[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

        [Value]
convs <- Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
getAllConvs Value
alice
        [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
convs ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
        HasCallStack => Int -> WebSocket -> App ()
Int -> WebSocket -> App ()
assertNoEvent Int
2 WebSocket
wssAlice
        HasCallStack => Int -> WebSocket -> App ()
Int -> WebSocket -> App ()
assertNoEvent Int
2 WebSocket
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
      String
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
      [Value
alice, Value
alex, Value
arnold, Value
bob] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
domain, String
domain, String
domain, String
charlieDomain]

      do
        Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [alex]} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (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]}) ((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
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"
        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 -> 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 = [arnold]} 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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [bob]}) ((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
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"

      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 -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
bob CreateConv
defProteus {qualifiedUsers = [alice]} 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

testGetConversationInternal :: (HasCallStack) => App ()
testGetConversationInternal :: HasCallStack => App ()
testGetConversationInternal = do
  (Value
owner, String
tid, [Value]
mems) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
owner (CreateConv
defProteus {team = Just tid, qualifiedUsers = mems}) 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
  Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
I.getConversation Value
conv App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json 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
    [Value]
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
    [Value]
memberIds <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
members (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    [Value]
memberIds [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Value
owner Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
mems) (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"))
    App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"members.self" App (Maybe Value) -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (forall a. Maybe a
Nothing @Value)

testGetSelfMember :: (HasCallStack) => App ()
testGetSelfMember :: HasCallStack => App ()
testGetSelfMember = do
  [Value
alice, Value
bob] <- [Domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [Domain
OwnDomain, Domain
OtherDomain]
  Value
conv <-
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [bob], newUsersRole = "wire_member"})
      App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getSelfMember Value
alice 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
    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"

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getSelfMember Value
bob 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
    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"