-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2026 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.Migration.TeamFeatures where

import qualified API.Galley as Public
import qualified API.GalleyInternal as Internal
import Control.Monad.Codensity
import Control.Monad.Reader
import SetupHelpers
import Test.FeatureFlags.Util
import Test.Migration.Util (waitForMigration)
import Testlib.Prelude hiding (pairs)
import Testlib.ResourcePool

testTeamFeaturesMigration :: (HasCallStack) => App ()
testTeamFeaturesMigration :: HasCallStack => App ()
testTeamFeaturesMigration = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
backend] -> do
    let preMigration :: App ([(Value, String, [Value])], [(Value, String, [Value])])
-> App ([(Value, String, [Value])], [(Value, String, [Value])])
preMigration = Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend (String -> Bool -> ServiceOverrides
conf String
"cassandra" Bool
False)) ((String
  -> App ([(Value, String, [Value])], [(Value, String, [Value])]))
 -> App ([(Value, String, [Value])], [(Value, String, [Value])]))
-> (App ([(Value, String, [Value])], [(Value, String, [Value])])
    -> String
    -> App ([(Value, String, [Value])], [(Value, String, [Value])]))
-> App ([(Value, String, [Value])], [(Value, String, [Value])])
-> App ([(Value, String, [Value])], [(Value, String, [Value])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App ([(Value, String, [Value])], [(Value, String, [Value])])
-> String
-> App ([(Value, String, [Value])], [(Value, String, [Value])])
forall a b. a -> b -> a
const
        switchToMigratingInterpreter :: App () -> App ()
switchToMigratingInterpreter = Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend (String -> Bool -> ServiceOverrides
conf String
"migration-to-postgresql" Bool
False)) ((String -> App ()) -> App ())
-> (App () -> String -> App ()) -> App () -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> String -> App ()
forall a b. a -> b -> a
const
        startMigration :: App () -> App ()
startMigration = Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend (String -> Bool -> ServiceOverrides
conf String
"migration-to-postgresql" Bool
True)) ((String -> App ()) -> App ())
-> (App () -> String -> App ()) -> App () -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> String -> App ()
forall a b. a -> b -> a
const
        stopMigration :: App () -> App ()
stopMigration = Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend (String -> Bool -> ServiceOverrides
conf String
"migration-to-postgresql" Bool
False)) ((String -> App ()) -> App ())
-> (App () -> String -> App ()) -> App () -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> String -> App ()
forall a b. a -> b -> a
const
        switchToPostgresInterpreter :: App () -> App ()
switchToPostgresInterpreter = Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend (String -> Bool -> ServiceOverrides
conf String
"postgresql" Bool
False)) ((String -> App ()) -> App ())
-> (App () -> String -> App ()) -> App () -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> String -> App ()
forall a b. a -> b -> a
const
        domain :: String
domain = BackendResource
backend.berDomain

    (teams0, teams1) <-
      App ([(Value, String, [Value])], [(Value, String, [Value])])
-> App ([(Value, String, [Value])], [(Value, String, [Value])])
preMigration (App ([(Value, String, [Value])], [(Value, String, [Value])])
 -> App ([(Value, String, [Value])], [(Value, String, [Value])]))
-> App ([(Value, String, [Value])], [(Value, String, [Value])])
-> App ([(Value, String, [Value])], [(Value, String, [Value])])
forall a b. (a -> b) -> a -> b
$ do
        teams0 <- Int
-> App (Value, String, [Value]) -> App [(Value, String, [Value])]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (App (Value, String, [Value]) -> App [(Value, String, [Value])])
-> App (Value, String, [Value]) -> App [(Value, String, [Value])]
forall a b. (a -> b) -> a -> b
$ String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
2
        teams1@(team1 : _) <- replicateM 5 $ createTeam domain 1
        for_ teams0 $ \(Value
owner, String
tid, [Value]
_) -> Value -> String -> [String] -> App ()
enableFeatures Value
owner String
tid [String]
unlockableFeatures
        testSetFeatures team1
        testGetFeatures team1
        pure (teams0, teams1)

    team1 : team2 : team3 : team4 : team5 : _ <- pure teams1

    switchToMigratingInterpreter $ do
      assertModifiedFeatures domain teams0
      testSetFeatures team2
      testGetFeatures team1
      testGetFeatures team2

    startMigration $ do
      assertModifiedFeatures domain teams0
      testSetFeatures team3
      testGetFeatures team1
      testGetFeatures team2
      testGetFeatures team3
      waitForMigration domain counterName

    stopMigration $ do
      assertModifiedFeatures domain teams0
      testSetFeatures team4
      testGetFeatures team1
      testGetFeatures team2
      testGetFeatures team3
      testGetFeatures team4

    switchToPostgresInterpreter $ do
      assertModifiedFeatures domain teams0
      testSetFeatures team5
      testGetFeatures team1
      testGetFeatures team2
      testGetFeatures team3
      testGetFeatures team4
      testGetFeatures team5
  where
    unlockableFeatures :: [String]
    unlockableFeatures :: [String]
unlockableFeatures =
      [ String
"fileSharing",
        String
"conferenceCalling",
        String
"selfDeletingMessages",
        String
"conversationGuestLinks",
        String
"sndFactorPasswordChallenge",
        String
"mls",
        String
"outlookCalIntegration",
        String
"mlsE2EId",
        String
"mlsMigration",
        String
"enforceFileDownloadLocation",
        String
"domainRegistration",
        String
"channels",
        String
"cells",
        String
"consumableNotifications",
        String
"chatBubbles",
        String
"apps",
        String
"simplifiedUserConnectionRequestQRCode",
        String
"stealthUsers",
        String
"meetings",
        String
"meetingsPremium",
        String
"backgroundEffects"
      ]

    assertModifiedFeatures :: String -> [(Value, String, [Value])] -> App ()
    assertModifiedFeatures :: String -> [(Value, String, [Value])] -> App ()
assertModifiedFeatures String
domain [(Value, String, [Value])]
teams = do
      expectedModifiedFeatures <-
        Value -> App Value
mkExpectedModifiedFeatures Value
defAllFeatures
          App Value -> (Value -> 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
>>= String -> [String] -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"classifiedDomains.config.domains" [String
domain]
      for_ teams $ \(Value
owner, String
tid, [Value]
_) ->
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user tid.
(HasCallStack, MakesValue user, MakesValue tid) =>
user -> tid -> App Response
Public.getTeamFeatures Value
owner String
tid) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          [String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String]
unlockableFeatures ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
feat -> do
            Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
feat App 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"
            Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
feat App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"lockStatus" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"unlocked"
          Response
resp.json Maybe Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expectedModifiedFeatures

    enableFeatures :: Value -> String -> [String] -> App ()
    enableFeatures :: Value -> String -> [String] -> App ()
enableFeatures Value
owner String
tid [String]
features = do
      [String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String]
features ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
name -> do
        Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
Internal.setTeamFeatureLockStatus Value
owner String
tid String
name String
"unlocked"
        HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
Internal.setTeamFeatureStatus Value
owner String
tid String
name String
"enabled"

    testSetFeatures :: (HasCallStack) => (Value, String, [Value]) -> App ()
    testSetFeatures :: HasCallStack => (Value, String, [Value]) -> App ()
testSetFeatures (Value
owner, String
tid, [Value]
_) = do
      Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
Internal.setTeamFeatureLockStatus Value
owner String
tid String
"channels" String
"unlocked"
      Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
Internal.setTeamFeatureLockStatus Value
owner String
tid String
"enforceFileDownloadLocation" String
"unlocked"
      HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> 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
Internal.setTeamFeatureConfig Value
owner String
tid String
"channels" Value
channelsConfig
      HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> 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
Internal.setTeamFeatureConfig Value
owner String
tid String
"enforceFileDownloadLocation" Value
enforceDownloadLocationConfig
      where
        channelsConfig :: Value
        channelsConfig :: Value
channelsConfig =
          [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
"allowed_to_create_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team-members",
                    String
"allowed_to_open_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"admins"
                  ]
            ]

        enforceDownloadLocationConfig :: Value
        enforceDownloadLocationConfig :: Value
enforceDownloadLocationConfig =
          [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
"enforcedDownloadLocation" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"/tmp/migration-test"]
            ]

    testGetFeatures :: (HasCallStack) => (Value, String, [Value]) -> App ()
    testGetFeatures :: HasCallStack => (Value, String, [Value]) -> App ()
testGetFeatures (Value
owner, String
tid, [Value]
_) = do
      expectedChannels <- App Value
expectedChannelsConfig
      expectedDownloadLocation <- expectedEnforceDownloadLocationConfig
      bindResponse (Public.getTeamFeature owner tid "channels") $ \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 -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expectedChannels
      bindResponse (Public.getTeamFeature owner tid "enforceFileDownloadLocation") $ \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 -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
expectedDownloadLocation
      where
        expectedChannelsConfig :: App Value
        expectedChannelsConfig :: App Value
expectedChannelsConfig = do
          defChannels <- Value
defAllFeatures Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"channels"
          defChannels
            & setField "lockStatus" "unlocked"
              >>= setField "status" "enabled"
              >>= setField "config.allowed_to_create_channels" "team-members"
              >>= setField "config.allowed_to_open_channels" "admins"

        expectedEnforceDownloadLocationConfig :: App Value
        expectedEnforceDownloadLocationConfig :: App Value
expectedEnforceDownloadLocationConfig = do
          defFeature <- Value
defAllFeatures Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"enforceFileDownloadLocation"
          defFeature
            & setField "lockStatus" "unlocked"
              >>= setField "status" "enabled"
              >>= setField "config.enforcedDownloadLocation" "/tmp/migration-test"

    mkExpectedModifiedFeatures :: Value -> App Value
    mkExpectedModifiedFeatures :: Value -> App Value
mkExpectedModifiedFeatures Value
features =
      (App Value -> String -> App Value)
-> App Value -> [String] -> App Value
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((String -> App Value -> App Value)
-> App Value -> String -> App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> App Value -> App Value
forall {a}. MakesValue a => String -> a -> App Value
update) (Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
features) [String]
unlockableFeatures
      where
        update :: String -> a -> App Value
update String
feat =
          String -> String -> a -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField (String
feat String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".status") String
"enabled"
            (a -> App Value) -> (Value -> App Value) -> a -> App Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField (String
feat String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".lockStatus") String
"unlocked"

    conf :: String -> Bool -> ServiceOverrides
    conf :: String -> Bool -> ServiceOverrides
conf String
db Bool
runMigration =
      ServiceOverrides
forall a. Default a => a
def
        { galleyCfg = setField "postgresMigration.teamFeatures" db,
          backgroundWorkerCfg = setField "migrateTeamFeatures" runMigration
        }

counterName :: String
counterName :: String
counterName = String
"^wire_team_features_migration_finished"