-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 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.TeamCollaborators where

import API.Brig
import API.Galley
import qualified API.GalleyInternal as Internal
import Data.Tuple.Extra
import Notifications (isConvLeaveNotif, isTeamCollaboratorAddedNotif, isTeamCollaboratorRemovedNotif, isTeamMemberLeaveNotif)
import SetupHelpers
import Testlib.Prelude

testCreateTeamCollaborator :: (HasCallStack) => App ()
testCreateTeamCollaborator :: HasCallStack => App ()
testCreateTeamCollaborator = do
  (owner, team, [alice]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  user <- randomUser OwnDomain def
  (_, userId) <- objQid user
  withWebSockets [owner, alice] $ \[WebSocket
wsOwner, WebSocket
wsAlice] -> do
    Value -> String -> Value -> [String] -> App Response
forall owner collaborator.
(MakesValue owner, MakesValue collaborator, HasCallStack) =>
owner -> String -> collaborator -> [String] -> App Response
addTeamCollaborator
      Value
owner
      String
team
      Value
user
      [ String
"create_team_conversation",
        String
"implicit_connection"
      ]
      App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    let checkEvent :: (MakesValue a) => a -> App ()
        checkEvent :: forall a. MakesValue a => a -> App ()
checkEvent a
evt = do
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.permissions" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
"create_team_conversation", String
"implicit_connection"]
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.user" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
userId
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
team
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"transient" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False

    HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isTeamCollaboratorAddedNotif WebSocket
wsOwner App Value -> (Value -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App ()
forall a. MakesValue a => a -> App ()
checkEvent
    HasCallStack => Int -> WebSocket -> App ()
Int -> WebSocket -> App ()
assertNoEvent Int
1 WebSocket
wsAlice

  bindResponse (getAllTeamCollaborators owner team) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    res <- (Response
resp.jsonBody Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList) App [Value] -> ([Value] -> App Value) -> App (App Value)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    res %. "user" `shouldMatch` userId
    res %. "team" `shouldMatch` team
    res %. "permissions" `shouldMatch` ["create_team_conversation", "implicit_connection"]

testTeamCollaboratorEndpointsForbiddenForOtherTeams :: (HasCallStack) => App ()
testTeamCollaboratorEndpointsForbiddenForOtherTeams :: HasCallStack => App ()
testTeamCollaboratorEndpointsForbiddenForOtherTeams = do
  (owner, _team, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  (_owner2, team2, _members2) <- createTeam OwnDomain 0

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  user <- randomUser OwnDomain def
  addTeamCollaborator
    owner
    team2
    user
    [ "create_team_conversation",
      "implicit_connection"
    ]
    >>= assertStatus 403

  getAllTeamCollaborators owner team2 >>= assertStatus 403

testCreateTeamCollaboratorPostTwice :: (HasCallStack) => App ()
testCreateTeamCollaboratorPostTwice :: HasCallStack => App ()
testCreateTeamCollaboratorPostTwice = do
  (owner, team, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  user <- randomUser OwnDomain def
  let add =
        Value -> String -> Value -> [String] -> App Response
forall owner collaborator.
(MakesValue owner, MakesValue collaborator, HasCallStack) =>
owner -> String -> collaborator -> [String] -> App Response
addTeamCollaborator
          Value
owner
          String
team
          Value
user
          [ String
"create_team_conversation",
            String
"implicit_connection"
          ]
  bindResponse add assertSuccess
  bindResponse add $ assertStatus 409

testCollaboratorCanCreateTeamConv :: (HasCallStack) => TaggedBool "collaborator-has-team" -> App ()
testCollaboratorCanCreateTeamConv :: HasCallStack => TaggedBool "collaborator-has-team" -> App ()
testCollaboratorCanCreateTeamConv (TaggedBool Bool
collaboratorHasTeam) = do
  (owner, team, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  (_, nonCollaboratingTeam, _) <- createTeam OwnDomain 1
  collaborator <-
    if collaboratorHasTeam
      then head . thd3 <$> createTeam OwnDomain 2
      else randomUser OwnDomain def

  addTeamCollaborator owner team collaborator ["create_team_conversation"]
    >>= assertSuccess

  postConversation collaborator (defMLS {team = Just nonCollaboratingTeam}) `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
"no-team-member"

  postConversation collaborator (defMLS {team = Just team}) `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
team

testImplicitConnectionAllowed :: (HasCallStack) => App ()
testImplicitConnectionAllowed :: HasCallStack => App ()
testImplicitConnectionAllowed = do
  (owner, team, [alice]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  bob <- randomUser OwnDomain def
  addTeamCollaborator
    owner
    team
    bob
    ["implicit_connection"]
    >>= assertSuccess

  postOne2OneConversation bob alice team "chit-chat" >>= assertSuccess

  getMLSOne2OneConversation bob alice >>= assertSuccess

  -- Connecting should work the other way round as well.
  postOne2OneConversation alice bob team "chat-chit" >>= assertSuccess

  getMLSOne2OneConversation alice bob >>= assertSuccess

testImplicitConnectionNotConfigured :: (HasCallStack) => App ()
testImplicitConnectionNotConfigured :: HasCallStack => App ()
testImplicitConnectionNotConfigured = do
  (owner, team, [alice]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  bob <- randomUser OwnDomain def
  addTeamCollaborator
    owner
    team
    bob
    []
    >>= assertSuccess

  postOne2OneConversation bob alice team "chit-chat" >>= assertLabel 403 "operation-denied"

  -- Team members can create 1:1s with all collaborators, regardless of the
  -- collaborators' permissions.
  postOne2OneConversation alice bob team "chat-chit" >>= assertSuccess

  getMLSOne2OneConversation alice bob >>= assertSuccess

testImplicitConnectionNoCollaborator :: (HasCallStack) => App ()
testImplicitConnectionNoCollaborator :: HasCallStack => App ()
testImplicitConnectionNoCollaborator = do
  (_owner0, team0, [alice]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  (owner1, team1, _users1) <- createTeam OwnDomain 2

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  bob <- randomUser OwnDomain def
  addTeamCollaborator
    owner1
    team1
    bob
    ["implicit_connection"]
    >>= assertSuccess

  -- Alice and Bob aren't connected at all.
  postOne2OneConversation bob alice team0 "chit-chat" >>= assertLabel 403 "no-team-member"

testRemoveCollaboratorInTeamsO2O :: (HasCallStack) => App ()
testRemoveCollaboratorInTeamsO2O :: HasCallStack => App ()
testRemoveCollaboratorInTeamsO2O = do
  (owner0, team0, [alice]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  (owner1, team1, [bob]) <- createTeam OwnDomain 2

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  charlie <- randomUser OwnDomain def
  addTeamCollaborator owner0 team0 charlie ["implicit_connection"] >>= assertSuccess
  addTeamCollaborator owner1 team1 charlie ["implicit_connection"] >>= assertSuccess

  convId <-
    postOne2OneConversation charlie alice team0 "chit-chat" `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  postOne2OneConversation charlie bob team1 "chit-chat" >>= assertSuccess
  Internal.getConversation convId >>= assertSuccess

  removeTeamCollaborator owner0 team0 charlie >>= assertSuccess

  getMLSOne2OneConversation charlie alice >>= assertLabel 403 "not-connected"
  postOne2OneConversation charlie alice team0 "chit-chat" >>= assertLabel 403 "no-team-member"
  Internal.getConversation convId >>= assertLabel 404 "no-conversation"
  getMLSOne2OneConversation charlie bob >>= assertSuccess

testRemoveCollaboratorInO2OConnected :: (HasCallStack) => App ()
testRemoveCollaboratorInO2OConnected :: HasCallStack => App ()
testRemoveCollaboratorInO2OConnected = do
  (owner0, team0, [alice]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  bob <- randomUser OwnDomain def
  connectTwoUsers alice bob

  addTeamCollaborator owner0 team0 bob ["implicit_connection"] >>= assertSuccess

  postOne2OneConversation bob alice team0 "chit-chat" >>= assertSuccess

  removeTeamCollaborator owner0 team0 bob >>= assertSuccess

  getMLSOne2OneConversation bob alice >>= assertSuccess

testRemoveCollaboratorInO2O :: (HasCallStack) => App ()
testRemoveCollaboratorInO2O :: HasCallStack => App ()
testRemoveCollaboratorInO2O = do
  (owner0, team0, [alice]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  bob <- randomUser OwnDomain def
  addTeamCollaborator owner0 team0 bob ["implicit_connection"] >>= assertSuccess

  teamConvId <-
    postOne2OneConversation bob alice team0 "chit-chat" `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
  Internal.getConversation teamConvId >>= assertSuccess

  connectTwoUsers alice bob
  personalConvId <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
  Internal.getConversation personalConvId >>= assertSuccess

  removeTeamCollaborator owner0 team0 bob >>= assertSuccess

  postOne2OneConversation bob alice team0 "chit-chat" >>= assertLabel 403 "no-team-member"
  Internal.getConversation teamConvId >>= assertLabel 404 "no-conversation"

  getMLSOne2OneConversation bob alice >>= assertSuccess
  Internal.getConversation personalConvId >>= assertSuccess

testRemoveCollaboratorInTeamConversation :: (HasCallStack) => App ()
testRemoveCollaboratorInTeamConversation :: HasCallStack => App ()
testRemoveCollaboratorInTeamConversation = do
  (owner, team, [alice, bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3

  conv <-
    postConversation
      owner
      defProteus {team = Just team, qualifiedUsers = [alice, bob]}
      >>= getJSON 201

  withWebSockets [owner, alice, bob] $ \[WebSocket
wsOwner, WebSocket
wsAlice, WebSocket
wsBob] -> do
    Value -> String -> Value -> App Response
forall owner collaborator.
(MakesValue owner, MakesValue collaborator, HasCallStack) =>
owner -> String -> collaborator -> App Response
removeTeamCollaborator Value
owner String
team Value
bob App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    bobId <- Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
    bobUnqualifiedId <- bobId %. "id"
    let checkLeaveEvent :: (MakesValue a, HasCallStack) => a -> App ()
        checkLeaveEvent a
evt = do
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.user" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
bobUnqualifiedId
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
team
        checkRemoveEvent :: (MakesValue a, HasCallStack) => a -> App ()
        checkRemoveEvent a
evt = do
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.user" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
bobUnqualifiedId
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
team
        checkConvLeaveEvent :: (MakesValue a, HasCallStack) => a -> App ()
        checkConvLeaveEvent a
evt = do
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.data.qualified_user_ids" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value
bobId]
          a
evt a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
team

    awaitMatch isTeamMemberLeaveNotif wsOwner >>= checkLeaveEvent
    awaitMatch isTeamMemberLeaveNotif wsAlice >>= checkRemoveEvent
    awaitMatch isTeamMemberLeaveNotif wsBob >>= checkLeaveEvent
    awaitMatch isTeamCollaboratorRemovedNotif wsOwner >>= checkRemoveEvent
    awaitMatch isConvLeaveNotif wsAlice >>= checkConvLeaveEvent

  getConversation alice conv `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    otherMember <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne ([Value] -> App Value) -> App [Value] -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others")
    otherMember %. "qualified_id" `shouldNotMatch` (bob %. "qualified_id")

  getConversation bob conv `bindResponse` \Response
resp -> do
    -- should be 404
    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
"access-denied"

  Internal.getConversation conv `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    otherMembers <- App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others")
    traverse (%. "qualified_id") otherMembers `shouldMatchSet` traverse (%. "qualified_id") [owner, alice]

testUpdateCollaborator :: (HasCallStack) => App ()
testUpdateCollaborator :: HasCallStack => App ()
testUpdateCollaborator = do
  (owner, team, [alice]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- At the time of writing, it wasn't clear if this should be a bot instead.
  bob <- randomUser OwnDomain def
  addTeamCollaborator
    owner
    team
    bob
    ["implicit_connection"]
    >>= assertSuccess
  postOne2OneConversation bob alice team "chit-chat" >>= assertSuccess

  updateTeamCollaborator
    owner
    team
    bob
    ["create_team_conversation", "implicit_connection"]
    >>= assertSuccess
  postOne2OneConversation bob alice team "chit-chat" >>= assertSuccess

  updateTeamCollaborator
    owner
    team
    bob
    []
    >>= assertSuccess
  postOne2OneConversation bob alice team "chit-chat" >>= assertLabel 403 "operation-denied"