{-# 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
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

testDynamicBackendsFullyConnectedWhenAllowAll :: (HasCallStack) => App ()
testDynamicBackendsFullyConnectedWhenAllowAll :: HasCallStack => App ()
testDynamicBackendsFullyConnectedWhenAllowAll = do
  -- The default setting is 'allowAll'
  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a. [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. [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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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. [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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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. [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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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. [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. [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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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. [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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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. [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, String
client) <-
      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, String))
 -> App (Value, Value, String))
-> (String -> App (Value, Value, String))
-> App (Value, Value, String)
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
        String
client <- 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
charlie 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 -> 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, String) -> App (Value, Value, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
conv, Value
charlie, String
client)

    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 -> String -> Maybe Value -> (Value -> App Bool) -> App Value
forall user client lastNotifId.
(HasCallStack, MakesValue user, MakesValue client,
 MakesValue lastNotifId) =>
user
-> client -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
charlie String
client 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 -> String -> Maybe Value -> (Value -> App Bool) -> App Value
forall user client lastNotifId.
(HasCallStack, MakesValue user, MakesValue client,
 MakesValue lastNotifId) =>
user
-> client -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
charlie String
client 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

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. [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. [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, String
bobClient) <- 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, String)) -> App (Value, String))
-> (String -> App (Value, String)) -> App (Value, String)
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
      String
bobClient <- 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
bob 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 ()
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, String) -> App (Value, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
bob, String
bobClient)
    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 -> String -> Maybe Value -> (Value -> App Bool) -> App Value
forall user client lastNotifId.
(HasCallStack, MakesValue user, MakesValue client,
 MakesValue lastNotifId) =>
user
-> client -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
bob String
bobClient 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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. [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. [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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
conv

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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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 dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> 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