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

import API.Brig
import SetupHelpers
import Testlib.Prelude

testGetSettingsPublic ::
  (HasCallStack) =>
  Tagged "nomad-profiles" (Maybe Bool) ->
  Tagged "restrict-user-creation" (Maybe Bool) ->
  App ()
testGetSettingsPublic :: HasCallStack =>
Tagged "nomad-profiles" (Maybe Bool)
-> Tagged "restrict-user-creation" (Maybe Bool) -> App ()
testGetSettingsPublic (MkTagged Maybe Bool
nomadProfiles) (MkTagged Maybe Bool
restrictUserCreation) =
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
forall a. Default a => a
def {brigCfg = setFields} \String
domain -> do
    String -> App Response
forall domain. MakesValue domain => domain -> App Response
getSystemSettingsPublic String
domain 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
      Maybe Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"nomadProfiles" App (Maybe Value) -> Maybe Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Maybe Bool
nomadProfiles
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"setRestrictUserCreation" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
restrictUserCreation
  where
    setFields :: Value -> App Value
setFields =
      (Value -> App Value)
-> (Bool -> Value -> App Value) -> Maybe Bool -> Value -> App Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Value -> App Value
forall a. (HasCallStack, MakesValue a) => String -> a -> App Value
removeField String
"optSettings.setNomadProfiles") (String -> Bool -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"optSettings.setNomadProfiles") Maybe Bool
nomadProfiles
        (Value -> App Value) -> (Value -> App Value) -> Value -> App Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Value -> App Value)
-> (Bool -> Value -> App Value) -> Maybe Bool -> Value -> App Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Value -> App Value
forall a. (HasCallStack, MakesValue a) => String -> a -> App Value
removeField String
"optSettings.setRestrictUserCreation") (String -> Bool -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"optSettings.setRestrictUserCreation") Maybe Bool
restrictUserCreation

testGetSettingsInternal :: (HasCallStack) => Tagged "enabled-mls" (Maybe Bool) -> App ()
testGetSettingsInternal :: HasCallStack => Tagged "enabled-mls" (Maybe Bool) -> App ()
testGetSettingsInternal (MkTagged Maybe Bool
enableMls) = do
  let conf :: ServiceOverrides
conf = ServiceOverrides
forall a. Default a => a
def {brigCfg = maybe (removeField "optSettings.setEnableMLS") (setField "optSettings.setEnableMLS") enableMls}
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
conf \String
domain -> do
    user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
    getSystemSettingsInternal user `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"setEnableMls" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
enableMls

testGetSettingsInternalSsoIdpChangeDetection ::
  (HasCallStack) =>
  Tagged "sso-idp-change-detection" (Maybe Bool) ->
  App ()
testGetSettingsInternalSsoIdpChangeDetection :: HasCallStack =>
Tagged "sso-idp-change-detection" (Maybe Bool) -> App ()
testGetSettingsInternalSsoIdpChangeDetection (MkTagged Maybe Bool
multiIngress) = do
  let conf :: ServiceOverrides
conf =
        ServiceOverrides
forall a. Default a => a
def
          { brigCfg =
              maybe
                (removeField "optSettings.setSsoIdpChangeDetectionInputs")
                (setField "optSettings.setSsoIdpChangeDetectionInputs" . sparInputs)
                multiIngress
          }
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
conf \String
domain -> do
    user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
    getSystemSettingsInternal user `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      -- Brig derives the flag in Haskell from the raw inputs: true iff both the
      -- multi-ingress domain configs and the IdP cert fingerprint allowlist are
      -- non-empty (Brig.Options.deriveSsoIdpChangeDetectionEnabled); absent
      -- inputs mean disabled. The tag enumerates Nothing/Just False/Just True
      -- (GEnum), so `fromMaybe` — not `fromJust`.
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"ssoIdpChangeDetectionEnabled" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
multiIngress
    getSystemSettingsPublic domain `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Maybe Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"ssoIdpChangeDetectionEnabled" App (Maybe Value) -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe Value
forall a. Maybe a
Nothing :: Maybe Value)

-- | Minimal mirror of @spar.config@: 'True' is a multi-ingress spar (non-empty
-- @domainConfigs@ and allowlist); 'False' is single-ingress spar (both empty).
sparInputs :: Bool -> Value
sparInputs :: Bool -> Value
sparInputs Bool
multiIngress =
  [Pair] -> Value
object
    [ String
"multiIngressDomainConfigs"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= if Bool
multiIngress then [Pair] -> Value
object [String
"example.com" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object []] else [Pair] -> Value
object [],
      String
"idpCertFingerprintAllowlist"
        String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= if Bool
multiIngress then [String
"00:11:22:33:44:55:66:77:88:99:AA:BB:CC:DD:EE:FF:00:11:22:33" :: String] else ([] :: [String])
    ]