{-# 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.Channels where

import API.Galley
import API.GalleyInternal hiding (setTeamFeatureConfig)
import GHC.Stack
import MLS.Util (createMLSClient, uploadNewKeyPackage)
import SetupHelpers
import Testlib.JSON
import Testlib.Prelude

testCreateChannelEveryone :: (HasCallStack) => App ()
testCreateChannelEveryone :: HasCallStack => App ()
testCreateChannelEveryone = do
  (Value
owner, String
tid, Value
mem : [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 -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
owner CreateTeamMember
forall a. Default a => a
def {role = "partner"}
  ClientIdentity
ownerClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
owner
  ClientIdentity
memClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
mem
  ClientIdentity
partnerClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
partner
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity
memClient, ClientIdentity
ownerClient, ClientIdentity
partnerClient] (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  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
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")
  HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
assertCreateChannelSuccess ClientIdentity
ownerClient String
tid
  HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
assertCreateChannelSuccess ClientIdentity
memClient String
tid
  HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
assertCreateChannelSuccess ClientIdentity
partnerClient String
tid

testCreateChannelMembersOnly :: (HasCallStack) => App ()
testCreateChannelMembersOnly :: HasCallStack => App ()
testCreateChannelMembersOnly = do
  (Value
owner, String
tid, Value
mem : [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 -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
owner CreateTeamMember
forall a. Default a => a
def {role = "partner"}
  ClientIdentity
ownerClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
owner
  ClientIdentity
memClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
mem
  ClientIdentity
partnerClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
partner
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity
memClient, ClientIdentity
ownerClient, ClientIdentity
partnerClient] (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  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
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"team-members")
  HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
assertCreateChannelSuccess ClientIdentity
ownerClient String
tid
  HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
assertCreateChannelSuccess ClientIdentity
memClient String
tid
  HasCallStack => String -> ClientIdentity -> String -> App ()
String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
"operation-denied" ClientIdentity
partnerClient String
tid

testCreateChannelAdminsOnly :: (HasCallStack) => App ()
testCreateChannelAdminsOnly :: HasCallStack => App ()
testCreateChannelAdminsOnly = do
  (Value
owner, String
tid, Value
mem : [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 -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
owner CreateTeamMember
forall a. Default a => a
def {role = "partner"}
  ClientIdentity
ownerClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
owner
  ClientIdentity
memClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
mem
  ClientIdentity
partnerClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
partner
  [ClientIdentity] -> (ClientIdentity -> App String) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity
memClient, ClientIdentity
ownerClient, ClientIdentity
partnerClient] (HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def)
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  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
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"admins")
  HasCallStack => ClientIdentity -> String -> App ()
ClientIdentity -> String -> App ()
assertCreateChannelSuccess ClientIdentity
ownerClient String
tid
  HasCallStack => String -> ClientIdentity -> String -> App ()
String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
"operation-denied" ClientIdentity
memClient String
tid
  HasCallStack => String -> ClientIdentity -> String -> App ()
String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
"operation-denied" ClientIdentity
partnerClient String
tid

testCreateChannelFeatureDisabled :: (HasCallStack) => App ()
testCreateChannelFeatureDisabled :: HasCallStack => App ()
testCreateChannelFeatureDisabled = do
  (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
1
  ClientIdentity
ownerClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
owner
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
ownerClient
  HasCallStack => String -> ClientIdentity -> String -> App ()
String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
"channels-not-enabled" ClientIdentity
ownerClient String
tid

testCreateChannelNonTeamConvNotAllowed :: (HasCallStack) => App ()
testCreateChannelNonTeamConvNotAllowed :: HasCallStack => App ()
testCreateChannelNonTeamConvNotAllowed = do
  Value
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  ClientIdentity
userClient <- Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def Value
user
  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
userClient
  ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
userClient CreateConv
defMLS {groupConvType = Just "channel"} 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
"operation-denied"

testCreateChannelProteusNotAllowed :: (HasCallStack) => App ()
testCreateChannelProteusNotAllowed :: HasCallStack => App ()
testCreateChannelProteusNotAllowed = do
  (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
1
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
  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
$ Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
user -> team -> featureName -> payload -> App Response
setTeamFeatureConfig Value
owner String
tid String
"channels" (String -> Value
config String
"everyone")
  Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
owner CreateConv
defProteus {groupConvType = Just "channel", team = Just tid} 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
"not-mls-conversation"

assertCreateChannelSuccess :: (HasCallStack) => ClientIdentity -> String -> App ()
assertCreateChannelSuccess :: HasCallStack => ClientIdentity -> String -> App ()
assertCreateChannelSuccess ClientIdentity
client String
tid = do
  Value
conv <- ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
client CreateConv
defMLS {groupConvType = Just "channel", 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
  Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"group_conv_type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"channel"

assertCreateChannelFailure :: (HasCallStack) => String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure :: HasCallStack => String -> ClientIdentity -> String -> App ()
assertCreateChannelFailure String
label ClientIdentity
client String
tid = do
  ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation ClientIdentity
client CreateConv
defMLS {groupConvType = Just "channel", team = Just tid} 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
label

config :: String -> Value
config :: String -> Value
config String
perms =
  [Pair] -> Value
object
    [ String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled",
      String
"config"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"allowed_to_create_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
perms,
            String
"allowed_to_open_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
perms
          ]
    ]