module Test.FeatureFlags.User where

import qualified API.BrigInternal as I
import API.Galley
import qualified API.GalleyInternal as I
import SetupHelpers
import Testlib.Prelude

testFeatureConferenceCallingForUser :: App ()
testFeatureConferenceCallingForUser :: App ()
testFeatureConferenceCallingForUser = do
  (Value
alice, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0 -- team user
  Value
bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def -- non-team user
  let featureName :: String
featureName = String
"conferenceCalling"

  -- set initial value at the team level
  let patch :: Value
patch =
        [Pair] -> Value
object
          [ String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlocked",
            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
"useSFTForOneToOneCalls" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True]
          ]

  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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
I.patchTeamFeatureConfig Domain
OwnDomain String
tid String
featureName Value
patch

  -- set user value for both users
  [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob] ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
u -> do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> Value -> App Response
forall user config.
(HasCallStack, MakesValue user, MakesValue config) =>
user -> String -> config -> App Response
I.putFeatureForUser
        Value
u
        String
featureName
        ( [Pair] -> Value
object
            [ String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"disabled"
            ]
        )
      App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
    Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
I.getFeatureForUser Value
u String
featureName 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
200
      Value
config <- Response
resp.json
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"

      -- this config is just made up by brig, it does not reflect the actual value
      -- that will be returned to the user
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"config.useSFTForOneToOneCalls" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False

  -- alice
  do
    Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getFeaturesForUser Value
alice 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
200
      Value
config <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
featureName

      -- alice is a team user, so her config reflects that of the team
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"config.useSFTForOneToOneCalls" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True

  do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
I.deleteFeatureForUser Value
alice String
featureName App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
    Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getFeaturesForUser Value
alice 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
200
      Value
config <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
featureName
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"config.useSFTForOneToOneCalls" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True

  -- bob
  do
    Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getFeaturesForUser Value
bob 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
200
      Value
config <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
featureName
      -- bob is not in a team, so we get his own personal settings here
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"
      -- but only for status, config is the server defaults
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"config.useSFTForOneToOneCalls" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
  do
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
I.deleteFeatureForUser Value
bob String
featureName App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
    Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getFeaturesForUser Value
bob 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
200
      Value
config <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
featureName
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"
      Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"config.useSFTForOneToOneCalls" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False