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

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2023 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Test.ExternalPartner where

import API.Galley
import GHC.Stack
import MLS.Util
import SetupHelpers
import Testlib.Prelude

testExternalPartnerPermissions :: (HasCallStack) => App ()
testExternalPartnerPermissions :: HasCallStack => App ()
testExternalPartnerPermissions = do
  (Value
owner, String
tid, Value
u1 : Value
u2 : Value
u3 : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4

  Value
partner <- Value -> String -> String -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> String -> String -> App Value
createTeamMemberWithRole Value
owner String
tid String
"partner"

  -- a partner should not be able to create conversation with 2 additional users or more
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
partner (CreateConv
defProteus {team = Just tid, qualifiedUsers = [u1, u2]}) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
403

  do
    -- a partner can create a one to one conversation with a user from the same team
    Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
partner (CreateConv
defProteus {team = Just tid, qualifiedUsers = [u1]}) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

    -- they should not be able to add another team member to the one to one conversation
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
partner Value
conv AddMembers
forall a. Default a => a
def {users = [u2]}) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

    -- the other member in the conversation gets deleted
    Value -> App ()
forall user. (HasCallStack, MakesValue user) => user -> App ()
deleteUser Value
u1

    -- now they still should not be able to add another member
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
partner Value
conv AddMembers
forall a. Default a => a
def {users = [u2]}) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

  do
    -- also an external partner cannot add someone to a conversation, even if it is empty
    Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
partner (CreateConv
defProteus {team = Just tid}) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
partner Value
conv AddMembers
forall a. Default a => a
def {users = [u3]}) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

testExternalPartnerPermissionsMls :: (HasCallStack) => App ()
testExternalPartnerPermissionsMls :: HasCallStack => App ()
testExternalPartnerPermissionsMls = do
  -- external partners should not be able to create (MLS) conversations
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
bobExt <- Value -> String -> String -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> String -> String -> App Value
createTeamMemberWithRole Value
owner String
tid String
"partner"
  ClientIdentity
bobExtClient <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
bobExt
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
bobExtClient CreateConv
defMLS) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

testExternalPartnerPermissionMlsOne2One :: (HasCallStack) => App ()
testExternalPartnerPermissionMlsOne2One :: HasCallStack => App ()
testExternalPartnerPermissionMlsOne2One = do
  (Value
owner, String
tid, Value
alice : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
bobExternal <- Value -> String -> String -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> String -> String -> App Value
createTeamMemberWithRole Value
owner String
tid String
"partner"
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> Value -> App Response
forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> App Response
getMLSOne2OneConversation Value
alice Value
bobExternal App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200

testExternalPartnerPermissionsConvName :: (HasCallStack) => App ()
testExternalPartnerPermissionsConvName :: HasCallStack => App ()
testExternalPartnerPermissionsConvName = do
  (Value
owner, String
tid, Value
u1 : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  Value
partner <- Value -> String -> String -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> String -> String -> App Value
createTeamMemberWithRole Value
owner String
tid String
"partner"

  Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
partner (CreateConv
defProteus {team = Just tid, qualifiedUsers = [u1]}) App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> App Response
forall user conv name.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue name) =>
user -> conv -> name -> App Response
changeConversationName Value
partner Value
conv String
"new name") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403