WPB-19713: Implement channels and channelsCount in user-groups endpoints

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"]
@@ -1074,11 +1079,23 @@ data GetUserGroupsArgs = GetUserGroupsArgs
     lastName :: Maybe String,
     lastCreatedAt :: Maybe String,
     lastId :: Maybe String,
-    includeMemberCount :: Bool
+    includeMemberCount :: Bool,
+    includeChannels :: Bool
   }
 
 instance Default GetUserGroupsArgs where
-  def = GetUserGroupsArgs Nothing Nothing Nothing Nothing Nothing Nothing Nothing False
+  def =
+    GetUserGroupsArgs
+      { q = Nothing,
+        sortByKeys = Nothing,
+        sortOrder = Nothing,
+        pSize = Nothing,
+        lastName = Nothing,
+        lastCreatedAt = Nothing,
+        lastId = Nothing,
+        includeMemberCount = False,
+        includeChannels = False
+      }
 
 getUserGroups :: (MakesValue user) => user -> GetUserGroupsArgs -> App Response
 getUserGroups user GetUserGroupsArgs {..} = do
@@ -1094,7 +1111,8 @@ getUserGroups user GetUserGroupsArgs {..} = do
               ("last_seen_name",) <$> lastName,
               ("last_seen_created_at",) <$> lastCreatedAt,
               ("last_seen_id",) <$> lastId,
-              (if includeMemberCount then Just ("include_member_count", "true") else Nothing)
+              (if includeMemberCount then Just ("include_member_count", "true") else Nothing),
+              (if includeChannels then Just ("include_channels", "true") else Nothing)
             ]
         )
 

integration/test/Test/UserGroup.hs

@@ -339,7 +339,8 @@ testUserGroupGetGroupsAllInputs = do
             lastName = lastName',
             lastCreatedAt = lastCreatedAt',
             lastId = lastId',
-            includeMemberCount = includeMemberCount'
+            includeMemberCount = includeMemberCount',
+            includeChannels = includeChannels'
           }
         | q' <- qs,
           sortBy' <- sortByKeysList,
@@ -348,7 +349,8 @@ testUserGroupGetGroupsAllInputs = do
           lastName' <- lastNames,
           lastCreatedAt' <- lastCreatedAts,
           lastId' <- lastIds,
-          includeMemberCount' <- [False, True]
+          includeMemberCount' <- [False, True],
+          includeChannels' <- [False, True]
       ]
       where
         qs = [Nothing, Just "A"]
@@ -392,8 +394,8 @@ testUserGroupRemovalOnDelete = do
     resp.status `shouldMatchInt` 200
     resp.json %. "members" `shouldMatch` [charlieId]
 
-testUserGroupUpdateChannels :: (HasCallStack) => App ()
-testUserGroupUpdateChannels = do
+testUserGroupUpdateChannelsSucceeds :: (HasCallStack) => App ()
+testUserGroupUpdateChannelsSucceeds = do
   (alice, tid, [_bob]) <- createTeam OwnDomain 2
   setTeamFeatureLockStatus alice tid "channels" "unlocked"
   let config =
@@ -412,22 +414,41 @@ testUserGroupUpdateChannels = do
       >>= getJSON 200
   gid <- ug %. "id" & asString
 
-  convId <-
-    postConversation alice (defMLS {team = Just tid, groupConvType = Just "channel"})
-      >>= getJSON 201
-      >>= objConvId
+  convs <- replicateM 5 $ postConversation alice (defMLS {team = Just tid, groupConvType = Just "channel"}) >>= getJSON 201 >>= objConvId
+
   withWebSocket alice $ \wsAlice -> do
-    updateUserGroupChannels alice gid [convId.id_] >>= assertSuccess
+    updateUserGroupChannels alice gid ((.id_) <$> take 2 convs) >>= assertSuccess
 
     notif <- awaitMatch isUserGroupUpdatedNotif wsAlice
     notif %. "payload.0.user_group.id" `shouldMatch` gid
 
-  -- bobId <- asString $ bob %. "id"
-  bindResponse (getUserGroup alice gid) $ \resp -> do
+  bindResponse (getUserGroupWithChannels alice gid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    (resp.json %. "channels" >>= asList >>= traverse objQid) `shouldMatchSet` for (take 2 convs) objQid
+
+  bindResponse (getUserGroups alice (def {includeChannels = True})) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    (resp.json %. "page.0.channels" >>= asList >>= traverse objQid) `shouldMatchSet` for (take 2 convs) objQid
+
+  updateUserGroupChannels alice gid ((.id_) <$> tail convs) >>= assertSuccess
+
+  bindResponse (getUserGroupWithChannels alice gid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    (resp.json %. "channels" >>= asList >>= traverse objQid) `shouldMatchSet` for (tail convs) objQid
+
+  bindResponse (getUserGroups alice (def {includeChannels = True})) $ \resp -> do
     resp.status `shouldMatchInt` 200
+    (resp.json %. "page.0.channels" >>= asList >>= traverse objQid) `shouldMatchSet` for (tail convs) objQid
 
--- FUTUREWORK: check the actual associated channels
---  resp.json %. "members" `shouldMatch` [bobId]
+  updateUserGroupChannels alice gid [] >>= assertSuccess
+
+  bindResponse (getUserGroupWithChannels alice gid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    (resp.json %. "channels" >>= fmap length . asList) `shouldMatchInt` 0
+
+  bindResponse (getUserGroups alice (def {includeChannels = True})) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    (resp.json %. "page.0.channels" >>= fmap length . asList) `shouldMatchInt` 0
 
 testUserGroupUpdateChannelsNonAdmin :: (HasCallStack) => App ()
 testUserGroupUpdateChannelsNonAdmin = do

libs/types-common/default.nix

@@ -35,6 +35,7 @@
 , openapi3
 , optparse-applicative
 , pem
+, polysemy
 , protobuf
 , QuickCheck
 , quickcheck-instances
@@ -93,6 +94,7 @@ mkDerivation {
     openapi3
     optparse-applicative
     pem
+    polysemy
     protobuf
     QuickCheck
     quickcheck-instances

libs/types-common/src/Data/Qualified.hs

@@ -47,6 +47,7 @@ module Data.Qualified
     deprecatedSchema,
     qualifiedSchema,
     qualifiedObjectSchema,
+    inputQualifyLocal,
   )
 where
 
@@ -61,6 +62,8 @@ import Data.OpenApi (deprecated)
 import Data.OpenApi qualified as S
 import Data.Schema
 import Imports hiding (local)
+import Polysemy
+import Polysemy.Input
 import Test.QuickCheck (Arbitrary (arbitrary))
 
 ----------------------------------------------------------------------
@@ -234,3 +237,11 @@ instance S.ToSchema (Qualified Handle) where
 
 instance (Arbitrary a) => Arbitrary (Qualified a) where
   arbitrary = Qualified <$> arbitrary <*> arbitrary
+
+----------------------------------------------------------------------
+-- Polysemy
+
+inputQualifyLocal :: (Member (Input (Local ())) r) => a -> Sem r (Local a)
+inputQualifyLocal a = do
+  l <- input @(Local ())
+  pure $ qualifyAs l a

libs/types-common/types-common.cabal

@@ -125,6 +125,7 @@ library
     , openapi3
     , optparse-applicative   >=0.10
     , pem
+    , polysemy
     , protobuf               >=0.2
     , QuickCheck             >=2.9
     , quickcheck-instances   >=0.3.16

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-api/src/Wire/API/UserGroup.hs

@@ -110,7 +110,7 @@ userGroupToMeta ug =
     { id_ = ug.id_,
       name = ug.name,
       members = Const (),
-      channels = Const (),
+      channels = ug.channels,
       membersCount = ug.membersCount,
       channelsCount = ug.channelsCount,
       managedBy = ug.managedBy,
@@ -121,8 +121,8 @@ data UserGroup_ (f :: Type -> Type) = UserGroup_
   { id_ :: UserGroupId,
     name :: UserGroupName,
     members :: f (Vector UserId),
-    channels :: f (Maybe (Vector (Qualified ConvId))),
     membersCount :: Maybe Int,
+    channels :: Maybe (Vector (Qualified ConvId)),
     channelsCount :: Maybe Int,
     managedBy :: ManagedBy,
     createdAt :: UTCTimeMillis
@@ -150,8 +150,8 @@ instance ToSchema (UserGroup_ (Const ())) where
         <$> (.id_) .= field "id" schema
         <*> (.name) .= field "name" schema
         <*> (.members) .= pure mempty
-        <*> (.channels) .= pure mempty
         <*> (.membersCount) .= maybe_ (optField "membersCount" schema)
+        <*> (.channels) .= maybe_ (optField "channels" (vector schema))
         <*> (.channelsCount) .= maybe_ (optField "channelsCount" schema)
         <*> (.managedBy) .= field "managedBy" schema
         <*> (.createdAt) .= field "createdAt" schema
@@ -177,8 +177,8 @@ instance ToSchema (UserGroup_ Identity) where
         <$> (.id_) .= field "id" schema
         <*> (.name) .= field "name" schema
         <*> (runIdentity . (.members)) .= field "members" (Identity <$> vector schema)
-        <*> (runIdentity . (.channels)) .= (Identity <$> maybe_ (optField "channels" (vector schema)))
         <*> (.membersCount) .= maybe_ (optField "membersCount" schema)
+        <*> (.channels) .= maybe_ (optField "channels" (vector schema))
         <*> (.channelsCount) .= maybe_ (optField "channelsCount" schema)
         <*> (.managedBy) .= field "managedBy" schema
         <*> (.createdAt) .= field "createdAt" schema

libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserGroup.hs

@@ -42,9 +42,9 @@ testObject_UserGroup_1 :: UserGroupMeta
 testObject_UserGroup_1 =
   UserGroup_
     { id_ = userGroupId1,
-      name = (unsafeToUserGroupName "name"),
-      members = (Const ()),
-      channels = (Const ()),
+      name = unsafeToUserGroupName "name",
+      members = Const (),
+      channels = Nothing,
       membersCount = Nothing,
       channelsCount = Just 0,
       managedBy = ManagedByWire,
@@ -55,10 +55,10 @@ testObject_UserGroup_2 :: UserGroup
 testObject_UserGroup_2 =
   UserGroup_
     { id_ = userGroupId2,
-      name = (unsafeToUserGroupName "yet another one"),
-      members = (Identity $ fromList [userId1, userId2]),
+      name = unsafeToUserGroupName "yet another one",
+      members = Identity $ fromList [userId1, userId2],
       channels =
-        Identity . Just . fromList $
+        Just . fromList $
           [ Qualified (Id (fromJust (UUID.fromString "445c08d2-a16b-49ea-a274-4208bb2efe8f"))) (Domain "example.com")
           ],
       membersCount = Nothing,

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

@@ -18,7 +18,8 @@ data UserGroupPageRequest = UserGroupPageRequest
     paginationState :: PaginationState,
     sortOrder :: SortOrder,
     pageSize :: PageSize,
-    includeMemberCount :: Bool
+    includeMemberCount :: Bool,
+    includeChannels :: Bool
   }
 
 data PaginationState = PaginationSortByName (Maybe (UserGroupName, UserGroupId)) | PaginationSortByCreatedAt (Maybe (UTCTimeMillis, UserGroupId))
@@ -33,7 +34,7 @@ toSortBy = \case
 
 data UserGroupStore m a where
   CreateUserGroup :: TeamId -> NewUserGroup -> ManagedBy -> UserGroupStore m UserGroup
-  GetUserGroup :: TeamId -> UserGroupId -> UserGroupStore m (Maybe UserGroup)
+  GetUserGroup :: TeamId -> UserGroupId -> Bool -> UserGroupStore m (Maybe UserGroup)
   GetUserGroups :: UserGroupPageRequest -> UserGroupStore m UserGroupPage
   UpdateUserGroup :: TeamId -> UserGroupId -> UserGroupUpdate -> UserGroupStore m (Maybe ())
   DeleteUserGroup :: TeamId -> UserGroupId -> UserGroupStore m (Maybe ())