-- 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/>.

-- | Tests for listing SCIM users (@GET /scim/v2/Users@) without a filter, using
-- @startIndex@ and @count@. Listing is backed by an offset-paginated query in
-- brig which is only available when the user store is Postgres.
module Test.Spar.ListUsers where

import API.Spar
import GHC.Stack
import SetupHelpers
import Testlib.Prelude

-- | The storage location of users, as configured for brig.
getUserStore :: (HasCallStack) => App String
getUserStore :: HasCallStack => App String
getUserStore = Service -> App Value
readServiceConfig Service
Brig App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"postgresMigration.user" 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

-- | Create a SCIM user. If 'acceptInvitation' is set, the invitation is accepted
-- immediately, otherwise brig would garbage collect the user because of the
-- very short team invitation timeout in the test environment.
createScimUserInTeam :: (HasCallStack, MakesValue domain) => domain -> String -> String -> Bool -> App String
createScimUserInTeam :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> Bool -> App String
createScimUserInTeam domain
domain String
tok String
tid Bool
acceptInvitation = do
  scimUser <- App Value
randomScimUser
  email <- scimUser %. "emails.0.value" & asString
  scimId <- createScimUser domain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
  when acceptInvitation $ registerInvitedUser domain tid email
  pure scimId

-- | Create a team with a SCIM token and @n@ active SCIM users. Returns the
-- token, the team ID, the owner and the SCIM IDs of the created users.
setupTeamWithScimUsers :: (HasCallStack, MakesValue domain) => domain -> Int -> App (String, String, Value, [String])
setupTeamWithScimUsers :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (String, String, Value, [String])
setupTeamWithScimUsers domain
domain Int
n = do
  (owner, tid, _) <- domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam domain
domain Int
1
  tok <- createScimToken owner def >>= getJSON 200 >>= (%. "token") >>= asString
  scimIds <- replicateM n $ createScimUserInTeam domain tok tid True
  pure (tok, tid, owner, scimIds)

-- | Assert on the page structure and return the SCIM IDs of the resources.
assertPage ::
  (HasCallStack, MakesValue domain) =>
  domain ->
  Maybe Int ->
  Maybe Int ->
  -- | expected startIndex
  Int ->
  -- | expected totalResults
  Int ->
  -- | expected itemsPerPage
  Int ->
  String ->
  App [String]
assertPage :: forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> Int
-> String
-> App [String]
assertPage domain
domain Maybe Int
mStartIndex Maybe Int
mCount Int
expectedStart Int
expectedTotal Int
expectedItems String
tok =
  domain -> String -> Maybe Int -> Maybe Int -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe Int -> Maybe Int -> App Response
listScimUsersPaginate domain
domain String
tok Maybe Int
mStartIndex Maybe Int
mCount App Response -> (Response -> App [String]) -> App [String]
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"startIndex" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
expectedStart
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"totalResults" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
expectedTotal
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"itemsPerPage" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
expectedItems
    resources <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Resources" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length resources `shouldMatchInt` expectedItems
    for resources $ \Value
r -> Value
r Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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

testSparScimListUsersPaginated :: (HasCallStack) => App ()
testSparScimListUsersPaginated :: HasCallStack => App ()
testSparScimListUsersPaginated = do
  store <- App String
HasCallStack => App String
getUserStore
  -- Only the Postgres user store supports offset based pagination.
  when (store == "postgresql") $ do
    let settings =
          ServiceOverrides
forall a. Default a => a
def
            { brigCfg =
                setField "optSettings.setTeamInvitationTimeout" (4 :: Int)
                  -- Keep expired accounts around so listing must filter them.
                  . setField "optSettings.setExpiredUserCleanupTimeout" (3600 :: Int)
            }
    withModifiedBackend settings $ \String
domain -> do
      let total :: Int
total = Int
12
          defaultCount :: Int
defaultCount = Int
10
      (tok, tid, _owner, scimIds) <- String -> Int -> App (String, String, Value, [String])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (String, String, Value, [String])
setupTeamWithScimUsers String
domain Int
total
      (tokOther, _tidOther, _ownerOther, scimIdsOther) <- setupTeamWithScimUsers domain 2

      -- walk through all pages, none of the users should be repeated and the team
      -- owner (managed by wire) should not be listed.
      let count = Int
5
      pages <- forM [1, 6, 11] $ \Int
startIndex ->
        String
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> Int
-> String
-> App [String]
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> Int
-> String
-> App [String]
assertPage String
domain (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
startIndex) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count) Int
startIndex Int
total (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))) String
tok
      let allIds = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
pages
      length allIds `shouldMatchInt` total
      allIds `shouldMatchSet` scimIds

      -- the default count is 10
      firstPage <- assertPage domain Nothing Nothing 1 total defaultCount tok
      firstPage `shouldMatchSet` take defaultCount allIds
      void $ assertPage domain (Just 11) Nothing 11 total (total - 10) tok

      -- count=0 is used to just get the total
      void $ assertPage domain Nothing (Just 0) 1 total 0 tok

      -- index after the last user
      void $ assertPage domain (Just (total + 1)) (Just count) (total + 1) total 0 tok

      -- indexes lower than 1 are treated as 1
      forM_ [0, -2, -2147483648, minBound] $ \Int
startIndex -> do
        ids <- String
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> Int
-> String
-> App [String]
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> Int
-> String
-> App [String]
assertPage String
domain (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
startIndex) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count) Int
1 Int
total Int
count String
tok
        ids `shouldMatchSet` take count allIds

      -- Large indices must never wrap around or fall back to the first page.
      forM_ [2147483648, 2147483649, maxBound] $ \Int
startIndex ->
        App [String] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [String] -> App ()) -> App [String] -> App ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> Int
-> String
-> App [String]
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> Int
-> String
-> App [String]
assertPage String
domain (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
startIndex) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count) Int
startIndex Int
total Int
0 String
tok

      -- other teams are not mixed up
      otherIds <- assertPage domain Nothing Nothing 1 2 2 tokOther
      otherIds `shouldMatchSet` scimIdsOther

      -- pending (not yet accepted) SCIM users are listed as well
      pendingId <- createScimUserInTeam domain tok tid False
      idsWithPending <- assertPage domain (Just 1) (Just 20) 1 (total + 1) (total + 1) tok
      idsWithPending `shouldContain` [pendingId]

      -- Once the pending invitation expires, listing must exclude the user and
      -- stop counting it. Use only the listing endpoint so a GET by ID cannot
      -- trigger cleanup. Retry until expiration, but check the total outside the
      -- retry so asynchronous deletion cannot mask an inconsistent response.
      pageAfterExpiration <- retryT $ do
        page <- listScimUsersPaginate domain tok (Just 1) (Just 20) >>= getJSON 200
        resources <- page %. "Resources" & asList
        idsAfterExpiration <- for resources $ \Value
r -> Value
r Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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
        idsAfterExpiration `shouldMatchSet` scimIds
        pure page
      pageAfterExpiration %. "totalResults" `shouldMatchInt` total
      pageAfterExpiration %. "itemsPerPage" `shouldMatchInt` total
      -- The count-only query must exclude the expired user as well.
      void $ assertPage domain Nothing (Just 0) 1 total 0 tok

      -- Expiration must not leave holes in pages or shift the accepted users.
      pagesAfterExpiration <- forM [1, 6, 11] $ \Int
startIndex ->
        String
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> Int
-> String
-> App [String]
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> Int
-> String
-> App [String]
assertPage String
domain (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
startIndex) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count) Int
startIndex Int
total (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))) String
tok
      concat pagesAfterExpiration `shouldMatch` allIds

testSparScimListUsersUnsupportedStore :: (HasCallStack) => App ()
testSparScimListUsersUnsupportedStore :: HasCallStack => App ()
testSparScimListUsersUnsupportedStore = do
  store <- App String
HasCallStack => App String
getUserStore
  when (store /= "postgresql") $ do
    (tok, _tid, _owner, _scimIds) <- setupTeamWithScimUsers OwnDomain 1
    listScimUsersPaginate OwnDomain tok (Just 1) (Just 10) `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
      Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"scimType" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"tooMany"