-- 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.AdminlessGroups where

import API.Brig
import API.Galley
import API.GalleyInternal hiding (getConversation)
import qualified API.GalleyInternal as GalleyI
import MLS.Util
import Notifications
import SetupHelpers hiding (deleteUser)
import Testlib.Prelude

testOnLastAdminLeaveReturnEligibleMembers :: (HasCallStack) => App ()
testOnLastAdminLeaveReturnEligibleMembers :: HasCallStack => App ()
testOnLastAdminLeaveReturnEligibleMembers = do
  -- bob is eligible
  (alice, tid, [bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  setTeamFeatureLockStatus OwnDomain tid "preventAdminlessGroups" "unlocked"
  patchTeamFeature OwnDomain tid "preventAdminlessGroups" (object ["status" .= "enabled"]) >>= assertSuccess

  -- local user is eligible
  localUser <- randomUser OwnDomain def
  connectTwoUsers alice localUser

  -- ephemeral user is not eligible
  tmpUser <- ephemeralUser OwnDomain

  -- a remote user is not eligible
  remoteUser <- randomUser OtherDomain def
  connectTwoUsers alice remoteUser

  -- app is not eligible
  let newApp = NewApp
forall a. Default a => a
def {name = "some-app", description = "non-eligible app member"}
  app <- bindResponse (createApp alice tid newApp) $ \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
"user"

  clients@(alice1 : tmpUser1 : _) <- traverse (createMLSClient def) [alice, tmpUser, bob, localUser, remoteUser, app]
  for_ clients (uploadNewKeyPackage def)

  conv <- createTeamMLSConversation alice tid alice1 [bob, app, localUser, remoteUser]
  convId <- objConvId conv

  (key, code) <- bindResponse (postConversationCode alice conv Nothing Nothing) $ \Response
resp -> do
    res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
    (,) <$> (res %. "data.key" & asString) <*> (res %. "data.code" & asString)
  postJoinCodeConv tmpUser key code >>= assertSuccess
  void $ createExternalCommit convId tmpUser1 Nothing >>= sendAndConsumeCommitBundle

  GalleyI.getConversation conv `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    members <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    actual <- traverse (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") members
    expected <- traverse (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") [alice, tmpUser, bob, localUser, remoteUser, app]
    actual `shouldMatchSet` expected

  assertAttemptToLeaveFails conv alice [bob, localUser]

  -- promote bob to admin
  void $ updateRole alice bob "wire_admin" (conv %. "qualified_id") >>= assertSuccess

  -- attempt to leave should succeed now
  bindResponse (removeMember alice conv alice) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  assertAttemptToLeaveFails conv bob [localUser]

  -- before bob leaves, we make sure the local user is not an admin
  bindResponse (getConversation localUser conv) $ \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
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_member"

  -- in V15 it should be possible to leave (autopromotion should be triggered)
  bindResponse (removeMemberV15 bob conv bob) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- assert autopromotion worked and the local user is an admin now
  bindResponse (getConversation localUser conv) $ \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
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_admin"
  where
    assertAttemptToLeaveFails :: conv -> removed -> t a -> App ()
assertAttemptToLeaveFails conv
conv removed
user t a
eligible =
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (removed -> conv -> removed -> App Response
forall remover conv removed.
(HasCallStack, MakesValue remover, MakesValue conv,
 MakesValue removed) =>
remover -> conv -> removed -> App Response
removeMember removed
user conv
conv removed
user) ((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
403
        Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"adminless-conversation"
        eligibleMembers <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"eligible_members" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
        expected <- for eligible $ \a
u -> a
u a -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
        eligibleMembers `shouldMatchSet` expected

    removeMemberV15 :: (HasCallStack, MakesValue remover, MakesValue conv, MakesValue removed) => remover -> conv -> removed -> App Response
    removeMemberV15 :: forall remover conv removed.
(HasCallStack, MakesValue remover, MakesValue conv,
 MakesValue removed) =>
remover -> conv -> removed -> App Response
removeMemberV15 remover
remover conv
qcnv removed
removed = do
      (convDomain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
      (removedDomain, removedId) <- objQid removed
      req <- baseRequest remover Galley (ExplicitVersion 15) (joinHttpPath ["conversations", convDomain, convId, "members", removedDomain, removedId])
      submit "DELETE" req

testOnLastAdminLeaveNoEligibleMembersExist :: (HasCallStack) => App ()
testOnLastAdminLeaveNoEligibleMembersExist :: HasCallStack => App ()
testOnLastAdminLeaveNoEligibleMembersExist = do
  (alice, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  configureAdminlessGroupsFeature OwnDomain tid "enabled" "10s" ["9s", "8s"]

  tmpUser <- ephemeralUser OwnDomain

  alice1 <- createMLSClient def alice
  tmpUser1 <- createMLSClient def tmpUser
  traverse_ (uploadNewKeyPackage def) [alice1, tmpUser1]

  conv <- createTeamMLSConversation alice tid alice1 []
  let newApp = NewApp
forall a. Default a => a
def {name = "adminless-reminder-app", description = "not eligible for promotion"}
  (app, _) <- createAndAddAppMember alice tid alice1 conv newApp
  convId <- objConvId conv

  (key, code) <- bindResponse (postConversationCode alice conv Nothing Nothing) $ \Response
resp -> do
    res <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 Response
resp
    (,) <$> (res %. "data.key" & asString) <*> (res %. "data.code" & asString)
  postJoinCodeConv tmpUser key code >>= assertSuccess
  void $ createExternalCommit convId tmpUser1 Nothing >>= sendAndConsumeCommitBundle

  GalleyI.getConversation conv `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    members <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" 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
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    actual <- traverse (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") members
    expected <- traverse (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") [app, alice, tmpUser]
    actual `shouldMatchSet` expected

  withWebSockets [app, tmpUser] $ \[WebSocket
wsApp, WebSocket
wsTmpUser] -> do
    -- alice leaves the conversation, no error, group will be marked for deletion
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Value -> App Response
forall remover conv removed.
(HasCallStack, MakesValue remover, MakesValue conv,
 MakesValue removed) =>
remover -> conv -> removed -> App Response
removeMember Value
alice Value
conv Value
alice) ((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

    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
$ HasCallStack =>
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
awaitNMatches Int
2 Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvAdminlessReminderNotif WebSocket
wsApp
    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
$ HasCallStack =>
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
Int -> (Value -> App Bool) -> WebSocket -> App [Value]
awaitNMatches Int
2 Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvAdminlessReminderNotif WebSocket
wsTmpUser

    -- The deletion event is sent after the conversation has been removed. The
    -- suite's local timeout is only 2s, but this job is scheduled 10s ahead.
    -- Use a longer timeout here and avoid racing the final HTTP assertion.
    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
$ HasCallStack =>
Int -> (Value -> App Bool) -> WebSocket -> App Value
Int -> (Value -> App Bool) -> WebSocket -> App Value
awaitMatchFor Int
15 Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvDeleteNotif WebSocket
wsApp
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall conv.
(HasCallStack, MakesValue conv) =>
conv -> App Response
GalleyI.getConversation Value
conv) ((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
404

testAdminlessSetupOnFeatureEnable :: (HasCallStack) => App ()
testAdminlessSetupOnFeatureEnable :: HasCallStack => App ()
testAdminlessSetupOnFeatureEnable = do
  (alice, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  setTeamFeatureLockStatus OwnDomain tid "preventAdminlessGroups" "unlocked"
  patchTeamFeature OwnDomain tid "preventAdminlessGroups" (object ["status" .= "disabled"]) >>= assertSuccess

  alice1 <- createMLSClient def alice
  void $ uploadNewKeyPackage def alice1
  conv <- createTeamMLSConversation alice tid alice1 []
  let newApp = NewApp
forall a. Default a => a
def {name = "adminless-setup-app", description = "not eligible for promotion"}
  (app, _) <- createAndAddAppMember alice tid alice1 conv newApp

  -- The feature is disabled, so leaving the conversation must not schedule a
  -- deletion job. Enabling it afterwards exercises the team reconciliation job.
  bindResponse (removeMember alice conv alice) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  bindResponse (GalleyI.getConversation conv) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  withWebSockets [app] $ \[WebSocket
wsApp] -> do
    Domain -> String -> String -> String -> [String] -> App ()
forall domain.
MakesValue domain =>
domain -> String -> String -> String -> [String] -> App ()
configureAdminlessGroupsFeature Domain
OwnDomain String
tid String
"enabled" String
"5s" [String
"4s"]

    -- Leave enough margin for the setup job to enqueue both jobs and for them
    -- to be picked up when the integration suite is under load.
    reminder <- HasCallStack =>
Int -> (Value -> App Bool) -> WebSocket -> App Value
Int -> (Value -> App Bool) -> WebSocket -> App Value
awaitMatchFor Int
20 Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvSystemAdminlessReminderNotif WebSocket
wsApp
    reminder %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv
    void $ reminder %. "payload.0.data.deletion_scheduled_for" & asString
    void $ awaitMatchFor 20 isConvDeleteNotif wsApp
    bindResponse (GalleyI.getConversation conv) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testAdminlessSetupSystemMemberUpdate :: (HasCallStack) => App ()
testAdminlessSetupSystemMemberUpdate :: HasCallStack => App ()
testAdminlessSetupSystemMemberUpdate = do
  (alice, tid, [bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  setTeamFeatureLockStatus OwnDomain tid "preventAdminlessGroups" "unlocked"
  patchTeamFeature OwnDomain tid "preventAdminlessGroups" (object ["status" .= "disabled"]) >>= assertSuccess

  [alice1, bob1] <- traverse (createMLSClient def) [alice, bob]
  traverse_ (uploadNewKeyPackage def) [alice1, bob1]

  conv <- createTeamMLSConversation alice tid alice1 [bob]

  -- Create an adminless conversation while the feature is disabled. The setup
  -- job will later autopromote bob without an originating user ID.
  bindResponse (removeMember alice conv alice) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  withWebSockets [bob] $ \[WebSocket
wsBob] -> do
    Domain -> 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
patchTeamFeature Domain
OwnDomain String
tid String
"preventAdminlessGroups" ([Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"]) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    notif <- HasCallStack =>
Int -> (Value -> App Bool) -> WebSocket -> App Value
Int -> (Value -> App Bool) -> WebSocket -> App Value
awaitMatchFor Int
20 Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvSystemMemberUpdateNotif WebSocket
wsBob
    notif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv
    notif %. "payload.0.data.qualified_target" `shouldMatch` objQidObject bob
    notif %. "payload.0.data.conversation_role" `shouldMatch` "wire_admin"

    bindResponse (getConversation bob conv) $ \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
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_admin"

testAdminlessJobsCancelledOnFeatureDisable :: (HasCallStack) => App ()
testAdminlessJobsCancelledOnFeatureDisable :: HasCallStack => App ()
testAdminlessJobsCancelledOnFeatureDisable = do
  (alice, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  configureAdminlessGroupsFeature OwnDomain tid "enabled" "5s" []

  alice1 <- createMLSClient def alice
  void $ uploadNewKeyPackage def alice1
  conv <- createTeamMLSConversation alice tid alice1 []
  let newApp = NewApp
forall a. Default a => a
def {name = "adminless-cancel-app", description = "not eligible for promotion"}
  (app, _) <- createAndAddAppMember alice tid alice1 conv newApp

  withWebSockets [app] $ \[WebSocket
wsApp] -> do
    -- Leaving schedules deletion while the feature is enabled.
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Value -> App Response
forall remover conv removed.
(HasCallStack, MakesValue remover, MakesValue conv,
 MakesValue removed) =>
remover -> conv -> removed -> App Response
removeMember Value
alice Value
conv Value
alice) ((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

    -- Disabling the feature must cancel the pending deletion before its deadline.
    Domain -> 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
patchTeamFeature Domain
OwnDomain String
tid String
"preventAdminlessGroups" ([Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"disabled"]) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    -- Wait beyond the original deadline and worker polling window. The
    -- conversation must remain because the pending job was canceled. Feature
    -- update events are ignored by the matcher.
    result <- HasCallStack =>
Int -> Int -> (Value -> App Bool) -> WebSocket -> App AwaitResult
Int -> Int -> (Value -> App Bool) -> WebSocket -> App AwaitResult
awaitNMatchesResultFor Int
15 Int
1 Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvDeleteNotif WebSocket
wsApp
    result.success `shouldMatch` False
    bindResponse (GalleyI.getConversation conv) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

testAdminlessJobsRecreatedOnFeatureConfigChange :: (HasCallStack) => App ()
testAdminlessJobsRecreatedOnFeatureConfigChange :: HasCallStack => App ()
testAdminlessJobsRecreatedOnFeatureConfigChange = do
  (alice, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  configureAdminlessGroupsFeature OwnDomain tid "enabled" "10s" []

  alice1 <- createMLSClient def alice
  void $ uploadNewKeyPackage def alice1
  conv <- createTeamMLSConversation alice tid alice1 []
  let newApp = NewApp
forall a. Default a => a
def {name = "adminless-reschedule-app", description = "not eligible for promotion"}
  (app, _) <- createAndAddAppMember alice tid alice1 conv newApp

  withWebSockets [app] $ \[WebSocket
wsApp] -> do
    -- Leaving schedules a deletion using the original timeout.
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Value -> App Response
forall remover conv removed.
(HasCallStack, MakesValue remover, MakesValue conv,
 MakesValue removed) =>
remover -> conv -> removed -> App Response
removeMember Value
alice Value
conv Value
alice) ((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

    -- Changing the configuration must cancel the old job and recreate it
    -- using the new timeout.
    Domain -> String -> String -> String -> [String] -> App ()
forall domain.
MakesValue domain =>
domain -> String -> String -> String -> [String] -> App ()
configureAdminlessGroupsFeature Domain
OwnDomain String
tid String
"enabled" String
"20s" []

    -- If the old job was not canceled, it would delete the conversation after
    -- 10s. Wait past that deadline before checking that it still exists.
    oldJobResult <- HasCallStack =>
Int -> Int -> (Value -> App Bool) -> WebSocket -> App AwaitResult
Int -> Int -> (Value -> App Bool) -> WebSocket -> App AwaitResult
awaitNMatchesResultFor Int
15 Int
1 Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvDeleteNotif WebSocket
wsApp
    oldJobResult.success `shouldMatch` False
    bindResponse (GalleyI.getConversation conv) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

    -- The replacement job uses the new 20s timeout.
    void $ awaitMatchFor 30 isConvDeleteNotif wsApp
    bindResponse (GalleyI.getConversation conv) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testAdminlessJobCancellationIsTeamScoped :: (HasCallStack) => App ()
testAdminlessJobCancellationIsTeamScoped :: HasCallStack => App ()
testAdminlessJobCancellationIsTeamScoped = do
  (alice, canceledTid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  (bob, activeTid, _) <- createTeam OwnDomain 1

  let enabledFeature = String -> String -> [String] -> Value
mkAdminlessFeature String
"enabled" String
"10s" []

  for_ [canceledTid, activeTid] $ \String
tid -> do
    Domain -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Domain
OwnDomain String
tid String
"preventAdminlessGroups" String
"unlocked"
    Domain -> 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
patchTeamFeature Domain
OwnDomain String
tid String
"preventAdminlessGroups" Value
enabledFeature App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  let newApp String
name = NewApp
forall a. Default a => a
def {name = name, description = "not eligible for promotion"}
  alice1 <- createMLSClient def alice
  bob1 <- createMLSClient def bob
  traverse_ (uploadNewKeyPackage def) [alice1, bob1]

  canceledConv <- createTeamMLSConversation alice canceledTid alice1 []
  (canceledApp, _) <- createAndAddAppMember alice canceledTid alice1 canceledConv (newApp "adminless-cancel-team-app")

  activeConv <- createTeamMLSConversation bob activeTid bob1 []
  (activeApp, _) <- createAndAddAppMember bob activeTid bob1 activeConv (newApp "adminless-active-team-app")

  withWebSockets [canceledApp, activeApp] $ \[WebSocket
wsCanceled, WebSocket
wsActive] -> do
    -- Schedule one deletion job for each team before disabling only one team.
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Value -> App Response
forall remover conv removed.
(HasCallStack, MakesValue remover, MakesValue conv,
 MakesValue removed) =>
remover -> conv -> removed -> App Response
removeMember Value
alice Value
canceledConv Value
alice) ((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
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> Value -> App Response
forall remover conv removed.
(HasCallStack, MakesValue remover, MakesValue conv,
 MakesValue removed) =>
remover -> conv -> removed -> App Response
removeMember Value
bob Value
activeConv Value
bob) ((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

    Domain -> 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
patchTeamFeature Domain
OwnDomain String
canceledTid String
"preventAdminlessGroups" ([Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"disabled"]) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    -- The cancellation query must not affect the other team's job.
    canceledResult <- HasCallStack =>
Int -> Int -> (Value -> App Bool) -> WebSocket -> App AwaitResult
Int -> Int -> (Value -> App Bool) -> WebSocket -> App AwaitResult
awaitNMatchesResultFor Int
20 Int
1 Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isConvDeleteNotif WebSocket
wsCanceled
    canceledResult.success `shouldMatch` False
    void $ awaitMatchFor 30 isConvDeleteNotif wsActive

    bindResponse (GalleyI.getConversation canceledConv) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    bindResponse (GalleyI.getConversation activeConv) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testOnLastAdminLeaveFeatureDisabled :: (HasCallStack) => App ()
testOnLastAdminLeaveFeatureDisabled :: HasCallStack => App ()
testOnLastAdminLeaveFeatureDisabled = do
  -- bob is eligible
  (alice, tid, [bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  setTeamFeatureLockStatus OwnDomain tid "preventAdminlessGroups" "unlocked"
  patchTeamFeature OwnDomain tid "preventAdminlessGroups" (object ["status" .= "disabled"]) >>= assertSuccess

  clients@(alice1 : _) <- traverse (createMLSClient def) [alice, bob]
  for_ clients (uploadNewKeyPackage def)

  conv <- postConversation alice defMLS {team = Just tid} >>= getJSON 201
  convId <- objConvId conv
  createGroup def alice1 convId
  void $ createAddCommit alice1 convId [bob] >>= sendAndConsumeCommitBundle

  -- alice leaves the conversation, no error, no autopromotion
  bindResponse (removeMember alice conv alice) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

testOnLastAdminTeamMemberDeletionAutopromotes :: (HasCallStack) => App ()
testOnLastAdminTeamMemberDeletionAutopromotes :: HasCallStack => App ()
testOnLastAdminTeamMemberDeletionAutopromotes = do
  (alice, tid, [charlie]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  setTeamFeatureLockStatus OwnDomain tid "preventAdminlessGroups" "unlocked"
  patchTeamFeature OwnDomain tid "preventAdminlessGroups" (object ["status" .= "enabled"]) >>= assertSuccess

  [alice1, charlie1] <- traverse (createMLSClient def) [alice, charlie]
  traverse_ (uploadNewKeyPackage def) [alice1, charlie1]

  conv <- postConversation charlie defMLS {team = Just tid} >>= getJSON 201
  convId <- objConvId conv
  createGroup def charlie1 convId
  void $ createAddCommit charlie1 convId [alice] >>= sendAndConsumeCommitBundle

  bindResponse (getConversation alice conv) $ \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
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_member"
    others <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    [other] <- pure others
    other %. "qualified_id" `shouldMatch` objQidObject charlie
    other %. "conversation_role" `shouldMatch` "wire_admin"

  void $ deleteTeamMember tid alice charlie >>= getBody 202

  -- alice is the only eligible member that remains after charlie (the conversation admin) is removed from the team
  eventually $ do
    bindResponse (getConversation alice conv) $ \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
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_admin"
      members <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      shouldBeEmpty members

testOnLastAdminSelfDeletionAutopromotes :: (HasCallStack) => App ()
testOnLastAdminSelfDeletionAutopromotes :: HasCallStack => App ()
testOnLastAdminSelfDeletionAutopromotes = do
  (alice, tid, [charlie]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  setTeamFeatureLockStatus OwnDomain tid "preventAdminlessGroups" "unlocked"
  patchTeamFeature OwnDomain tid "preventAdminlessGroups" (object ["status" .= "enabled"]) >>= assertSuccess

  [alice1, charlie1] <- traverse (createMLSClient def) [alice, charlie]
  traverse_ (uploadNewKeyPackage def) [alice1, charlie1]

  conv <- postConversation charlie defMLS {team = Just tid} >>= getJSON 201
  convId <- objConvId conv
  createGroup def charlie1 convId
  void $ createAddCommit charlie1 convId [alice] >>= sendAndConsumeCommitBundle

  bindResponse (getConversation alice conv) $ \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
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_member"
    others <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    [other] <- pure others
    other %. "qualified_id" `shouldMatch` objQidObject charlie
    other %. "conversation_role" `shouldMatch` "wire_admin"

  void $ deleteUser charlie >>= getBody 200

  eventually $ do
    bindResponse (getConversation alice conv) $ \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
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_admin"
      members <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      shouldBeEmpty members

-----------------------------------------------------------------------------------------------------------------------------
-- UTILS

createTeamMLSConversation :: (HasCallStack, MakesValue owner) => owner -> String -> ClientIdentity -> [Value] -> App Value
createTeamMLSConversation :: forall owner.
(HasCallStack, MakesValue owner) =>
owner -> String -> ClientIdentity -> [Value] -> App Value
createTeamMLSConversation owner
owner String
tid ClientIdentity
ownerClient [Value]
members = do
  conv <- owner -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation owner
owner (CreateConv -> CreateConv
allowAll CreateConv
defMLS) {team = Just tid} 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
201
  convId <- objConvId conv
  createGroup def ownerClient convId
  unless (null members)
    $ void
    $ createAddCommit ownerClient convId members
    >>= sendAndConsumeCommitBundle
  pure conv

createAndAddAppMember :: (HasCallStack, MakesValue creator, MakesValue conv) => creator -> String -> ClientIdentity -> conv -> NewApp -> App (Value, ClientIdentity)
createAndAddAppMember :: forall creator conv.
(HasCallStack, MakesValue creator, MakesValue conv) =>
creator
-> String
-> ClientIdentity
-> conv
-> NewApp
-> App (Value, ClientIdentity)
createAndAddAppMember creator
creator String
tid ClientIdentity
ownerClient conv
conv NewApp
newApp = do
  app <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (creator -> String -> NewApp -> App Response
forall creator.
MakesValue creator =>
creator -> String -> NewApp -> App Response
createApp creator
creator String
tid NewApp
newApp) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
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
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"user"
  appClient <- createMLSClient def app
  void $ uploadNewKeyPackage def appClient
  convId <- objConvId conv
  void $ createAddCommit ownerClient convId [app] >>= sendAndConsumeCommitBundle
  pure (app, appClient)

configureAdminlessGroupsFeature :: (MakesValue domain) => domain -> String -> String -> String -> [String] -> App ()
configureAdminlessGroupsFeature :: forall domain.
MakesValue domain =>
domain -> String -> String -> String -> [String] -> App ()
configureAdminlessGroupsFeature domain
domain String
tid String
status String
deletionTimeout [String]
reminderTimeouts = do
  domain -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus domain
domain String
tid String
"preventAdminlessGroups" String
"unlocked"
  domain -> 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
patchTeamFeature domain
domain String
tid String
"preventAdminlessGroups" (String -> String -> [String] -> Value
mkAdminlessFeature String
status String
deletionTimeout [String]
reminderTimeouts) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

mkAdminlessFeature :: String -> String -> [String] -> Value
mkAdminlessFeature :: String -> String -> [String] -> Value
mkAdminlessFeature String
status String
deletionTimeout [String]
reminderTimeouts =
  [Pair] -> Value
object
    [ String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
status,
      String
"config"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"deletionTimeoutDuration" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
deletionTimeout,
            String
"reminderTimeoutDurations" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String]
reminderTimeouts,
            String
"promotionStrategy" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"random"
          ]
    ]