module Test.FeatureFlags.Initialisation where

import API.GalleyInternal
import Control.Monad.Codensity
import Control.Monad.Extra
import Control.Monad.Reader
import SetupHelpers
import Testlib.Prelude
import Testlib.ResourcePool

testMLSInitialisation :: (HasCallStack) => App ()
testMLSInitialisation :: HasCallStack => App ()
testMLSInitialisation = do
  let override :: ServiceOverrides
override =
        ServiceOverrides
forall a. Default a => a
def
          { galleyCfg =
              setField
                "settings.featureFlags.mls"
                ( object
                    [ "initialConfig"
                        .= object
                          [ "protocolToggleUsers" .= ([] :: [Int]),
                            "defaultProtocol" .= "mls",
                            "allowedCipherSuites" .= [1, 2 :: Int],
                            "defaultCipherSuite" .= (1 :: Int),
                            "supportedProtocols" .= ["mls", "proteus"]
                          ]
                    ]
                )
                >=> removeField "settings.featureFlags.mlsMigration"
          }

  ResourcePool BackendResource
pool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity do
    [BackendResource
resource] <- Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
1 ResourcePool BackendResource
pool

    (Value
alice, String
aliceTeam) <- App (Value, String) -> Codensity App (Value, String)
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App (Value, String) -> Codensity App (Value, String))
-> App (Value, String) -> Codensity App (Value, String)
forall a b. (a -> b) -> a -> b
$ Codensity App (Value, String) -> App (Value, String)
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity do
      -- start a dynamic backend with default configuration
      String
domain <- BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
resource ServiceOverrides
forall a. Default a => a
def

      -- create a team
      App (Value, String) -> Codensity App (Value, String)
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
        (Value
alice, String
tid, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
0
        Value
feat <- Value -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature Value
alice String
tid String
"mls" 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
200
        Value
feat Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"config.defaultProtocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"proteus"
        (Value, String) -> App (Value, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
alice, String
tid)

    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity do
      -- now start the backend again, this time with an initial mls
      -- configuration set
      String
domain <- BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
resource ServiceOverrides
override

      -- a pre-existing team should get the default configuration
      App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
        Value
feat <- Value -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature Value
alice String
aliceTeam String
"mls" 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
200
        Value
feat Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"config.defaultProtocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"proteus"

      -- a new team should get the initial mls configuration
      App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
        (Value
bob, String
tid, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
0
        Value
feat <- Value -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature Value
bob String
tid String
"mls" 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
200
        Value
feat Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"config.defaultProtocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls"

        -- if the mls feature is locked, the config reverts back to default
        App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
          (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> Value -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> Value -> App Response
patchTeamFeature Value
bob String
tid String
"mls" ([Pair] -> Value
object [String
"lockStatus" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"locked"])
          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
200
        Value
feat' <- Value -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature Value
bob String
tid String
"mls" 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
200
        Value
feat' Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"config.defaultProtocol" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"proteus"