WPB-21768: Add SCIM get/filter groups response pagination

cassandra-schema.cql

@@ -1114,7 +1114,7 @@ CREATE TABLE galley_test.team_conv (
     AND crc_check_chance = 1.0
     AND dclocal_read_repair_chance = 0.1
     AND default_time_to_live = 0
-    AND gc_grace_seconds = 864000
+    AND gc_grace_seconds = 86400
     AND max_index_interval = 2048
     AND memtable_flush_period_in_ms = 0
     AND min_index_interval = 128
@@ -1295,7 +1295,7 @@ CREATE TABLE galley_test.member (
     AND crc_check_chance = 1.0
     AND dclocal_read_repair_chance = 0.1
     AND default_time_to_live = 0
-    AND gc_grace_seconds = 864000
+    AND gc_grace_seconds = 86400
     AND max_index_interval = 2048
     AND memtable_flush_period_in_ms = 0
     AND min_index_interval = 128
@@ -1381,7 +1381,7 @@ CREATE TABLE galley_test.member_remote_user (
     AND crc_check_chance = 1.0
     AND dclocal_read_repair_chance = 0.1
     AND default_time_to_live = 0
-    AND gc_grace_seconds = 864000
+    AND gc_grace_seconds = 86400
     AND max_index_interval = 2048
     AND memtable_flush_period_in_ms = 0
     AND min_index_interval = 128
@@ -1508,7 +1508,7 @@ CREATE TABLE galley_test.user (
     AND crc_check_chance = 1.0
     AND dclocal_read_repair_chance = 0.1
     AND default_time_to_live = 0
-    AND gc_grace_seconds = 864000
+    AND gc_grace_seconds = 86400
     AND max_index_interval = 2048
     AND memtable_flush_period_in_ms = 0
     AND min_index_interval = 128
@@ -1600,7 +1600,7 @@ CREATE TABLE galley_test.mls_group_member_client (
     AND crc_check_chance = 1.0
     AND dclocal_read_repair_chance = 0.1
     AND default_time_to_live = 0
-    AND gc_grace_seconds = 864000
+    AND gc_grace_seconds = 86400
     AND max_index_interval = 2048
     AND memtable_flush_period_in_ms = 0
     AND min_index_interval = 128
@@ -1654,7 +1654,7 @@ CREATE TABLE galley_test.conversation (
     AND crc_check_chance = 1.0
     AND dclocal_read_repair_chance = 0.1
     AND default_time_to_live = 0
-    AND gc_grace_seconds = 864000
+    AND gc_grace_seconds = 86400
     AND max_index_interval = 2048
     AND memtable_flush_period_in_ms = 0
     AND min_index_interval = 128
@@ -1698,7 +1698,7 @@ CREATE TABLE galley_test.subconversation (
     AND crc_check_chance = 1.0
     AND dclocal_read_repair_chance = 0.1
     AND default_time_to_live = 0
-    AND gc_grace_seconds = 864000
+    AND gc_grace_seconds = 86400
     AND max_index_interval = 2048
     AND memtable_flush_period_in_ms = 0
     AND min_index_interval = 128

changelog.d/1-api-changes/add-scim-group-pagination

@@ -0,0 +1 @@
+Add [pagination to SCIM groups](https://datatracker.ietf.org/doc/html/rfc7644#section-3.4.2.4) in Spar /scim/v2/Groups

integration/test/API/Spar.hs

@@ -135,11 +135,18 @@ deleteScimUserGroup domain token groupId = do
   submit "DELETE" $ req & addHeader "Authorization" ("Bearer " <> token)
 
 filterScimUserGroup :: (HasCallStack, MakesValue domain) => domain -> String -> Maybe String -> App Response
-filterScimUserGroup domain token mbFilter = do
+filterScimUserGroup domain token mbFilter = filterScimUserGroupPaginate domain token mbFilter Nothing Nothing
+
+filterScimUserGroupPaginate :: (HasCallStack, MakesValue domain) => domain -> String -> Maybe String -> Maybe Int -> Maybe Int -> App Response
+filterScimUserGroupPaginate domain token mbFilter mbStartIndex mbCount = do
   req <- baseRequest domain Spar Versioned "/scim/v2/Groups"
   submit "GET" $ req
     & scimCommonHeaders token
-    & maybe id (\f -> addQueryParams [("filter", f)]) mbFilter
+    & addQueryParams
+      ( maybe [] (\f -> [("filter", f)]) mbFilter
+          <> maybe [] (\startIndex -> [("startIndex", show startIndex)]) mbStartIndex
+          <> maybe [] (\count -> [("count", show count)]) mbCount
+      )
 
 mkScimGroup :: String -> [Value] -> Value
 mkScimGroup name members =

integration/test/Test/Spar.hs

@@ -449,6 +449,72 @@ testSparScimCreateGetSearchUserGroup = do
     (singleEmptyGroup %. "members" & asList) `shouldMatch` ([] :: [Value])
     respGroup4.json `shouldMatch` singleEmptyGroup
 
+  -- 4. Pagination
+  let searchPage substr startIndex count =
+        filterScimUserGroupPaginate
+          OwnDomain
+          tok
+          (Just $ "displayName co \"" <> substr <> "\"")
+          (Just startIndex)
+          (Just count)
+      createGroup name = createScimUserGroup OwnDomain tok $ mkScimGroup name [mkScimUser scimUserId]
+
+  -- Create 20 groups
+  let expectedTotalResults = 20 :: Int
+  forM_ [1 .. expectedTotalResults] $ \n -> createGroup ("newGroupNo" <> show n)
+
+  -- Go through 4 pages (the last one is an empty page)
+  forM_ [1 .. 4] $ \p ->
+    let startIndex = (p - 1) * count + 1 -- 1-based index
+        count = 7
+        expectedItemsPerPage = max 0 (min count (expectedTotalResults - startIndex + 1)) -- expected between 0 and `count` depending on if it's a full, half or empty page
+     in searchPage "newGroupNo" startIndex count `bindResponse` \resp -> do
+          resp.json %. "startIndex" `shouldMatchInt` startIndex
+          resp.json %. "totalResults" `shouldMatchInt` expectedTotalResults
+          resp.json %. "itemsPerPage" `shouldMatchInt` expectedItemsPerPage
+          resources <- resp.json %. "Resources" & asList
+          length resources `shouldMatchInt` expectedItemsPerPage
+
+  -- startIndex=0 edge case: the 0 is treated as 1 according to SCIM spec
+  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"newGroupNo\"") (Just 0) (Just 5) `bindResponse` \resp -> do
+    resp.json %. "startIndex" `shouldMatchInt` 1
+    resources <- resp.json %. "Resources" & asList
+    length resources `shouldMatchInt` 5
+
+  -- startIndex=-2 edge case: -2 is treated as 1 according to SCIM spec
+  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"newGroupNo\"") (Just (-2)) (Just 9) `bindResponse` \resp -> do
+    resp.json %. "startIndex" `shouldMatchInt` 1
+    resources <- resp.json %. "Resources" & asList
+    length resources `shouldMatchInt` 9
+
+  -- Only startIndex, no count
+  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"newGroupNo\"") (Just 5) Nothing `bindResponse` \resp -> do
+    resp.json %. "startIndex" `shouldMatchInt` 5
+    resp.json %. "totalResults" `shouldMatchInt` expectedTotalResults
+
+  -- Only count, no startIndex
+  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"newGroupNo\"") Nothing (Just 3) `bindResponse` \resp -> do
+    resp.json %. "startIndex" `shouldMatchInt` 1
+    resp.json %. "itemsPerPage" `shouldMatchInt` 3
+    resources <- resp.json %. "Resources" & asList
+    length resources `shouldMatchInt` 3
+
+  -- Filter with empty result
+  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"nonexistent-filter-xyz\"") (Just 1) (Just 10) `bindResponse` \resp -> do
+    resp.json %. "startIndex" `shouldMatchInt` 1
+    resp.json %. "totalResults" `shouldMatchInt` 0
+    resp.json %. "itemsPerPage" `shouldMatchInt` 0
+    resources <- resp.json %. "Resources" & asList
+    length resources `shouldMatchInt` 0
+
+  -- All results in one page
+  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"newGroupNo\"") (Just 1) (Just 100) `bindResponse` \resp -> do
+    resp.json %. "startIndex" `shouldMatchInt` 1
+    resp.json %. "totalResults" `shouldMatchInt` expectedTotalResults
+    resp.json %. "itemsPerPage" `shouldMatchInt` expectedTotalResults
+    resources <- resp.json %. "Resources" & asList
+    length resources `shouldMatchInt` expectedTotalResults
+
 testSparScimUpdateUserGroup :: (HasCallStack) => App ()
 testSparScimUpdateUserGroup = do
   (alice, tid, []) <- createTeam OwnDomain 1

libs/hscim/default.nix

@@ -10,6 +10,7 @@
 , base
 , bytestring
 , case-insensitive
+, containers
 , email-validate
 , gitignoreSource
 , hashable
@@ -21,8 +22,10 @@
 , http-api-data
 , http-media
 , http-types
+, HUnit
 , hw-hspec-hedgehog
 , indexed-traversable
+, lens-aeson
 , lib
 , list-t
 , microlens
@@ -43,6 +46,7 @@
 , time
 , utf8-string
 , uuid
+, vector
 , wai
 , wai-extra
 , wai-utilities
@@ -62,6 +66,7 @@ mkDerivation {
     base
     bytestring
     case-insensitive
+    containers
     email-validate
     hashable
     hspec
@@ -113,14 +118,17 @@ mkDerivation {
     hspec-expectations
     hspec-wai
     http-types
+    HUnit
     hw-hspec-hedgehog
     indexed-traversable
+    lens-aeson
     microlens
     network-uri
     servant
     servant-server
     stm-containers
     text
+    vector
     wai
     wai-extra
   ];

libs/hscim/hscim.cabal

@@ -92,6 +92,7 @@ library
     , base
     , bytestring
     , case-insensitive
+    , containers
     , email-validate
     , hashable
     , hspec
@@ -219,14 +220,17 @@ test-suite spec
     , hspec-expectations
     , hspec-wai
     , http-types
+    , HUnit
     , hw-hspec-hedgehog
     , indexed-traversable
+    , lens-aeson
     , microlens
     , network-uri
     , servant
     , servant-server
     , stm-containers
     , text
+    , vector
     , wai
     , wai-extra
 

libs/hscim/src/Web/Scim/Class/Group.hs

@@ -85,6 +85,8 @@ data GroupSite tag route = GroupSite
   { gsGetGroups ::
       route
         :- QueryParam "filter" Filter
+          :> QueryParam "startIndex" Int
+          :> QueryParam "count" Int
           :> Get '[SCIM] (ListResponse (StoredGroup tag)),
     gsGetGroup ::
       route
@@ -119,6 +121,8 @@ class (Monad m, GroupTypes tag, AuthDB tag m) => GroupDB tag m where
   getGroups ::
     AuthInfo tag ->
     Maybe Filter ->
+    Maybe Int ->
+    Maybe Int ->
     ScimHandler m (ListResponse (StoredGroup tag))
 
   -- | Get a single group by ID.
@@ -179,9 +183,9 @@ groupServer ::
   GroupSite tag (AsServerT (ScimHandler m))
 groupServer authData =
   GroupSite
-    { gsGetGroups = \mbFilter -> do
+    { gsGetGroups = \mbFilter mbStartIndex mbCount -> do
         auth <- authCheck @tag authData
-        getGroups @tag auth mbFilter,
+        getGroups @tag auth mbFilter mbStartIndex mbCount,
       gsGetGroup = \gid -> do
         auth <- authCheck @tag authData
         getGroup @tag auth gid,

libs/hscim/src/Web/Scim/Server/Mock.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- This file is part of the Wire Server implementation.
@@ -29,7 +30,11 @@ import Control.Monad.Reader
 import Control.Monad.STM (STM, atomically)
 import Data.Aeson
 import qualified Data.CaseInsensitive as CI
+import qualified Data.Foldable as Fold
 import Data.Hashable
+import Data.Maybe (fromMaybe)
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
 import Data.Text (Text, pack)
 import Data.Time.Calendar
 import Data.Time.Clock
@@ -50,7 +55,7 @@ import Web.Scim.Schema.Error
 import Web.Scim.Schema.ListResponse
 import Web.Scim.Schema.Meta
 import Web.Scim.Schema.ResourceType
-import Web.Scim.Schema.Schema (Schema (Group20, User20))
+import Web.Scim.Schema.Schema (Schema (Group20, ListResponse20, User20))
 import Web.Scim.Schema.User hiding (displayName)
 
 -- | Tag used in the mock server.
@@ -155,7 +160,7 @@ instance GroupTypes Mock where
   type GroupId Mock = Id
 
 instance GroupDB Mock TestServer where
-  getGroups () mbFilter = do
+  getGroups () mbFilter mbStartIndex mbCount = do
     m <- asks groupDB
     groups <- map snd <$> liftSTM (ListT.toList $ STMMap.listT m)
     case mbFilter of
@@ -170,7 +175,7 @@ instance GroupDB Mock TestServer where
              in pureSorted $ filter p groups
           _ -> throwScim $ badRequest InvalidFilter $ Just "Only displayName filter supported"
     where
-      pureSorted groups = pure $ fromList $ sortWith (Common.id . thing) groups
+      pureSorted groups = pure $ toPage (fromMaybe 1 mbStartIndex) mbCount $ sortWith (Common.id . thing) groups
 
   getGroup () gid = do
     m <- asks groupDB
@@ -202,6 +207,31 @@ instance GroupDB Mock TestServer where
       Nothing -> throwScim (notFound "Group" (pack (show gid)))
       Just _ -> liftSTM $ STMMap.delete gid m
 
+toPage :: forall a. Int -> Maybe Int -> [a] -> ListResponse a
+toPage (max 1 -> startIx) mbCount list = case mbCount of
+  Nothing ->
+    ListResponse
+      { Web.Scim.Schema.ListResponse.schemas = [ListResponse20],
+        totalResults = totalResults',
+        startIndex = startIx,
+        itemsPerPage = Seq.length list',
+        resources = Fold.toList list'
+      }
+  Just count ->
+    let (page, _rest) = Seq.splitAt (fromIntegral safeCount) list'
+        safeCount = max 0 (min count maxBound)
+     in ListResponse
+          { Web.Scim.Schema.ListResponse.schemas = [ListResponse20],
+            totalResults = totalResults',
+            startIndex = startIx,
+            itemsPerPage = Seq.length page,
+            resources = Fold.toList page
+          }
+  where
+    totalResults' = length list
+    list' :: Seq a
+    list' = Seq.drop (startIx - 1) (Seq.fromList list)
+
 ----------------------------------------------------------------------------
 -- AuthDB
 
@@ -234,9 +264,11 @@ createMeta rType =
       lastModified = testDate,
       version = Weak "testVersion",
       location =
-        Common.URI $ -- FUTUREWORK: getting the actual schema, authority, and path here
-        -- is a bit of work, but it may be required one day.
-          URI "https:" (Just $ URI.URIAuth "" "example.com" "") "/Users/id" "" ""
+        Common.URI
+          (URI "https:" (Just $ URI.URIAuth "" "example.com" "") "/Users/id" "" "")
+          -- FUTUREWORK: getting the actual schema, authority, and
+          -- path here is a bit of work, but it may be required one
+          -- day.
     }
 
 -- Natural transformation from our transformer stack to the Servant stack