module Test.FeatureFlags.ClassifiedDomains where

import SetupHelpers
import Test.FeatureFlags.Util
import Testlib.Prelude

testClassifiedDomainsEnabled :: (HasCallStack) => App ()
testClassifiedDomainsEnabled :: HasCallStack => App ()
testClassifiedDomainsEnabled = do
  (Value
_, String
tid, Value
m : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
expected <- Value
enabled Value -> (Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> [String] -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"config.domains" [String
"example.com"]
  String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature String
"classifiedDomains" Value
m String
tid Value
expected

testClassifiedDomainsDisabled :: (HasCallStack) => App ()
testClassifiedDomainsDisabled :: HasCallStack => App ()
testClassifiedDomainsDisabled = do
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
forall a. Default a => a
def {galleyCfg = setField "settings.featureFlags.classifiedDomains" (object ["status" .= "disabled", "config" .= object ["domains" .= ["example.com"]]])} ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    (Value
_, String
tid, Value
m : [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
2
    Value
expected <- Value
disabled Value -> (Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& String -> [String] -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"config.domains" [String
"example.com"]
    String -> Value -> String -> Value -> App ()
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
String -> user -> tid -> Value -> App ()
checkFeature String
"classifiedDomains" Value
m String
tid Value
expected