-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 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.FeatureFlags.Cells where

import API.Galley (setTeamFeatureConfigVersioned)
import SetupHelpers
import Test.FeatureFlags.Util
import Testlib.Prelude

testCells :: (HasCallStack) => APIAccess -> App ()
testCells :: HasCallStack => APIAccess -> App ()
testCells APIAccess
access =
  String -> FeatureTests
mkFeatureTests String
"cells"
    FeatureTests -> (FeatureTests -> FeatureTests) -> FeatureTests
forall a b. a -> (a -> b) -> b
& Value -> FeatureTests -> FeatureTests
addUpdate (Bool -> Value
validConfig Bool
True)
    FeatureTests -> (FeatureTests -> FeatureTests) -> FeatureTests
forall a b. a -> (a -> b) -> b
& Value -> FeatureTests -> FeatureTests
addUpdate (Bool -> Value
validConfig Bool
False)
    FeatureTests -> (FeatureTests -> FeatureTests) -> FeatureTests
forall a b. a -> (a -> b) -> b
& Value -> FeatureTests -> FeatureTests
addInvalidUpdate Value
invalidConfig
    FeatureTests -> (FeatureTests -> App ()) -> App ()
forall a b. a -> (a -> b) -> b
& Domain -> APIAccess -> FeatureTests -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> APIAccess -> FeatureTests -> App ()
runFeatureTests Domain
OwnDomain APIAccess
access

testPatchCells :: (HasCallStack) => App ()
testPatchCells :: HasCallStack => App ()
testPatchCells = Domain -> String -> Value -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Value -> App ()
checkPatch Domain
OwnDomain String
"cells" (Bool -> Value
validConfig Bool
True)

validConfig :: Bool -> Value
validConfig :: Bool -> Value
validConfig Bool
b =
  [Pair] -> Value
object
    [ String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= if Bool
b then String
"enabled" else String
"disabled",
      String
"config"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"channels"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
                  String
"default" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"
                ],
            String
"groups"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
                  String
"default" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"
                ],
            String
"one2one"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
                  String
"default" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"
                ],
            String
"users"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"externals" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
                  String
"guests" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False
                ],
            String
"collabora"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False],
            String
"publicLinks"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"enableFiles" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
                  String
"enableFolders" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
                  String
"enforcePassword" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False,
                  String
"enforceExpirationMax" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
0 :: Int),
                  String
"enforceExpirationDefault" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
0 :: Int)
                ],
            String
"storage"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"perFileQuotaBytes" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"100000000",
                  String
"recycle"
                    String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                      [ String
"autoPurgeDays" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
30 :: Int),
                        String
"disable" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False,
                        String
"allowSkip" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False
                      ]
                ],
            String
"metadata"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ String
"namespaces"
                    String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                      [ String
"usermetaTags"
                          String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                            [ String
"defaultValues" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [String]),
                              String
"allowFreeValues" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True
                            ]
                      ]
                ]
          ]
    ]

invalidConfig :: Value
invalidConfig :: Value
invalidConfig =
  [Pair] -> Value
object
    [ 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
"foox" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"bar"]
    ]

testCellsV13 :: (HasCallStack) => App ()
testCellsV13 :: HasCallStack => App ()
testCellsV13 = 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
1
  Versioned -> Value -> String -> String -> Value -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
Versioned -> user -> team -> featureName -> payload -> App Response
setTeamFeatureConfigVersioned
    (Int -> Versioned
ExplicitVersion Int
13)
    Value
alice
    String
tid
    String
"cells"
    Value
enabled
    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