[WPB-1753] list user groups

Makefile

@@ -21,6 +21,7 @@ ingress-nginx-controller nginx-ingress-services reaper restund \
 k8ssandra-test-cluster ldap-scim-bridge wire-server-enterprise
 KIND_CLUSTER_NAME     := wire-server
 HELM_PARALLELISM      ?= 1 # 1 for sequential tests; 6 for all-parallel tests
+PSQL_DB               ?= wire-server
 
 package ?= all
 EXE_SCHEMA := ./dist/$(package)-schema
@@ -343,7 +344,8 @@ cqlsh:
 psql:
 	@grep -q wire-server:wire-server ~/.pgpass || \
 	  echo "consider running 'echo localhost:5432:wire-server:wire-server:posty-the-gres > ~/.pgpass ; chmod 600 ~/.pgpass '"
-	psql -h localhost -p 5432 -U wire-server -w
+	psql -h localhost -p 5432 -d $(PSQL_DB) -U wire-server -w || \
+	  echo 'if the database is missing, consider running "make postgres-reset", or setting $$PSQL_DB to the correct table space.'
 
 .PHONY: db-reset-package
 db-reset-package:

changelog.d/1-api-changes/WPB-17534-list-user-groups

@@ -0,0 +1 @@
+New end-point `GET /user-groups?...` for filtering, sorting, and pagination.

deploy/dockerephemeral/docker-compose.yaml

@@ -290,6 +290,7 @@ services:
       POSTGRES_PASSWORD: "posty-the-gres"
       POSTGRES_USER: "wire-server"
       POSTGRES_DB: "backendA"
+    command: postgres -c max_connections=50
 
   cassandra:
     container_name: demo_wire_cassandra

integration/test/API/Brig.hs

@@ -1056,10 +1056,35 @@ getUserGroup user gid = do
   req <- baseRequest user Brig Versioned $ joinHttpPath ["user-groups", gid]
   submit "GET" req
 
-getUserGroups :: (MakesValue user) => user -> Maybe Int -> Maybe String -> App Response
-getUserGroups user mbLimit mbLastKey = do
-  req <- baseRequest user Brig Versioned $ joinHttpPath ["user-groups"]
-  submit "GET" $ req & addQueryParams (catMaybes [(("limit",) . show) <$> mbLimit, ("last_key",) <$> mbLastKey])
+data GetUserGroupsArgs = GetUserGroupsArgs
+  { q :: Maybe String,
+    sortByKeys :: Maybe String,
+    sortOrder :: Maybe String,
+    pSize :: Maybe Int,
+    lastName :: Maybe String,
+    lastCreatedAt :: Maybe String,
+    lastId :: Maybe String
+  }
+
+instance Default GetUserGroupsArgs where
+  def = GetUserGroupsArgs Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+
+getUserGroups :: (MakesValue user) => user -> GetUserGroupsArgs -> App Response
+getUserGroups user GetUserGroupsArgs {..} = do
+  req <- baseRequest user Brig Versioned "user-groups"
+  submit "GET" $
+    req
+      & addQueryParams
+        ( catMaybes
+            [ ("q",) <$> q,
+              ("sort_by",) <$> sortByKeys,
+              ("sort_order",) <$> sortOrder,
+              (("page_size",) . show) <$> pSize,
+              ("last_seen_name",) <$> lastName,
+              ("last_seen_created_at",) <$> lastCreatedAt,
+              ("last_seen_id",) <$> lastId
+            ]
+        )
 
 updateUserGroup :: (MakesValue user, MakesValue userGroupUpdate) => user -> String -> userGroupUpdate -> App Response
 updateUserGroup user gid userGroupUpdate = do

integration/test/Test/UserGroup.hs

@@ -4,6 +4,7 @@ module Test.UserGroup where
 
 import API.Brig
 import API.Galley
+import Control.Error (lastMay)
 import Notifications (isUserGroupCreatedNotif)
 import SetupHelpers
 import Testlib.Prelude
@@ -60,6 +61,10 @@ testUserGroupSmoke = do
     resp.json %. "name" `shouldMatch` "also good"
     resp.json %. "members" `shouldMatch` [mem2id, mem3id]
 
+  bindResponse (getUserGroups owner def) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "page.0.name" `shouldMatch` "also good"
+
   bindResponse (deleteUserGroup owner badGid) $ \resp -> do
     resp.status `shouldMatchInt` 404
 
@@ -74,3 +79,181 @@ testUserGroupSmoke = do
 
   bindResponse (removeUserFromGroup owner gid mem1id) $ \resp -> do
     resp.status `shouldMatchInt` 404
+
+testUserGroupGetGroups :: (HasCallStack) => App ()
+testUserGroupGetGroups = do
+  (owner, _team, []) <- createTeam OwnDomain 1
+
+  let groupNames = ["First group", "CC", "CCC"] <> ((: []) <$> ['A' .. 'G'])
+  forM_ groupNames $ \gname -> do
+    let newGroup = object ["name" .= gname, "members" .= ([] :: [()])]
+    bindResponse (createUserGroup owner newGroup) $ \resp -> do
+      resp.status `shouldMatchInt` 200
+      resp.json %. "name" `shouldMatch` gname
+      resp.json %. "members" `shouldMatch` ([] :: [()])
+
+  -- Default sort by is createdAt, and sortOrder is DESC
+  _ <- runSearch owner def {q = Just "C"} ["C", "CCC", "CC"]
+
+  -- Default sortOrder is DESC, regardless of sortBy
+  _ <- runSearch owner def {q = Just "CC", sortByKeys = Just "name"} ["CCC", "CC"]
+
+  -- 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"
+      ]
+  _ <-
+    runSearch
+      owner
+      def {sortByKeys = Just "name", sortOrder = Just "desc"}
+      ( reverse
+          [ "A",
+            "B",
+            "C",
+            "CC",
+            "CCC",
+            "D",
+            "E",
+            "F",
+            "First group",
+            "G"
+          ]
+      )
+  _ <-
+    runSearch
+      owner
+      def {sortByKeys = Just "created_at", sortOrder = Just "asc"}
+      [ "First group",
+        "CC",
+        "CCC",
+        "A",
+        "B",
+        "C",
+        "D",
+        "E",
+        "F",
+        "G"
+      ]
+  _ <-
+    runSearch
+      owner
+      def {sortByKeys = Just "created_at", sortOrder = Just "desc"}
+      ( reverse
+          [ "First group",
+            "CC",
+            "CCC",
+            "A",
+            "B",
+            "C",
+            "D",
+            "E",
+            "F",
+            "G"
+          ]
+      )
+
+  -- Test sorting and filtering works across pages
+  let firstPageParams = def {sortByKeys = Just "name", sortOrder = Just "desc", pSize = Just 3}
+  Just (name1, createdAt1, id1) <-
+    runSearch
+      owner
+      firstPageParams
+      [ "G",
+        "First group",
+        "F"
+      ]
+  Just (name2, createdAt2, id2) <-
+    runSearch
+      owner
+      firstPageParams {lastName = Just name1, lastCreatedAt = Just createdAt1, lastId = Just id1}
+      [ "E",
+        "D",
+        "CCC"
+      ]
+  Just (name3, createdAt3, id3) <-
+    runSearch
+      owner
+      firstPageParams {lastName = Just name2, lastCreatedAt = Just createdAt2, lastId = Just id2}
+      [ "CC",
+        "C",
+        "B"
+      ]
+
+  void
+    $ runSearch
+      owner
+      firstPageParams {lastName = Just name3, lastCreatedAt = Just createdAt3, lastId = Just id3}
+      ["A"]
+
+runSearch :: (HasCallStack, MakesValue owner) => owner -> GetUserGroupsArgs -> [String] -> App (Maybe (String, String, String))
+runSearch owner args expected =
+  bindResponse (getUserGroups owner args) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    found <- ((%. "name") `mapM`) =<< asList =<< resp.json %. "page"
+    found `shouldMatch` expected
+    results <- asList $ resp.json %. "page"
+    for (lastMay results) $ \lastGroup ->
+      (,,)
+        <$> asString (lastGroup %. "name")
+        <*> asString (lastGroup %. "createdAt")
+        <*> asString (lastGroup %. "id")
+
+testUserGroupGetGroupsAllInputs :: (HasCallStack) => App ()
+testUserGroupGetGroupsAllInputs = do
+  (owner, _team, []) <- createTeam OwnDomain 1
+  for_ ((: []) <$> ['A' .. 'Z']) $ \gname -> do
+    let newGroup = object ["name" .= gname, "members" .= ([] :: [()])]
+    createUserGroup owner newGroup >>= assertSuccess
+
+  Just (ln, ltz, lid) <- runSearch owner def {pSize = Just 3} ["Z", "Y", "X"]
+  let getUserGroupArgs = getUserGroupArgsCombinations ln ltz lid
+  for_ getUserGroupArgs $ \args -> do
+    bindResponse (getUserGroups owner args) $ \resp -> do
+      -- most important check is that all combinations return 200
+      resp.status `shouldMatchInt` 200
+      -- additionally we can check a few invariants
+      groups <- resp.json %. "page" >>= asList
+      case (args.q, args.lastName, args.lastCreatedAt, args.lastId) of
+        (Nothing, Nothing, Nothing, Nothing) -> length groups `shouldMatchInt` (fromMaybe 15 args.pSize)
+        (Just _, Nothing, Nothing, Nothing) -> length groups `shouldMatchInt` 1
+        _ -> pure ()
+  where
+    getUserGroupArgsCombinations :: String -> String -> String -> [GetUserGroupsArgs]
+    getUserGroupArgsCombinations ln ltz lid =
+      [ GetUserGroupsArgs
+          { q = q',
+            sortByKeys = sortBy',
+            sortOrder = sortOrder',
+            pSize = pSize',
+            lastName = lastName',
+            lastCreatedAt = lastCreatedAt',
+            lastId = lastId'
+          }
+        | q' <- qs,
+          sortBy' <- sortByKeysList,
+          sortOrder' <- sortOrders,
+          pSize' <- pSizes,
+          lastName' <- lastNames,
+          lastCreatedAt' <- lastCreatedAts,
+          lastId' <- lastIds
+      ]
+      where
+        qs = [Nothing, Just "A"]
+        sortByKeysList = [Nothing, Just "name", Just "created_at"]
+        sortOrders = [Nothing, Just "asc", Just "desc"]
+        pSizes = [Nothing, Just 3]
+        lastNames = [Nothing, Just ln]
+        lastCreatedAts = [Nothing, Just ltz]
+        lastIds = [Nothing, Just lid]

libs/types-common/src/Data/Json/Util.hs

@@ -101,6 +101,8 @@ newtype UTCTimeMillis = UTCTimeMillis {fromUTCTimeMillis :: UTCTime}
   deriving (Eq, Ord, Generic)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema UTCTimeMillis
 
+instance S.ToParamSchema UTCTimeMillis
+
 instance ToSchema UTCTimeMillis where
   schema =
     UTCTimeMillis
@@ -144,6 +146,16 @@ instance Show UTCTimeMillis where
 instance BS.ToByteString UTCTimeMillis where
   builder = BB.byteString . UTF8.fromString . show
 
+instance ToHttpApiData UTCTimeMillis where
+  toUrlPiece = showUTCTimeMillis
+
+instance FromHttpApiData UTCTimeMillis where
+  parseUrlPiece raw =
+    maybe (Left $ "Could not parse UTCTimeMillis: " <> raw) Right
+      . readUTCTimeMillis
+      . Text.unpack
+      $ raw
+
 instance BS.FromByteString UTCTimeMillis where
   parser = maybe (fail "UTCTimeMillis") pure . readUTCTimeMillis =<< BS.parser
 

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

@@ -27,6 +27,7 @@ import Data.CommaSeparatedList (CommaSeparatedList)
 import Data.Domain
 import Data.Handle
 import Data.Id as Id
+import Data.Json.Util
 import Data.Misc
 import Data.Nonce (Nonce)
 import Data.OpenApi hiding (Contact, Header, Schema, ToSchema)
@@ -82,6 +83,7 @@ import Wire.API.User.Password (CompletePasswordReset, NewPasswordReset, Password
 import Wire.API.User.RichInfo (RichInfoAssocList)
 import Wire.API.User.Search (Contact, PagingState, RoleFilter, SearchResult, TeamContact, TeamUserSearchSortBy, TeamUserSearchSortOrder)
 import Wire.API.UserGroup
+import Wire.API.UserGroup.Pagination
 import Wire.API.UserMap
 
 type BrigAPI =
@@ -290,6 +292,12 @@ type UserAPI =
                     (Respond 200 "Protocols supported by the user" (Set BaseProtocolTag))
            )
 
+type LastSeenNameDesc = Description "`name` of the last seen user group, used to get the next page when sorting by name."
+
+type LastSeenCreatedAtDesc = Description "`created_at` field of the last seen user group, used to get the next page when sorting by created_at."
+
+type LastSeenIdDesc = Description "`id` of the last seen group, used to get the next page. **Must** be sent to get the next page."
+
 type UserGroupAPI =
   Named
     "create-user-group"
@@ -316,6 +324,20 @@ type UserGroupAPI =
                     ]
                     (Maybe UserGroup)
            )
+    :<|> Named
+           "get-user-groups"
+           ( From 'V10
+               :> ZLocalUser
+               :> "user-groups"
+               :> QueryParam' '[Optional, Strict, Description "Search string"] "q" Text
+               :> QueryParam' '[Optional, Strict] "sort_by" SortBy
+               :> QueryParam' '[Optional, Strict] "sort_order" SortOrder
+               :> QueryParam' '[Optional, Strict] "page_size" PageSize
+               :> 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
+               :> Get '[JSON] UserGroupPage
+           )
     :<|> Named
            "update-user-group"
            ( From 'V10