-- 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
  (alice, bob, 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
  aliceId <- alice %. "qualified_id"
  getConversation alice one2oneId `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    qIds <- for others (%. "qualified_id")
    qIds `shouldMatchSet` ([] :: [Value])
  void $ putConnection bob alice "accepted" >>= getBody 200
  getConversation bob one2oneId `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    qIds <- for others (%. "qualified_id")
    qIds `shouldMatchSet` [aliceId]

testRemoteUserGetsDeleted :: (HasCallStack) => App ()
testRemoteUserGetsDeleted :: HasCallStack => App ()
testRemoteUserGetsDeleted = do
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  charlieConnected <- do
    charlie <- randomUser OtherDomain def
    connectTwoUsers alice charlie
    pure charlie

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

    getConnection alice charlie `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

    getConnection charlie alice `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

    pure charlie

  charlieBlocked <- do
    charlie <- randomUser OtherDomain def
    postConnection alice charlie `bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

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

    getConnection charlie alice `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

    pure charlie

  charlieUnconnected <- randomUser OtherDomain def

  forConcurrently_
    [charliePending, charlieConnected, charlieBlocked, 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.
HasCallStack =>
[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
    alices <- Domain -> App [Value]
forall {domain}. MakesValue domain => domain -> App [Value]
mkFiveUsers Domain
OwnDomain
    bobs <- mkFiveUsers OwnDomain
    charlies <- mkFiveUsers OtherDomain
    dylans <- mkFiveUsers dynBackend
    for_ 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

    getConnStatusForUsers alices OwnDomain `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      conns <- App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList Response
resp.json
      let 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
                  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
                  pure $ f s
              [Value]
conns

      sent <- statusIs (== "sent")
      accepted <- statusIs (== "accepted")
      other <- 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"

      length other `shouldMatchInt` 0
      length accepted `shouldMatchInt` 15
      length sent `shouldMatchInt` 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
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  bob <- randomUser domain def

  void $ postConnection bob alice >>= getBody 201
  -- set up an initial "ignored" state on Alice's side
  assertConnectionStatus alice bob "pending"
  void $ putConnection alice bob "ignored" >>= getBody 200
  assertConnectionStatus alice bob "ignored"

  -- if Bob sends a new connection request, Alice goes back to "pending"
  void $ postConnection bob alice >>= getBody 200
  assertConnectionStatus alice bob "pending"

  -- if Alice accepts, and Bob still wants to connect, Alice transitions to
  -- "accepted"
  putConnection alice bob "accepted" `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
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  bob <- randomUser domain def

  -- set up an initial "ignored" state
  void $ postConnection bob alice >>= getBody 201
  void $ putConnection alice bob "ignored" >>= getBody 200
  assertConnectionStatus alice bob "ignored"

  -- if Bob rescinds, Alice stays in "ignored"
  void $ putConnection bob alice "cancelled" >>= getBody 200
  assertConnectionStatus alice bob "ignored"

  -- if Alice accepts, and Bob does not want to connect anymore, Alice
  -- transitions to "sent"
  void $ putConnection alice bob "accepted" >>= getBody 200
  assertConnectionStatus alice bob "sent"

testConnectFromBlocked :: (HasCallStack) => StaticDomain -> App ()
testConnectFromBlocked :: HasCallStack => StaticDomain -> App ()
testConnectFromBlocked StaticDomain
domain = do
  (alice, bob, 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
  bobId <- bob %. "qualified_id"

  -- set up an initial "blocked" state
  void $ postConnection bob alice >>= getBody 200
  void $ putConnection alice bob "blocked" >>= getBody 200
  assertConnectionStatus alice bob "blocked"
  getConversation alice one2oneId `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
  void $ postConnection bob alice >>= getBody 200
  assertConnectionStatus alice bob "blocked"

  -- if Alice accepts (or sends a connection request), and Bob still
  -- wants to connect, Alice transitions to "accepted"
  void $ postConnection alice bob >>= getBody 200
  assertConnectionStatus alice bob "accepted"
  getConversation alice one2oneId `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    qIds <- for others (%. "qualified_id")
    qIds `shouldMatchSet` [bobId]

testSentFromBlocked :: (HasCallStack) => StaticDomain -> App ()
testSentFromBlocked :: HasCallStack => StaticDomain -> App ()
testSentFromBlocked StaticDomain
domain = do
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  bob <- randomUser domain def

  -- set up an initial "blocked" state
  void $ postConnection bob alice >>= getBody 201
  void $ putConnection alice bob "blocked" >>= getBody 200
  assertConnectionStatus alice bob "blocked"

  -- if Bob rescinds, Alice stays in "blocked"
  void $ putConnection bob alice "cancelled" >>= getBody 200
  assertConnectionStatus alice bob "blocked"

  -- if Alice accepts, and Bob does not want to connect anymore, Alice
  -- transitions to "sent"
  void $ putConnection alice bob "accepted" >>= getBody 200
  assertConnectionStatus alice bob "sent"

testCancel :: (HasCallStack) => StaticDomain -> App ()
testCancel :: HasCallStack => StaticDomain -> App ()
testCancel StaticDomain
domain = do
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  bob <- randomUser domain def

  void $ postConnection alice bob >>= getBody 201
  assertConnectionStatus alice bob "sent"

  void $ putConnection alice bob "cancelled" >>= getBody 200
  assertConnectionStatus alice bob "cancelled"

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

  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  [charlie1, charlie2, charlie3, charlie4] <- replicateM 4 do
    randomUser domain def
  -- connect to connectionLimit - 1 many users
  (charlie5 : _) <- replicateM (connectionLimit - 1) do
    charlie <- randomUser domain def
    postConnection alice charlie `bindResponse` \Response
resp ->
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
    pure charlie

  -- CHARLIE 1

  -- accepting one more connection should be fine
  postConnection charlie1 alice `bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
  putConnection alice charlie1 "accepted" `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
  putConnection alice charlie1 "accepted" `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
  postConnection charlie2 alice `bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

  putConnection alice charlie2 "accepted" `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
  getConnection alice charlie2 `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
  putConnection charlie5 alice "accepted" `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
  getConnection alice charlie5 `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
  postConnection alice charlie3 `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
  putConnection alice charlie1 "blocked" `bindResponse` \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  postConnection alice charlie4 `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 [])
    alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def
    bob <- randomUser domainB def
    postConnection alice bob `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)
      ]
    alice <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domainA CreateUser
forall a. Default a => a
def
    bob <- randomUser domainB def {API.BrigInternal.team = True}

    -- Alice's backend federates with Bob's team
    void $ updateFedConn domainA domainB (FedConn domainB defSearchPolicy $ Just [])
    bobTeamId <- bob %. "team"
    addFederationRemoteTeam domainA domainB bobTeamId

    -- Bob's backend federates with no team on Alice's backend
    void $ updateFedConn domainB domainA (FedConn domainA defSearchPolicy $ Just [])

    postConnection alice bob `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)
      ]
    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}
    bob <- randomUser domainB def {API.BrigInternal.team = True}

    -- Alice's backend federates with Bob's team
    void $ updateFedConn domainA domainB (FedConn domainB defSearchPolicy $ Just [])
    bobTeamId <- bob %. "team"
    addFederationRemoteTeam domainA domainB bobTeamId

    -- Bob's backend federates with Alice's team
    void $ updateFedConn domainB domainA (FedConn domainA defSearchPolicy $ Just [])
    aliceTeamId <- alice %. "team"
    addFederationRemoteTeam domainB domainA aliceTeamId

    connectTwoUsers alice 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)
      ]
    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}
    bob <- randomUser domainB def {API.BrigInternal.team = True}

    -- Alice's backend federates with Bob's backend. Bob's backend federates
    -- with Alice's team.
    void $ updateFedConn domainB domainA (FedConn domainA defSearchPolicy $ Just [])
    aliceTeamId <- alice %. "team"
    addFederationRemoteTeam domainB domainA aliceTeamId

    connectTwoUsers alice bob
  where
    defSearchPolicy :: String
defSearchPolicy = String
"full_search"

testPendingConnectionUserDeleted :: (HasCallStack) => Domain -> App ()
testPendingConnectionUserDeleted :: HasCallStack => Domain -> App ()
testPendingConnectionUserDeleted Domain
bobsDomain = do
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  bob <- randomUser bobsDomain def

  withWebSockets [bob] $ \[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. (HasCallStack, 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. (HasCallStack, MakesValue a) => String -> a -> App Bool
isConnectionNotif String
"cancelled") WebSocket
bobWs