{-# OPTIONS -Wno-ambiguous-fields #-}
module Test.MLS.Services where

import API.Brig
import API.Common
import API.GalleyInternal (patchTeamFeatureConfig)
import SetupHelpers
import Testlib.JSON
import Testlib.Prelude

testWhitelistUpdatePermissions :: (HasCallStack) => App ()
testWhitelistUpdatePermissions :: HasCallStack => App ()
testWhitelistUpdatePermissions = do
  -- Create a team
  (Value
owner, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  -- Create a team admin
  Value
admin <- Value -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
owner CreateTeamMember
forall a. Default a => a
def {role = "admin"}

  -- Create a service
  String
email <- App String
randomEmail
  App Value
provider <- Value -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make (Value -> App Value) -> App Value -> App (App Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> NewProvider -> App Value
forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider Value
owner NewProvider
forall a. Default a => a
def {newProviderEmail = email}
  String
providerId <- App Value
provider App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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
  App Value
service <- Value -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make (Value -> App Value) -> App Value -> App (App Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain -> String -> NewService -> App Value
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> NewService -> App Value
newService Domain
OwnDomain String
providerId NewService
forall a. Default a => a
def

  do
    -- Check that a random user can't add the service to the whitelist
    Value
uid <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
    String
serviceId <- App Value
service App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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
    Value
np <-
      Value -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make
        (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
          [ String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
serviceId,
            String
"provider" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
providerId,
            String
"whitelisted" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True
          ]
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> Value -> App Response
forall user tid update.
(HasCallStack, MakesValue user, MakesValue tid,
 MakesValue update) =>
user -> tid -> update -> App Response
postServiceWhitelist Value
uid String
tid Value
np) ((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
      (Response
resp.jsonBody Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label") App Value -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String -> Maybe String
forall a. a -> Maybe a
Just String
"insufficient-permissions"

  do
    -- Check that an admin can add the service to the whitelist
    String
serviceId <- App Value
service App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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
    Value
np <-
      Value -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make
        (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
          [ String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
serviceId,
            String
"provider" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
providerId,
            String
"whitelisted" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True
          ]
    Value -> String -> Value -> App Response
forall user tid update.
(HasCallStack, MakesValue user, MakesValue tid,
 MakesValue update) =>
user -> tid -> update -> App Response
postServiceWhitelist Value
admin String
tid Value
np 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  -- set team's defaultProtocol to MLS
  Value
mlsConfig <-
    Value -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make
      (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
        [ String
"config"
            String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
              [ String
"allowedCipherSuites" String -> [Int] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Int
1 :: Int],
                String
"defaultCipherSuite" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
1 :: Int),
                String
"defaultProtocol" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"mls",
                String
"protocolToggleUsers" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [String]),
                String
"supportedProtocols" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"mls", String
"proteus"]
              ],
          String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled",
          String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited"
        ]
  Domain -> String -> String -> Value -> App Response
forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
patchTeamFeatureConfig Domain
OwnDomain String
tid String
"mls" Value
mlsConfig 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 => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  do
    -- Check that a random user can't add the service to the whitelist
    Value
uid <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
    String
serviceId <- App Value
service App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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
    Value
np <-
      Value -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make
        (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
          [ String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
serviceId,
            String
"provider" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
providerId,
            String
"whitelisted" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True
          ]
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> Value -> App Response
forall user tid update.
(HasCallStack, MakesValue user, MakesValue tid,
 MakesValue update) =>
user -> tid -> update -> App Response
postServiceWhitelist Value
uid String
tid Value
np) ((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
409
      (Response
resp.jsonBody Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label") App Value -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String -> Maybe String
forall a. a -> Maybe a
Just String
"mls-services-not-allowed"

  do
    -- Check that an admin can't add the service to the whitelist
    String
serviceId <- App Value
service App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" 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
    Value
np <-
      Value -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make
        (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
          [ String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
serviceId,
            String
"provider" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
providerId,
            String
"whitelisted" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True
          ]
    Value -> String -> Value -> App Response
forall user tid update.
(HasCallStack, MakesValue user, MakesValue tid,
 MakesValue update) =>
user -> tid -> update -> App Response
postServiceWhitelist Value
admin String
tid Value
np 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
>>= \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
      (Response
resp.jsonBody Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label") App Value -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String -> Maybe String
forall a. a -> Maybe a
Just String
"mls-services-not-allowed"