{-# 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
  (owner, tid, u1 : u2 : u3 : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
4

  partner <- createTeamMember owner def {role = "partner"}

  -- a partner should not be able to create conversation with 2 additional users or more
  void $ postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1, u2]}) >>= getJSON 403

  do
    -- a partner can create a one to one conversation with a user from the same team
    conv <- postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1]}) >>= getJSON 201

    -- they should not be able to add another team member to the one to one conversation
    bindResponse (addMembers partner conv def {users = [u2]}) $ \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
    deleteUser u1

    -- now they still should not be able to add another member
    bindResponse (addMembers partner conv def {users = [u2]}) $ \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
    conv <- postConversation partner (defProteus {team = Just tid}) >>= getJSON 201
    bindResponse (addMembers partner conv def {users = [u3]}) $ \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
  (owner, _, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  bobExt <- createTeamMember owner def {role = "partner"}
  bobExtClient <- createMLSClient def bobExt
  bindResponse (postConversation bobExtClient defMLS) $ \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
  (owner, _, alice : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  bobExternal <- createTeamMember owner def {role = "partner"}
  void $ getMLSOne2OneConversation alice bobExternal >>= getJSON 200

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

  partner <- createTeamMember owner def {role = "partner"}

  conv <- postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1]}) >>= getJSON 201

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

testExternalPartnerCannotBecomeConversationAdmin :: (HasCallStack) => App ()
testExternalPartnerCannotBecomeConversationAdmin :: HasCallStack => App ()
testExternalPartnerCannotBecomeConversationAdmin = do
  (owner, tid, tm1 : tm2 : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  partner <- createTeamMember owner def {role = "partner"}
  conv <- postConversation owner (defProteus {team = Just tid, qualifiedUsers = [partner, tm1], newUsersRole = "wire_admin"}) >>= getJSON 201

  bindResponse (getConversation owner conv) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    for_ members $ \Value
m -> do
      Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_admin"

  bindResponse (addMembers partner conv def {users = [tm2]}) $ \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
"invalid-op"