-- 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.Connection where

import API.Brig (getConnection, postConnection, putConnection)
import API.BrigInternal
import API.Galley
import Notifications
import SetupHelpers
import Testlib.Prelude
import Testlib.VersionedFed
import UnliftIO.Async (forConcurrently_)

testConnectWithRemoteUser :: (HasCallStack) => OneOf Domain AnyFedDomain -> App ()
testConnectWithRemoteUser :: HasCallStack => OneOf Domain AnyFedDomain -> App ()
testConnectWithRemoteUser OneOf Domain AnyFedDomain
owningDomain = do
  let otherDomain :: Domain
otherDomain = case OneOf Domain AnyFedDomain
owningDomain of
        OneOfA Domain
OwnDomain -> Domain
OtherDomain
        OneOf Domain AnyFedDomain
_ -> Domain
OwnDomain
  (Value
alice, Value
bob, Value
one2oneId) <- OneOf Domain AnyFedDomain -> Domain -> App (Value, Value, Value)
forall domain1 domain2.
(HasCallStack, MakesValue domain1, MakesValue domain2) =>
domain1 -> domain2 -> App (Value, Value, Value)
createOne2OneConversation OneOf Domain AnyFedDomain
owningDomain Domain
otherDomain
  Value
aliceId <- Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
one2oneId App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
others <- 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]
qIds <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
others (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    [Value]
qIds [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` ([] :: [Value])
  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 userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
bob Value
alice String
"accepted" 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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
one2oneId App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
others <- 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]
qIds <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
others (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    [Value]
qIds [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value
aliceId]

testRemoteUserGetsDeleted :: (HasCallStack) => App ()
testRemoteUserGetsDeleted :: HasCallStack => App ()
testRemoteUserGetsDeleted = 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
charlieConnected <- do
    Value
charlie <- 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
charlie
    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
charlie

  Value
charliePending <- do
    Value
charlie <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OtherDomain CreateUser
forall a. Default a => a
def
    -- the connection should be pending here
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice Value
charlie App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
alice Value
charlie App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      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
"sent"
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
charlie Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`waitForResponse` \Response
resp -> do
      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
"pending"
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
charlie

  Value
charlieBlocked <- do
    Value
charlie <- 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 Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice Value
charlie App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

    Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
charlie Value
alice String
"blocked" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
charlie Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      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
"blocked"
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
charlie

  Value
charlieUnconnected <- 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 ()) -> App ()
forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
f a -> (a -> m b) -> m ()
forConcurrently_
    [Value
charliePending, Value
charlieConnected, Value
charlieBlocked, Value
charlieUnconnected]
    \Value
charlie -> do
      Value -> App ()
forall user. (HasCallStack, MakesValue user) => user -> App ()
deleteUser Value
charlie

      -- charlie is on their local backend, so asking should be instant
      Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
charlie Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

      -- for alice, charlie is on the remote backend, so the status change
      -- may not be instant
      Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
alice Value
charlie App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`waitForResponse` \Response
resp ->
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testInternalGetConStatusesAll :: (HasCallStack) => App ()
testInternalGetConStatusesAll :: HasCallStack => App ()
testInternalGetConStatusesAll =
  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a. [ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Monoid a => a
mempty] \[String
dynBackend] -> do
    let mkFiveUsers :: domain -> App [Value]
mkFiveUsers domain
dom = Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
5 do
          domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser domain
dom CreateUser
forall a. Default a => a
def
    [Value]
alices <- Domain -> App [Value]
forall {domain}. MakesValue domain => domain -> App [Value]
mkFiveUsers Domain
OwnDomain
    [Value]
bobs <- Domain -> App [Value]
forall {domain}. MakesValue domain => domain -> App [Value]
mkFiveUsers Domain
OwnDomain
    [Value]
charlies <- Domain -> App [Value]
forall {domain}. MakesValue domain => domain -> App [Value]
mkFiveUsers Domain
OtherDomain
    [Value]
dylans <- String -> App [Value]
forall {domain}. MakesValue domain => domain -> App [Value]
mkFiveUsers String
dynBackend
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
alices \Value
alicei -> do
      let connectWith :: [Value] -> App ()
connectWith [Value]
users = do
            [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
users \Value
useri ->
              Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alicei Value
useri App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
                Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
            Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection ([Value] -> Value
forall a. HasCallStack => [a] -> a
head [Value]
users) Value
alicei String
"accepted" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
              Response
resp.status Int -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchOneOf` [Scientific -> Value
Number Scientific
200, Scientific -> Value
Number Scientific
204]
      -- local: connect each alice, accept only one
      [Value] -> App ()
connectWith [Value]
bobs
      -- remote 1 & 2: connect each alice, accept only one
      [Value] -> App ()
connectWith [Value]
charlies
      [Value] -> App ()
connectWith [Value]
dylans

    [Value] -> Domain -> App Response
forall users.
(HasCallStack, MakesValue users) =>
users -> Domain -> App Response
getConnStatusForUsers [Value]
alices Domain
OwnDomain App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      [Value]
conns <- App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList Response
resp.json
      let statusIs :: (String -> Bool) -> App [Value]
statusIs String -> Bool
f =
            (Value -> App Bool) -> [Value] -> App [Value]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
              do
                \Value
conn -> do
                  String
s <- Value
conn Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" 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
                  Bool -> App Bool
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> App Bool) -> Bool -> App Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
f String
s
              [Value]
conns

      [Value]
sent <- (String -> Bool) -> App [Value]
statusIs (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sent")
      [Value]
accepted <- (String -> Bool) -> App [Value]
statusIs (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"accepted")
      [Value]
other <- (String -> Bool) -> App [Value]
statusIs \String
v -> String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"sent" Bool -> Bool -> Bool
&& String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"accepted"

      [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
other Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
      [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
accepted Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
15
      [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
sent Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
60

assertConnectionStatus ::
  ( HasCallStack,
    MakesValue userFrom,
    MakesValue userTo
  ) =>
  userFrom ->
  userTo ->
  String ->
  App ()
assertConnectionStatus :: forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus userFrom
userFrom userTo
userTo String
connStatus =
  userFrom -> userTo -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection userFrom
userFrom userTo
userTo App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
connStatus

testConnectFromIgnored :: (HasCallStack) => StaticDomain -> App ()
testConnectFromIgnored :: HasCallStack => StaticDomain -> App ()
testConnectFromIgnored StaticDomain
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 <- StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser StaticDomain
domain CreateUser
forall a. Default a => a
def

  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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
bob 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
201
  -- set up an initial "ignored" state on Alice's side
  Value -> Value -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"pending"
  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 userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"ignored" 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 -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"ignored"

  -- if Bob sends a new connection request, Alice goes back to "pending"
  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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
bob 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 -> Value -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"pending"

  -- if Alice accepts, and Bob still wants to connect, Alice transitions to
  -- "accepted"
  Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"accepted" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"accepted"

testSentFromIgnored :: (HasCallStack) => StaticDomain -> App ()
testSentFromIgnored :: HasCallStack => StaticDomain -> App ()
testSentFromIgnored StaticDomain
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 <- StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser StaticDomain
domain CreateUser
forall a. Default a => a
def

  -- set up an initial "ignored" state
  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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
bob 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
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 Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"ignored" 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 -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"ignored"

  -- if Bob rescinds, Alice stays in "ignored"
  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 userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
bob Value
alice String
"cancelled" 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 -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"ignored"

  -- if Alice accepts, and Bob does not want to connect anymore, Alice
  -- transitions to "sent"
  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 userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"accepted" 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 -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"sent"

testConnectFromBlocked :: (HasCallStack) => StaticDomain -> App ()
testConnectFromBlocked :: HasCallStack => StaticDomain -> App ()
testConnectFromBlocked StaticDomain
domain = do
  (Value
alice, Value
bob, Value
one2oneId) <- Domain -> StaticDomain -> App (Value, Value, Value)
forall domain1 domain2.
(HasCallStack, MakesValue domain1, MakesValue domain2) =>
domain1 -> domain2 -> App (Value, Value, Value)
createOne2OneConversation Domain
OwnDomain StaticDomain
domain
  Value
bobId <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"

  -- set up an initial "blocked" state
  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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
bob 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
  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 userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"blocked" 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 -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"blocked"
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
one2oneId App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

  -- If Bob sends a new connection request, Alice ignores it
  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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
bob 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 -> Value -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"blocked"

  -- if Alice accepts (or sends a connection request), and Bob still
  -- wants to connect, Alice transitions to "accepted"
  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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice 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 -> Value -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"accepted"
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
one2oneId App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
others <- 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]
qIds <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
others (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
    [Value]
qIds [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value
bobId]

testSentFromBlocked :: (HasCallStack) => StaticDomain -> App ()
testSentFromBlocked :: HasCallStack => StaticDomain -> App ()
testSentFromBlocked StaticDomain
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 <- StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser StaticDomain
domain CreateUser
forall a. Default a => a
def

  -- set up an initial "blocked" state
  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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
bob 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
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 Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"blocked" 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 -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"blocked"

  -- if Bob rescinds, Alice stays in "blocked"
  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 userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
bob Value
alice String
"cancelled" 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 -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"blocked"

  -- if Alice accepts, and Bob does not want to connect anymore, Alice
  -- transitions to "sent"
  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 userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"accepted" 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 -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"sent"

testCancel :: (HasCallStack) => StaticDomain -> App ()
testCancel :: HasCallStack => StaticDomain -> App ()
testCancel StaticDomain
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 <- StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser StaticDomain
domain CreateUser
forall a. Default a => a
def

  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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice 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
201
  Value -> Value -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"sent"

  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 userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
bob String
"cancelled" 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 -> String -> App ()
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> String -> App ()
assertConnectionStatus Value
alice Value
bob String
"cancelled"

testConnectionLimits :: (HasCallStack) => StaticDomain -> App ()
testConnectionLimits :: HasCallStack => StaticDomain -> App ()
testConnectionLimits StaticDomain
domain = do
  let connectionLimit :: Int
connectionLimit = Int
16

  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
charlie1, Value
charlie2, Value
charlie3, Value
charlie4] <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 do
    StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser StaticDomain
domain CreateUser
forall a. Default a => a
def
  -- connect to connectionLimit - 1 many users
  (Value
charlie5 : [Value]
_) <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
connectionLimit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) do
    Value
charlie <- StaticDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser StaticDomain
domain CreateUser
forall a. Default a => a
def
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice Value
charlie App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
charlie

  -- CHARLIE 1

  -- accepting one more connection should be fine
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
charlie1 Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
  Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
charlie1 String
"accepted" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`waitForResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- resending a connection accept should be idempotent
  Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
charlie1 String
"accepted" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`waitForResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- CHARLIE 2

  -- an incoming connection beyond the limit should make it
  -- impossible for alice to accept
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
charlie2 Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

  Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
charlie2 String
"accepted" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`waitForResponse` \Response
resp -> do
    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
"connection-limit"
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

  -- the status should stay pending
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
alice Value
charlie2 App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    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
"pending"
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- CHARLIE 5

  -- the remote should be able to accept
  Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
charlie5 Value
alice String
"accepted" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`waitForResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- the status should change for alice as well
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
alice Value
charlie5 App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`waitForResponse` \Response
resp -> do
    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
"accepted"
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- CHARLIE 3

  -- attempting to send a new connection request should also hit the limit
  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice Value
charlie3 App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`waitForResponse` \Response
resp -> do
    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
"connection-limit"
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

  -- CHARLIE 4

  -- blocking should not count towards the connection limit, so after blocking
  -- charlie 1, we should be able establish another connection
  Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
 MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection Value
alice Value
charlie1 String
"blocked" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice Value
charlie4 App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

testNonFederatingRemoteTeam :: (HasCallStack) => App ()
testNonFederatingRemoteTeam :: HasCallStack => App ()
testNonFederatingRemoteTeam =
  ((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
_) -> do
    [App Response] -> App ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainA (String -> String -> Maybe [String] -> FedConn
FedConn String
domainB String
defSearchPolicy Maybe [String]
forall a. Maybe a
Nothing),
        String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainB (String -> String -> Maybe [String] -> FedConn
FedConn String
domainA String
defSearchPolicy 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 -> String -> FedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
updateFedConn String
domainA String
domainB (String -> String -> Maybe [String] -> FedConn
FedConn String
domainB String
defSearchPolicy (Maybe [String] -> FedConn) -> Maybe [String] -> FedConn
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just [])
    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def
    Value
bob <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainB CreateUser
forall a. Default a => a
def
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
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
"team-not-federating"
  where
    defSearchPolicy :: String
defSearchPolicy = String
"full_search"

testNonMutualFederationConnectionAttempt :: (HasCallStack) => App ()
testNonMutualFederationConnectionAttempt :: HasCallStack => App ()
testNonMutualFederationConnectionAttempt =
  ((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
_) -> do
    [App Response] -> App ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainA (String -> String -> Maybe [String] -> FedConn
FedConn String
domainB String
defSearchPolicy Maybe [String]
forall a. Maybe a
Nothing),
        String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainB (String -> String -> Maybe [String] -> FedConn
FedConn String
domainA String
defSearchPolicy Maybe [String]
forall a. Maybe a
Nothing)
      ]
    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def
    Value
bob <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainB CreateUser
forall a. Default a => a
def {API.BrigInternal.team = True}

    -- Alice's backend federates with Bob's team
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> FedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
updateFedConn String
domainA String
domainB (String -> String -> Maybe [String] -> FedConn
FedConn String
domainB String
defSearchPolicy (Maybe [String] -> FedConn) -> Maybe [String] -> FedConn
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just [])
    Value
bobTeamId <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team"
    String -> String -> Value -> App ()
forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
addFederationRemoteTeam String
domainA String
domainB Value
bobTeamId

    -- Bob's backend federates with no team on Alice's backend
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> FedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
updateFedConn String
domainB String
domainA (String -> String -> Maybe [String] -> FedConn
FedConn String
domainA String
defSearchPolicy (Maybe [String] -> FedConn) -> Maybe [String] -> FedConn
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just [])

    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice Value
bob App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
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
"team-not-federating"
  where
    defSearchPolicy :: String
defSearchPolicy = String
"full_search"

testFederationAllowAllConnectWithRemote :: (HasCallStack) => App ()
testFederationAllowAllConnectWithRemote :: HasCallStack => App ()
testFederationAllowAllConnectWithRemote =
  ((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
_) -> do
    [App Response] -> App ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainA (String -> String -> Maybe [String] -> FedConn
FedConn String
domainB String
defSearchPolicy Maybe [String]
forall a. Maybe a
Nothing),
        String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainB (String -> String -> Maybe [String] -> FedConn
FedConn String
domainA String
defSearchPolicy Maybe [String]
forall a. Maybe a
Nothing)
      ]
    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
$ [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
domainA, String
domainB]
  where
    defSearchPolicy :: String
defSearchPolicy = String
"full_search"

testFederationAllowDynamicConnectWithRemote :: (HasCallStack) => App ()
testFederationAllowDynamicConnectWithRemote :: HasCallStack => App ()
testFederationAllowDynamicConnectWithRemote =
  ((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
_) -> do
    [App Response] -> App ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainA (String -> String -> Maybe [String] -> FedConn
FedConn String
domainB String
defSearchPolicy Maybe [String]
forall a. Maybe a
Nothing),
        String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainB (String -> String -> Maybe [String] -> FedConn
FedConn String
domainA String
defSearchPolicy Maybe [String]
forall a. Maybe a
Nothing)
      ]
    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def {API.BrigInternal.team = True}
    Value
bob <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainB CreateUser
forall a. Default a => a
def {API.BrigInternal.team = True}

    -- Alice's backend federates with Bob's team
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> FedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
updateFedConn String
domainA String
domainB (String -> String -> Maybe [String] -> FedConn
FedConn String
domainB String
defSearchPolicy (Maybe [String] -> FedConn) -> Maybe [String] -> FedConn
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just [])
    Value
bobTeamId <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team"
    String -> String -> Value -> App ()
forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
addFederationRemoteTeam String
domainA String
domainB Value
bobTeamId

    -- Bob's backend federates with Alice's team
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> FedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
updateFedConn String
domainB String
domainA (String -> String -> Maybe [String] -> FedConn
FedConn String
domainA String
defSearchPolicy (Maybe [String] -> FedConn) -> Maybe [String] -> FedConn
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just [])
    Value
aliceTeamId <- Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team"
    String -> String -> Value -> App ()
forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
addFederationRemoteTeam String
domainB String
domainA Value
aliceTeamId

    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  where
    defSearchPolicy :: String
defSearchPolicy = String
"full_search"

testFederationAllowMixedConnectWithRemote :: (HasCallStack) => App ()
testFederationAllowMixedConnectWithRemote :: HasCallStack => App ()
testFederationAllowMixedConnectWithRemote =
  ((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
_) -> do
    [App Response] -> App ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainA (String -> String -> Maybe [String] -> FedConn
FedConn String
domainB String
defSearchPolicy Maybe [String]
forall a. Maybe a
Nothing),
        String -> FedConn -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
createFedConn String
domainB (String -> String -> Maybe [String] -> FedConn
FedConn String
domainA String
defSearchPolicy Maybe [String]
forall a. Maybe a
Nothing)
      ]
    Value
alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def {API.BrigInternal.team = True}
    Value
bob <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainB CreateUser
forall a. Default a => a
def {API.BrigInternal.team = True}

    -- Alice's backend federates with Bob's backend. Bob's backend federates
    -- with Alice's team.
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> FedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
updateFedConn String
domainB String
domainA (String -> String -> Maybe [String] -> FedConn
FedConn String
domainA String
defSearchPolicy (Maybe [String] -> FedConn) -> Maybe [String] -> FedConn
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just [])
    Value
aliceTeamId <- Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team"
    String -> String -> Value -> App ()
forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
addFederationRemoteTeam String
domainB String
domainA Value
aliceTeamId

    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
  where
    defSearchPolicy :: String
defSearchPolicy = String
"full_search"

testPendingConnectionUserDeleted :: (HasCallStack) => Domain -> App ()
testPendingConnectionUserDeleted :: HasCallStack => Domain -> App ()
testPendingConnectionUserDeleted Domain
bobsDomain = 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 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
bobsDomain CreateUser
forall a. Default a => a
def

  [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
bob] (([WebSocket] -> App ()) -> App ())
-> ([WebSocket] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[WebSocket
bobWs] -> 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 -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice 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
201
    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 (String -> Value -> App Bool
forall a. MakesValue a => String -> a -> App Bool
isConnectionNotif String
"pending") WebSocket
bobWs
    App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> App ()
forall user. (HasCallStack, MakesValue user) => user -> App ()
deleteUser Value
alice
    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 (String -> Value -> App Bool
forall a. MakesValue a => String -> a -> App Bool
isConnectionNotif String
"cancelled") WebSocket
bobWs