WPB-19712: Allow team admin to update the channels to user-group association

Author: blackheaven

changelog.d/2-features/WPB-19713

@@ -0,0 +1 @@
+Implement `channels` and `channelsCount` in `user-groups` endpoints.

integration/test/API/Brig.hs

@@ -1061,6 +1061,11 @@ getUserGroup user gid = do
   req <- baseRequest user Brig Versioned $ joinHttpPath ["user-groups", gid]
   submit "GET" req
 
+getUserGroupWithChannels :: (MakesValue user) => user -> String -> App Response
+getUserGroupWithChannels user gid = do
+  req <- baseRequest user Brig Versioned $ joinHttpPath ["user-groups", gid]
+  submit "GET" $ req & addQueryParams [("include_channels", "true")]
+
 updateUserGroupChannels :: (MakesValue user) => user -> String -> [String] -> App Response
 updateUserGroupChannels user gid convIds = do
   req <- baseRequest user Brig Versioned $ joinHttpPath ["user-groups", gid, "channels"]

integration/test/Test/UserGroup.hs

@@ -390,8 +390,9 @@ testUserGroupUpdateChannels = do
   updateUserGroupChannels alice gid [convId.id_] >>= assertSuccess
 
   -- bobId <- asString $ bob %. "id"
-  bindResponse (getUserGroup alice gid) $ \resp -> do
+  bindResponse (getUserGroupWithChannels alice gid) $ \resp -> do
     resp.status `shouldMatchInt` 200
+    resp.json %. "channels" `shouldMatch` [object ["id" .= convId.id_, "domain" .= convId.domain]]
 
 -- FUTUREWORK: check the actual associated channels
 --  resp.json %. "members" `shouldMatch` [bobId]

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -314,7 +314,7 @@ type UserGroupAPI =
     )
     :<|> Named
            "get-user-group"
-           ( Summary "[STUB] (channels in response not implemented)"
+           ( Summary "Fetch a group accessible from the logged-in user"
                :> From 'V10
                :> ZLocalUser
                :> CanThrow 'UserGroupNotFound
@@ -331,7 +331,7 @@ type UserGroupAPI =
            )
     :<|> Named
            "get-user-groups"
-           ( Summary "[STUB] (channelsCount not implemented)"
+           ( Summary "Fetch groups accessible from the logged-in user"
                :> From 'V10
                :> ZLocalUser
                :> "user-groups"
@@ -342,6 +342,7 @@ type UserGroupAPI =
                :> QueryParam' '[Optional, Strict, LastSeenNameDesc] "last_seen_name" UserGroupName
                :> QueryParam' '[Optional, Strict, LastSeenCreatedAtDesc] "last_seen_created_at" UTCTimeMillis
                :> QueryParam' '[Optional, Strict, LastSeenIdDesc] "last_seen_id" UserGroupId
+               :> QueryFlag "include_channels"
                :> QueryFlag "include_member_count"
                :> Get '[JSON] UserGroupPage
            )

libs/wire-subsystems/src/Wire/UserGroupStore.hs

@@ -38,5 +38,6 @@ data UserGroupStore m a where
   UpdateUsers :: UserGroupId -> Vector UserId -> UserGroupStore m ()
   RemoveUser :: UserGroupId -> UserId -> UserGroupStore m ()
   UpdateUserGroupChannels :: UserGroupId -> Vector ConvId -> UserGroupStore m ()
+  ListUserGroupChannels :: UserGroupId -> UserGroupStore m (Vector ConvId)
 
 makeSem ''UserGroupStore

libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs

@@ -54,6 +54,7 @@ interpretUserGroupStoreToPostgres =
     UpdateUsers gid uids -> updateUsers gid uids
     RemoveUser gid uid -> removeUser gid uid
     UpdateUserGroupChannels gid convIds -> updateUserGroupChannels gid convIds
+    ListUserGroupChannels gid -> listUserGroupChannels gid
 
 updateUsers :: (UserGroupStorePostgresEffectConstraints r) => UserGroupId -> Vector UserId -> Sem r ()
 updateUsers gid uids = do
@@ -441,6 +442,28 @@ updateUserGroupChannels gid convIds = do
           on conflict (user_group_id, conv_id) do nothing
           |]
 
+listUserGroupChannels ::
+  forall r.
+  (UserGroupStorePostgresEffectConstraints r) =>
+  UserGroupId ->
+  Sem r (Vector ConvId)
+listUserGroupChannels gid = do
+  pool <- input
+  eitherErrorOrUnit <- liftIO $ use pool session
+  either throw pure eitherErrorOrUnit
+  where
+    session :: Session (Vector ConvId)
+    session = statement gid selectStatement
+
+    selectStatement :: Statement UserGroupId (Vector ConvId)
+    selectStatement =
+      dimap
+        toUUID
+        (fmap Id)
+        [vectorStatement|
+            select (conv_id :: uuid) from user_group_channel where user_group_id = ($1 :: uuid)
+            |]
+
 crudUser ::
   forall r.
   (UserGroupStorePostgresEffectConstraints r) =>

libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs

@@ -33,5 +33,6 @@ data UserGroupSubsystem m a where
   UpdateUsers :: UserId -> UserGroupId -> Vector UserId -> UserGroupSubsystem m ()
   RemoveUser :: UserId -> UserGroupId -> UserId -> UserGroupSubsystem m ()
   UpdateChannels :: UserId -> UserGroupId -> Vector ConvId -> UserGroupSubsystem m ()
+  ListChannels :: UserId -> UserGroupId -> UserGroupSubsystem m (Vector ConvId)
 
 makeSem ''UserGroupSubsystem

libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs

@@ -53,6 +53,7 @@ interpretUserGroupSubsystem = interpret $ \case
   UpdateUsers updater groupId uids -> updateUsers updater groupId uids
   RemoveUser remover groupId removeeId -> removeUser remover groupId removeeId
   UpdateChannels performer groupId channelIds -> updateChannels performer groupId channelIds
+  ListChannels performer groupId -> listChannels performer groupId
 
 data UserGroupSubsystemError
   = UserGroupNotATeamAdmin
@@ -350,3 +351,17 @@ updateChannels performer groupId channelIds = do
   teamId <- getTeamAsAdmin performer >>= note UserGroupNotATeamAdmin
   traverse_ (getTeamConv performer teamId >=> note UserGroupChannelNotFound) channelIds
   Store.updateUserGroupChannels groupId channelIds
+
+listChannels ::
+  ( Member UserSubsystem r,
+    Member Store.UserGroupStore r,
+    Member (Error UserGroupSubsystemError) r,
+    Member TeamSubsystem r
+  ) =>
+  UserId ->
+  UserGroupId ->
+  Sem r (Vector ConvId)
+listChannels performer groupId = do
+  void $ getUserGroup performer groupId >>= note UserGroupNotFound
+  void $ getUserTeam performer >>= note UserGroupNotATeamAdmin
+  Store.listUserGroupChannels groupId

libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserGroupStore.hs

@@ -11,7 +11,7 @@ import Data.Domain (Domain (Domain))
 import Data.Id
 import Data.Json.Util
 import Data.Map qualified as Map
-import Data.Qualified (Qualified (Qualified))
+import Data.Qualified
 import Data.Text qualified as T
 import Data.Time.Clock
 import Data.Vector (Vector, fromList)
@@ -65,6 +65,7 @@ userGroupStoreTestInterpreter =
     UpdateUsers gid uids -> updateUsersImpl gid uids
     RemoveUser gid uid -> removeUserImpl gid uid
     UpdateUserGroupChannels gid convIds -> updateUserGroupChannelsImpl gid convIds
+    ListUserGroupChannels gid -> listUserGroupChannelsImpl gid
 
 updateUsersImpl :: (UserGroupStoreInMemEffectConstraints r) => UserGroupId -> Vector UserId -> Sem r ()
 updateUsersImpl gid uids = do
@@ -201,6 +202,14 @@ updateUserGroupChannelsImpl gid convIds = do
 
   modifyUserGroupsGidOnly gid (Map.alter f)
 
+listUserGroupChannelsImpl ::
+  (UserGroupStoreInMemEffectConstraints r) =>
+  UserGroupId ->
+  Sem r (Vector ConvId)
+listUserGroupChannelsImpl gid =
+  foldMap (fmap qUnqualified) . (runIdentity . (.channels) . snd <=< find ((== gid) . snd . fst) . Map.toList)
+    <$> get @(Map (TeamId, UserGroupId) UserGroup)
+
 ----------------------------------------------------------------------
 
 modifyUserGroupsGidOnly ::

postgres-schema.sql

@@ -104,6 +104,17 @@ CREATE TABLE public.user_group_channel (
 );
 
 
+
+--
+-- Name: user_group_channel; Type: TABLE; Schema: public; Owner: wire-server
+--
+
+CREATE TABLE public.user_group_channel (
+    user_group_id uuid NOT NULL,
+    conv_id uuid NOT NULL
+);
+
+
 ALTER TABLE public.user_group_channel OWNER TO "wire-server";
 
 --