{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

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

import API.Brig
import API.Galley
import API.GalleyInternal (setTeamFeatureLockStatus)
import Control.Error (lastMay)
import Notifications (isMemberJoinNotif, isUserGroupCreatedNotif, isUserGroupUpdatedNotif)
import SetupHelpers
import Testlib.Prelude

testUserGroupSmoke :: (HasCallStack) => App ()
testUserGroupSmoke :: HasCallStack => App ()
testUserGroupSmoke = do
  (owner, team, [mem1, mem2, mem3, mem4, mem5, mem6, admin2, mem8, mem9]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
10
  updateTeamMember team owner admin2 Admin >>= assertSuccess
  mem1id <- asString $ mem1 %. "id"
  mem2id <- asString $ mem2 %. "id"
  mem3id <- asString $ mem3 %. "id"
  mem4id <- asString $ mem4 %. "id"
  mem5id <- asString $ mem5 %. "id"
  mem6id <- asString $ mem6 %. "id"
  mem8id <- asString $ mem8 %. "id"
  mem9id <- asString $ mem9 %. "id"

  let badGid = String
"225c4d54-1ae7-11f0-8e9c-cbb31865d602"
      badMemid = String
"7bf23c0b-0be6-4432-bc5d-ab301bf75a99"

  gid <- withWebSockets [owner, admin2] $ \[WebSocket]
wss -> do
    gid <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user newUserGroup.
(MakesValue user, MakesValue newUserGroup) =>
user -> newUserGroup -> App Response
createUserGroup Value
owner ([Pair] -> Value
object [String
"name" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"none", String
"members" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
mem1id, String
mem2id]])) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
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 App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
mem1id, String
mem2id]
      App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
    for_ wss $ \WebSocket
ws -> do
      notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isUserGroupCreatedNotif WebSocket
ws
      notif %. "payload.0.user_group.id" `shouldMatch` gid
    pure gid

  bindResponse (getUserGroup owner badGid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

  bindResponse (getUserGroup mem3 badGid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

  bindResponse (getUserGroup owner gid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
mem1id, String
mem2id]

  bindResponse (updateUserGroup owner badGid (object ["name" .= ""])) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.json App 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
"bad-request"

  bindResponse (updateUserGroup owner badGid (object ["name" .= "good name"])) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

  bindResponse (updateUserGroup owner gid (object ["name" .= "also good"])) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  bindResponse (addUserToGroup owner gid mem3id) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204

  withWebSockets [owner, admin2] $ \[WebSocket]
wssAdmins -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> [String] -> App Response
forall user.
MakesValue user =>
user -> String -> [String] -> App Response
addUsersToGroup Value
owner String
gid [String
mem3id, String
mem4id, String
mem5id]) ((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
204
    [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wssAdmins ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
      notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isUserGroupUpdatedNotif WebSocket
ws
      notif %. "payload.0.user_group.id" `shouldMatch` gid

  bindResponse (addUsersToGroup owner gid [badMemid, mem6id]) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400

  bindResponse (removeUserFromGroup owner gid mem1id) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204

  bindResponse (getUserGroup owner gid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"also good"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
mem2id, String
mem3id, String
mem4id, String
mem5id]

  bindResponse (getUserGroups owner def) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page.0.name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"also good"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"total" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

  bindResponse (deleteUserGroup owner badGid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

  bindResponse (deleteUserGroup owner gid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204

  bindResponse (updateUserGroup owner gid (object ["name" .= "also good"])) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

  bindResponse (addUserToGroup owner gid mem1id) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

  bindResponse (addUsersToGroup owner gid [mem1id, mem5id]) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

  bindResponse (removeUserFromGroup owner gid mem1id) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

  withWebSockets [owner, admin2] $ \[WebSocket]
wssAdmins -> do
    ug2Id <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user newUserGroup.
(MakesValue user, MakesValue newUserGroup) =>
user -> newUserGroup -> App Response
createUserGroup Value
owner ([Pair] -> Value
object [String
"name" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"ug 2", String
"members" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
mem1id]])) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
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
      ug2Id <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")

      for_ wssAdmins $ \WebSocket
ws -> do
        notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isUserGroupCreatedNotif WebSocket
ws
        notif %. "payload.0.user_group.id" `shouldMatch` ug2Id

      pure ug2Id

    bindResponse (getUserGroup owner ug2Id) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
mem1id]

    bindResponse (updateUserGroupUsers owner ug2Id [mem8id, mem9id]) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

      [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wssAdmins ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
        notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isUserGroupUpdatedNotif WebSocket
ws
        notif %. "payload.0.user_group.id" `shouldMatch` ug2Id

    bindResponse (getUserGroup owner ug2Id) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
mem8id, String
mem9id]

    bindResponse (updateUserGroupUsers owner ug2Id []) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

      [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wssAdmins ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
        notif <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isUserGroupUpdatedNotif WebSocket
ws
        notif %. "payload.0.user_group.id" `shouldMatch` ug2Id

    bindResponse (getUserGroup owner ug2Id) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [()] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [()])

testUserGroupAddGroupDenied :: (HasCallStack) => App ()
testUserGroupAddGroupDenied :: HasCallStack => App ()
testUserGroupAddGroupDenied = do
  let noMember :: [()]
noMember = [] :: [()]

  (owner0, _team0, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  gid0 <- bindResponse (createUserGroup owner0 (object ["name" .= "none", "members" .= noMember])) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [()] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [()]
noMember
    App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")

  (owner1, _team1, [mem10]) <- createTeam OwnDomain 2
  _gid1 <- bindResponse (createUserGroup owner1 (object ["name" .= "none", "members" .= noMember])) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [()] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [()]
noMember
    App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
  mem10id <- asString $ mem10 %. "id"

  bindResponse (addUsersToGroup owner1 gid0 [mem10id]) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

  bindResponse (getUserGroup owner0 gid0) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [()] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [()]
noMember

testUserGroupGetGroups :: (HasCallStack) => App ()
testUserGroupGetGroups :: HasCallStack => App ()
testUserGroupGetGroups = do
  (owner, _team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  let groupNames = [String
"First group", String
"CC", String
"CCC"] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ((Char -> String -> String
forall a. a -> [a] -> [a]
: []) (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'A' .. Char
'G'])
      totalCount = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
groupNames
  forM_ groupNames $ \String
gname -> do
    let newGroup :: Value
newGroup = [Pair] -> Value
object [String
"name" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
gname, String
"members" String -> [()] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [()])]
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user newUserGroup.
(MakesValue user, MakesValue newUserGroup) =>
user -> newUserGroup -> App Response
createUserGroup Value
owner Value
newGroup) ((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
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
gname
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [()] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [()])

  -- Default sort by is createdAt, and sortOrder is DESC
  _ <- runSearch owner def {q = Just "C"} ["C", "CCC", "CC"] 3

  -- Default sortOrder is DESC, regardless of sortBy
  _ <- runSearch owner def {q = Just "CC", sortByKeys = Just "name"} ["CCC", "CC"] 2

  -- Test combinations of sortBy and sortOrder:
  _ <-
    runSearch
      owner
      def {sortByKeys = Just "name", sortOrder = Just "asc"}
      [ "A",
        "B",
        "C",
        "CC",
        "CCC",
        "D",
        "E",
        "F",
        "First group",
        "G"
      ]
      totalCount
  _ <-
    runSearch
      owner
      def {sortByKeys = Just "name", sortOrder = Just "desc"}
      ( reverse
          [ "A",
            "B",
            "C",
            "CC",
            "CCC",
            "D",
            "E",
            "F",
            "First group",
            "G"
          ]
      )
      totalCount
  _ <-
    runSearch
      owner
      def {sortByKeys = Just "created_at", sortOrder = Just "asc"}
      [ "First group",
        "CC",
        "CCC",
        "A",
        "B",
        "C",
        "D",
        "E",
        "F",
        "G"
      ]
      totalCount
  _ <-
    runSearch
      owner
      def {sortByKeys = Just "created_at", sortOrder = Just "desc"}
      ( reverse
          [ "First group",
            "CC",
            "CCC",
            "A",
            "B",
            "C",
            "D",
            "E",
            "F",
            "G"
          ]
      )
      totalCount

  -- Test sorting and filtering works across pages
  let firstPageParams = GetUserGroupsArgs
forall a. Default a => a
def {sortByKeys = Just "name", sortOrder = Just "desc", pSize = Just 3}
  Just (name1, createdAt1, id1) <-
    runSearch
      owner
      firstPageParams
      [ "G",
        "First group",
        "F"
      ]
      totalCount
  Just (name2, createdAt2, id2) <-
    runSearch
      owner
      firstPageParams {lastName = Just name1, lastCreatedAt = Just createdAt1, lastId = Just id1}
      [ "E",
        "D",
        "CCC"
      ]
      totalCount
  Just (name3, createdAt3, id3) <-
    runSearch
      owner
      firstPageParams {lastName = Just name2, lastCreatedAt = Just createdAt2, lastId = Just id2}
      [ "CC",
        "C",
        "B"
      ]
      totalCount

  void
    $ runSearch
      owner
      firstPageParams {lastName = Just name3, lastCreatedAt = Just createdAt3, lastId = Just id3}
      ["A"]
      totalCount

runSearch :: (HasCallStack, MakesValue owner) => owner -> GetUserGroupsArgs -> [String] -> Int -> App (Maybe (String, String, String))
runSearch :: forall owner.
(HasCallStack, MakesValue owner) =>
owner
-> GetUserGroupsArgs
-> [String]
-> Int
-> App (Maybe (String, String, String))
runSearch owner
owner GetUserGroupsArgs
args [String]
expected Int
expectedCount =
  App Response
-> (Response -> App (Maybe (String, String, String)))
-> App (Maybe (String, String, String))
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (owner -> GetUserGroupsArgs -> App Response
forall user.
MakesValue user =>
user -> GetUserGroupsArgs -> App Response
getUserGroups owner
owner GetUserGroupsArgs
args) ((Response -> App (Maybe (String, String, String)))
 -> App (Maybe (String, String, String)))
-> (Response -> App (Maybe (String, String, String)))
-> App (Maybe (String, String, String))
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
    found <- ((Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") (Value -> App Value) -> [Value] -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM`) ([Value] -> App [Value]) -> App [Value] -> App [Value]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList (Value -> App [Value]) -> App Value -> App [Value]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page"
    found `shouldMatch` expected
    results <- asList $ resp.json %. "page"
    resp.json %. "total" `shouldMatchInt` expectedCount
    for (lastMay results) $ \Value
lastGroup ->
      (,,)
        (String -> String -> String -> (String, String, String))
-> App String -> App (String -> String -> (String, String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value
lastGroup Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name")
        App (String -> String -> (String, String, String))
-> App String -> App (String -> (String, String, String))
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value
lastGroup Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"createdAt")
        App (String -> (String, String, String))
-> App String -> App (String, String, String)
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value
lastGroup Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")

testUserGroupGetGroupsAllInputs :: (HasCallStack) => App ()
testUserGroupGetGroupsAllInputs :: HasCallStack => App ()
testUserGroupGetGroupsAllInputs = do
  (owner, _team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  let gnames = [Char
'A' .. Char
'Z']
  for_ gnames $ \Char
gname -> do
    let newGroup :: Value
newGroup = [Pair] -> Value
object [String
"name" String -> Char -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Char
gname, String
"members" String -> [()] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [()])]
    Value -> Value -> App Response
forall user newUserGroup.
(MakesValue user, MakesValue newUserGroup) =>
user -> newUserGroup -> App Response
createUserGroup Value
owner Value
newGroup 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

  Just (ln, ltz, lid) <- runSearch owner def {pSize = Just 3} ["Z", "Y", "X"] 26
  let getUserGroupArgs = String -> String -> String -> [GetUserGroupsArgs]
getUserGroupArgsCombinations String
ln String
ltz String
lid
  for_ getUserGroupArgs $ \GetUserGroupsArgs
args -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> GetUserGroupsArgs -> App Response
forall user.
MakesValue user =>
user -> GetUserGroupsArgs -> App Response
getUserGroups Value
owner GetUserGroupsArgs
args) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      -- most important check is that all combinations return 200
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      -- additionally we can check a few invariants
      groups <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page" 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
      case (args.q, args.lastName, args.lastCreatedAt, args.lastId) of
        (Maybe String
Nothing, Maybe String
Nothing, Maybe String
Nothing, Maybe String
Nothing) -> do
          [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
groups Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
15 GetUserGroupsArgs
args.pSize)
          Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"total" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
gnames)
        (Just String
_, Maybe String
Nothing, Maybe String
Nothing, Maybe String
Nothing) -> do
          [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
groups Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1
        (Maybe String, Maybe String, Maybe String, Maybe String)
_ -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    getUserGroupArgsCombinations :: String -> String -> String -> [GetUserGroupsArgs]
    getUserGroupArgsCombinations :: String -> String -> String -> [GetUserGroupsArgs]
getUserGroupArgsCombinations String
ln String
ltz String
lid =
      [ GetUserGroupsArgs
          { q :: Maybe String
q = Maybe String
q',
            sortByKeys :: Maybe String
sortByKeys = Maybe String
sortBy',
            sortOrder :: Maybe String
sortOrder = Maybe String
sortOrder',
            pSize :: Maybe Int
pSize = Maybe Int
pSize',
            lastName :: Maybe String
lastName = Maybe String
lastName',
            lastCreatedAt :: Maybe String
lastCreatedAt = Maybe String
lastCreatedAt',
            lastId :: Maybe String
lastId = Maybe String
lastId',
            includeMemberCount :: Bool
includeMemberCount = Bool
includeMemberCount',
            includeChannels :: Bool
includeChannels = Bool
includeChannels'
          }
      | Maybe String
q' <- [Maybe String]
qs,
        Maybe String
sortBy' <- [Maybe String]
sortByKeysList,
        Maybe String
sortOrder' <- [Maybe String]
sortOrders,
        Maybe Int
pSize' <- [Maybe Int]
pSizes,
        Maybe String
lastName' <- [Maybe String]
lastNames,
        Maybe String
lastCreatedAt' <- [Maybe String]
lastCreatedAts,
        Maybe String
lastId' <- [Maybe String]
lastIds,
        Bool
includeMemberCount' <- [Bool
False, Bool
True],
        Bool
includeChannels' <- [Bool
False, Bool
True]
      ]
      where
        qs :: [Maybe String]
qs = [Maybe String
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just String
"A"]
        sortByKeysList :: [Maybe String]
sortByKeysList = [Maybe String
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just String
"name", String -> Maybe String
forall a. a -> Maybe a
Just String
"created_at"]
        sortOrders :: [Maybe String]
sortOrders = [Maybe String
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just String
"asc", String -> Maybe String
forall a. a -> Maybe a
Just String
"desc"]
        pSizes :: [Maybe Int]
pSizes = [Maybe Int
forall a. Maybe a
Nothing, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3]
        lastNames :: [Maybe String]
lastNames = [Maybe String
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just String
ln]
        lastCreatedAts :: [Maybe String]
lastCreatedAts = [Maybe String
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just String
ltz]
        lastIds :: [Maybe String]
lastIds = [Maybe String
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just String
lid]

testUserGroupMembersCount :: (HasCallStack) => App ()
testUserGroupMembersCount :: HasCallStack => App ()
testUserGroupMembersCount = do
  (owner, _team, [mem1, mem2]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3
  mem1id <- asString $ mem1 %. "id"
  mem2id <- asString $ mem2 %. "id"

  bindResponse (createUserGroup owner (object ["name" .= "none", "members" .= ([mem1id, mem2id])])) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
mem1id, String
mem2id]

  bindResponse (getUserGroups owner (def {includeMemberCount = True})) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page.0.membersCount" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"total" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

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

  bobId <- bob %. "id" & asString
  charlieId <- charlie %. "id" & asString

  ug <-
    createUserGroup alice (object ["name" .= "none", "members" .= [bobId, charlieId]])
      >>= getJSON 200
  gid <- ug %. "id" & asString
  void $ deleteTeamMember tid alice bob >>= getBody 202

  bindResponse (getUserGroup alice gid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
charlieId]

testUserGroupUpdateChannelsSucceeds :: (HasCallStack) => App ()
testUserGroupUpdateChannelsSucceeds :: HasCallStack => App ()
testUserGroupUpdateChannelsSucceeds = 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 alice tid "channels" "unlocked"
  setTeamFeatureConfig alice tid "channels" channelsConfig >>= assertSuccess

  ug <- createUserGroup alice (object ["name" .= "none", "members" .= (mempty :: [String])]) >>= getJSON 200
  gid <- ug %. "id" & asString

  convs <- replicateM 5 $ postConversation alice (defMLS {team = Just tid, groupConvType = Just "channel"}) >>= getJSON 201 >>= objConvId

  withWebSocket alice $ \WebSocket
wsAlice -> do
    Value -> String -> [String] -> App Response
forall user.
MakesValue user =>
user -> String -> [String] -> App Response
updateUserGroupChannels Value
alice String
gid ((.id_) (ConvId -> String) -> [ConvId] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [ConvId] -> [ConvId]
forall a. Int -> [a] -> [a]
take Int
2 [ConvId]
convs) 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 => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isUserGroupUpdatedNotif WebSocket
wsAlice
    notif %. "payload.0.user_group.id" `shouldMatch` gid

  bindResponse (getUserGroupWithChannels alice gid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    actual <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"channels" 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 App [Value]
-> ([Value] -> App [(String, String)]) -> App [(String, String)]
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 (String, String))
-> [Value] -> App [(String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid
    actual `shouldMatchSet` for (take 2 convs) objQid

  bindResponse (getUserGroups alice (def {includeChannels = True})) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page.0.channels" 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 App [Value]
-> ([Value] -> App [(String, String)]) -> App [(String, String)]
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 (String, String))
-> [Value] -> App [(String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid) App [(String, String)] -> App [(String, String)] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [ConvId]
-> (ConvId -> App (String, String)) -> App [(String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Int -> [ConvId] -> [ConvId]
forall a. Int -> [a] -> [a]
take Int
2 [ConvId]
convs) ConvId -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid

  updateUserGroupChannels alice gid ((.id_) <$> tail convs) >>= assertSuccess

  bindResponse (getUserGroupWithChannels alice gid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"channels" 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 App [Value]
-> ([Value] -> App [(String, String)]) -> App [(String, String)]
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 (String, String))
-> [Value] -> App [(String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid) App [(String, String)] -> App [(String, String)] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [ConvId]
-> (ConvId -> App (String, String)) -> App [(String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([ConvId] -> [ConvId]
forall a. HasCallStack => [a] -> [a]
tail [ConvId]
convs) ConvId -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid

  bindResponse (getUserGroups alice (def {includeChannels = True})) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page.0.channels" 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 App [Value]
-> ([Value] -> App [(String, String)]) -> App [(String, String)]
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 (String, String))
-> [Value] -> App [(String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid) App [(String, String)] -> App [(String, String)] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [ConvId]
-> (ConvId -> App (String, String)) -> App [(String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([ConvId] -> [ConvId]
forall a. HasCallStack => [a] -> [a]
tail [ConvId]
convs) ConvId -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid

  updateUserGroupChannels alice gid [] >>= assertSuccess

  bindResponse (getUserGroupWithChannels alice gid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"channels" App Value -> (Value -> App Int) -> App Int
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Value] -> Int) -> App [Value] -> App Int
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (App [Value] -> App Int)
-> (Value -> App [Value]) -> Value -> App Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList) App Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0

testUserGroupUpdateChannelsNonAdmin :: (HasCallStack) => App ()
testUserGroupUpdateChannelsNonAdmin :: HasCallStack => App ()
testUserGroupUpdateChannelsNonAdmin = 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

  ug <-
    createUserGroup alice (object ["name" .= "none", "members" .= (mempty :: [String])])
      >>= getJSON 200
  gid <- ug %. "id" & asString

  convId <-
    postConversation alice (defProteus {team = Just tid})
      >>= getJSON 201
      >>= objConvId
  updateUserGroupChannels bob gid [convId.id_] >>= assertLabel 404 "user-group-not-found"

testUserGroupUpdateChannelsNonExisting :: (HasCallStack) => App ()
testUserGroupUpdateChannelsNonExisting :: HasCallStack => App ()
testUserGroupUpdateChannelsNonExisting = 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
  (bob, _, _) <- createTeam OwnDomain 1

  ug <-
    createUserGroup alice (object ["name" .= "none", "members" .= (mempty :: [String])])
      >>= getJSON 200
  gid <- ug %. "id" & asString

  convId <-
    postConversation alice (defProteus {team = Just tid})
      >>= getJSON 201
      >>= objConvId
  updateUserGroupChannels bob gid [convId.id_] >>= assertLabel 404 "user-group-not-found"

testUserGroupUpdateChannelsNonChannel :: (HasCallStack) => App ()
testUserGroupUpdateChannelsNonChannel :: HasCallStack => App ()
testUserGroupUpdateChannelsNonChannel = 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

  ug <-
    createUserGroup alice (object ["name" .= "none", "members" .= (mempty :: [String])])
      >>= getJSON 200
  gid <- ug %. "id" & asString

  convId <-
    postConversation alice (defProteus {team = Just tid})
      >>= getJSON 201
      >>= objConvId
  updateUserGroupChannels alice gid [convId.id_] >>= assertLabel 404 "user-group-channel-not-found"

testUserGroupAddUsersToGroupWithChannels :: (HasCallStack) => App ()
testUserGroupAddUsersToGroupWithChannels :: HasCallStack => App ()
testUserGroupAddUsersToGroupWithChannels = do
  (alice, tid, mems@[bob, charlie, dave, eve, franzi]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
6
  setTeamFeatureLockStatus alice tid "channels" "unlocked"
  setTeamFeatureConfig alice tid "channels" channelsConfig >>= assertSuccess

  [bobId, charlieId, daveId, eveId, franziId] <- for mems $ asString . (%. "id")

  -- Create user group with bob as initial member
  ug <- createUserGroup alice (object ["name" .= "test group", "members" .= [bobId]]) >>= getJSON 200
  gid <- ug %. "id" & asString

  -- Create two conversations (channels) for the team
  [convId1, convId2] <- replicateM 2 $ postConversation alice (defMLS {team = Just tid, groupConvType = Just "channel"}) >>= getJSON 201 >>= objConvId

  -- Associate both channels with the user group
  withWebSocket bob $ \WebSocket
bobWs -> do
    Value -> String -> [String] -> App Response
forall user.
MakesValue user =>
user -> String -> [String] -> App Response
updateUserGroupChannels Value
alice String
gid [ConvId
convId1.id_, ConvId
convId2.id_] 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
    Int -> App Value -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif WebSocket
bobWs

  for_ [convId1, convId2] $ \ConvId
convId -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice ConvId
convId) ((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
      members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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
      memberIds <- mapM ((%. "qualified_id") >=> (%. "id") >=> asString) members
      memberIds `shouldMatchSet` [bobId]

  -- Add charlie, dave, and eve to the group using addUsersToGroup
  withWebSockets [charlie, dave, eve] $ \[WebSocket]
wss -> do
    Value -> String -> [String] -> App Response
forall user.
MakesValue user =>
user -> String -> [String] -> App Response
addUsersToGroup Value
alice String
gid [String
charlieId, String
daveId, String
eveId] 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
    [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> App Value -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 (App Value -> App ())
-> (WebSocket -> App Value) -> WebSocket -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif

  -- Verify all three users are now in the first channel
  for_ [convId1, convId2] $ \ConvId
convId -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice ConvId
convId) ((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
      members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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
      memberIds <- mapM ((%. "qualified_id") >=> (%. "id") >=> asString) members
      memberIds `shouldMatchSet` [bobId, charlieId, daveId, eveId]

    -- now we make charlie and dave admins in the conversation
    Value -> ConvId -> Value -> String -> App Response
forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
updateConversationMember Value
alice ConvId
convId Value
charlie String
"wire_admin" 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
    Value -> ConvId -> Value -> String -> App Response
forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
updateConversationMember Value
alice ConvId
convId Value
dave String
"wire_admin" 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

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice ConvId
convId) ((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
      members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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 <- for members toIdRolePair
      let expected = [(String
bobId, String
"wire_member"), (String
charlieId, String
"wire_admin"), (String
daveId, String
"wire_admin"), (String
eveId, String
"wire_member")]
      actual `shouldMatchSet` expected

  -- when we now add another user, we expect roles not be overwritten
  withWebSockets [franzi] $ \[WebSocket]
wss -> do
    Value -> String -> [String] -> App Response
forall user.
MakesValue user =>
user -> String -> [String] -> App Response
addUsersToGroup Value
alice String
gid [String
franziId] 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
    [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket]
wss ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> App Value -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 (App Value -> App ())
-> (WebSocket -> App Value) -> WebSocket -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
isMemberJoinNotif

  for_ [convId1] $ \ConvId
convId -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> ConvId -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice ConvId
convId) ((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
      members <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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 <- for members toIdRolePair
      let expected = [(String
bobId, String
"wire_member"), (String
charlieId, String
"wire_admin"), (String
daveId, String
"wire_admin"), (String
eveId, String
"wire_member"), (String
franziId, String
"wire_member")]
      actual `shouldMatchSet` expected
  where
    toIdRolePair :: Value -> App (String, String)
    toIdRolePair :: Value -> App (String, String)
toIdRolePair Value
mem = (,) (String -> String -> (String, String))
-> App String -> App (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
mem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString) App (String -> (String, String))
-> App String -> App (String, String)
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value
mem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation_role" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)

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
"team-members"
          ]
    ]