{-# OPTIONS_GHC -Wno-incomplete-patterns  -Wno-ambiguous-fields #-}

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

module Test.Spar where

import API.Brig as Brig
import API.BrigInternal as BrigInternal
import API.Common (defPassword, randomDomain, randomEmail, randomExternalId, randomHandle)
import API.GalleyInternal (setTeamFeatureStatus)
import qualified API.Nginz as Nginz
import API.Spar
import API.SparInternal
import Control.Lens (to, (^.))
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Types as A
import qualified Data.CaseInsensitive as CI
import qualified Data.Hourglass as Hourglass
import qualified Data.List.NonEmpty as NonEmpty
import Data.String.Conversions (cs)
import qualified Data.Text as ST
import qualified Data.UUID as UUID
import Data.UUID.V4 (nextRandom)
import qualified Data.Vector as V
import qualified SAML2.WebSSO as SAML
import qualified SAML2.WebSSO.Test.MockResponse as SAML
import qualified SAML2.WebSSO.Test.Util as SAML
import qualified SAML2.WebSSO.XML as SAMLXML
import SetupHelpers
import Testlib.Assertions
import Testlib.JSON
import Testlib.PTest
import Testlib.Prelude
import qualified Text.XML.DSig as SAML
import qualified Time.System as Hourglass

----------------------------------------------------------------------
-- scim stuff

testTeamInvitationWhenScimInvitationExpired :: (HasCallStack) => App ()
testTeamInvitationWhenScimInvitationExpired = do
  let settings =
        def
          { brigCfg =
              -- timeout for both SCIM and team invitations
              setField "optSettings.setTeamInvitationTimeout" (2 :: Int)
                -- Controls when asynchronous cleanup removes expired SCIM pending accounts.
                . setField "optSettings.setExpiredUserCleanupTimeout" (3600 :: Int)
          }
  withModifiedBackend settings $ \domain -> do
    (owner, _tid, _) <- createTeam domain 1
    token <- createScimToken owner def >>= getJSON 200 >>= (%. "token") >>= asString

    -- Create a SCIM user and let its invitation expire. Cleanup is deliberately
    -- delayed so the expired pending account still exists at this point.
    email <- randomEmail
    externalId <- randomExternalId
    scimUser <- randomScimUserWithEmail externalId email
    scid <- createScimUser domain token scimUser >>= getJSON 201 >>= (%. "id") >>= asString
    handle <- scimUser %. "userName" >>= asString

    -- assert that the SCIM handle is claimed
    putHandle owner handle >>= assertStatus 409

    -- Wait until the SCIM invitation has expired.
    eventually $ getInvitationByEmail domain email >>= assertStatus 404

    -- Create and accept a manual team invitation for the same email. This is
    -- expected to succeed after the expired SCIM account has been cleaned up.
    invitation <- postInvitation owner (def {email = Just email}) >>= getJSON 201
    code <- getInvitationCode owner invitation >>= getJSON 200 >>= (%. "code") >>= asString
    registerUserWith domain email code "Alice" >>= assertStatus 201
    user <- getUsersByEmail domain [email] >>= getJSON 200 >>= asList >>= assertOne
    manualUserId <- user %. "id" >>= asString

    -- The handle previously held by the SCIM account is available again.
    putHandle user handle >>= assertSuccess

    manualUser <- getUsersId domain [manualUserId] >>= getJSON 200 >>= asList >>= assertOne
    manualUser %. "id" `shouldMatch` manualUserId
    manualUser %. "email" `shouldMatch` email
    manualUser %. "handle" `shouldMatch` handle
    manualUser %. "managed_by" `shouldMatch` "wire"
    manualUser %. "status" `shouldMatch` "active"

    -- The regular internal users API filters deleted records, so it cannot
    -- distinguish a deleted SCIM account from an account that is not found.
    shouldBeEmpty $ getUsersId domain [scid] >>= getJSON 200 >>= asList

testTeamInvitationWhenScimInvitationPending :: (HasCallStack) => App ()
testTeamInvitationWhenScimInvitationPending = do
  (owner, _tid, _) <- createTeam OwnDomain 1
  (otherOwner, _otherTid, _) <- createTeam OwnDomain 1
  token <- createScimToken owner def >>= getJSON 200 >>= (%. "token") >>= asString

  -- Create a SCIM user; this sends a SCIM invitation that remains pending.
  email <- randomEmail
  externalId <- randomExternalId
  scimUser <- randomScimUserWithEmail externalId email
  scid <- createScimUser OwnDomain token scimUser >>= getJSON 201 >>= (%. "id") >>= asString
  handle <- scimUser %. "userName" >>= asString

  -- The SCIM invitation is still pending. A second team invitation for the
  -- same email and team must be rejected with a conflict.
  postInvitation owner (def {email = Just email}) >>= assertStatus 409

  -- The email must still be invit-able by a different team; otherwise a
  -- pending SCIM invitation could be used for an email-registration DoS.
  postInvitation otherOwner (def {email = Just email}) >>= assertStatus 201

  users <- getUsersIdIncludingPending OwnDomain [scid] >>= getJSON 200 >>= asList
  user <- assertOne users
  user %. "email" `shouldMatch` email
  user %. "handle" `shouldMatch` handle
  user %. "managed_by" `shouldMatch` "scim"
  user %. "status" `shouldMatch` "pending-invitation"

testTeamInvitationWhenScimAccountExists :: (HasCallStack) => App ()
testTeamInvitationWhenScimAccountExists = do
  (owner, tid, _) <- createTeam OwnDomain 1
  token <- createScimToken owner def >>= getJSON 200 >>= (%. "token") >>= asString

  -- Create a SCIM user and accept the resulting SCIM invitation below.
  email <- randomEmail
  externalId <- randomExternalId
  scimUser <- randomScimUserWithEmail externalId email
  scid <- createScimUser OwnDomain token scimUser >>= getJSON 201 >>= (%. "id") >>= asString
  handle <- scimUser %. "userName" >>= asString

  -- Accept the SCIM invitation so the SCIM-managed account is active.
  registerInvitedUser OwnDomain tid email

  -- An active SCIM account already owns the email. A second team invitation
  -- for the same email must therefore be rejected with a conflict.
  postInvitation owner (def {email = Just email}) >>= assertStatus 409

  users <- getUsersId OwnDomain [scid] >>= getJSON 200 >>= asList
  user <- assertOne users
  user %. "email" `shouldMatch` email
  user %. "handle" `shouldMatch` handle
  user %. "managed_by" `shouldMatch` "scim"
  user %. "status" `shouldMatch` "active"

testSparUserCreationInvitationTimeout :: (HasCallStack) => App ()
testSparUserCreationInvitationTimeout = do
  (owner, tid, _) <- createTeam OwnDomain 1
  tok <- createScimTokenV6 owner def >>= \resp -> resp.json %. "token" >>= asString

  email <- randomEmail
  extId <- randomExternalId
  scimUserToAcceptInvitation <- randomScimUserWithEmail extId email
  scimUserToExpire <- randomScimUser

  uidToExpire <- bindResponse (createScimUser OwnDomain tok scimUserToExpire) $ \res -> do
    res.status `shouldMatchInt` 201
    res.json %. "id" >>= asString

  dom <- asString OwnDomain
  let quidToExpire = object ["id" .= uidToExpire, "domain" .= dom]

  uidToAcceptInvitation <- bindResponse (createScimUser OwnDomain tok scimUserToAcceptInvitation) $ \res -> do
    res.status `shouldMatchInt` 201
    res.json %. "id" >>= asString

  withWebSocket quidToExpire $ \expireWs -> do
    -- Accept the invitation for one user
    registerInvitedUser OwnDomain tid email

    -- Getting both users immediately succeeds
    getScimUser owner tok uidToExpire >>= assertSuccess
    getScimUser owner tok uidToAcceptInvitation >>= assertSuccess

    -- Trying to create the same user again right away should fail
    bindResponse (createScimUser OwnDomain tok scimUserToExpire) $ \res -> do
      res.status `shouldMatchInt` 409

    bindResponse (createScimUser OwnDomain tok scimUserToAcceptInvitation) $ \res -> do
      res.status `shouldMatchInt` 409

    -- However, if we wait until the invitation timeout has passed. It's
    -- currently configured to 1s local/CI, however we rely on the user actually
    -- being deleted which happens in yet another background job, so we wait
    -- until the user receives the delete event.
    --
    -- Here we await any event because this user shouldn't receive any other
    -- events.
    void $ awaitAnyEvent 10 expireWs

    getScimUser owner tok uidToExpire >>= assertStatus 404
    getScimUser owner tok uidToAcceptInvitation >>= assertSuccess

    -- We should be able to create the user again
    retryT $ bindResponse (createScimUser OwnDomain tok scimUserToExpire) $ \res -> do
      res.status `shouldMatchInt` 201

testSparExternalIdDifferentFromEmailWithIdp :: (HasCallStack) => App ()
testSparExternalIdDifferentFromEmailWithIdp = do
  (owner, tid, _) <- createTeam OwnDomain 1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  void $ registerTestIdPWithMeta owner >>= getJSON 201
  tok <- createScimTokenV6 owner def >>= getJSON 200 >>= (%. "token") >>= asString
  email <- randomEmail
  extId <- randomExternalId
  scimUser <- randomScimUserWithEmail extId email
  userId <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
  activateEmail OwnDomain email
  checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \u -> do
    u %. "externalId" `shouldMatch` extId
    (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` email
  bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
    res.status `shouldMatchInt` 200
    u <- res.json & asList >>= assertOne
    u %. "email" `shouldMatch` email
    subject <- u %. "sso_id.subject" >>= asString
    subject `shouldContainString` extId
    u %. "handle" `shouldMatch` (scimUser %. "userName")

  -- Verify that updating `userName` (handle) works
  scimUserWith1Update <- do
    newHandle <- randomHandle
    updatedScimUser <- setField "userName" newHandle scimUser
    bindResponse (updateScimUser OwnDomain tok userId updatedScimUser) $ \res -> do
      res.status `shouldMatchInt` 200
      res.json %. "userName" `shouldMatch` newHandle
    checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \u -> do
      u %. "externalId" `shouldMatch` extId
      (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` email
    bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
      res.status `shouldMatchInt` 200
      u <- res.json & asList >>= assertOne
      u %. "handle" `shouldMatch` newHandle
    pure updatedScimUser

  -- Verify that updating the user's external ID works
  scimUserWith2Updates <- do
    newExtId <- randomExternalId
    updatedScimUser <- setField "externalId" newExtId scimUserWith1Update
    bindResponse (updateScimUser OwnDomain tok userId updatedScimUser) $ \res -> do
      res.status `shouldMatchInt` 200
      res.json %. "externalId" `shouldMatch` newExtId
    checkSparGetUserAndFindByExtId OwnDomain tok newExtId userId $ \u -> do
      u %. "externalId" `shouldMatch` newExtId
      (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` email
    bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
      res.status `shouldMatchInt` 200
      u <- res.json & asList >>= assertOne
      u %. "email" `shouldMatch` email
      subject <- u %. "sso_id.subject" >>= asString
      subject `shouldContainString` newExtId
    bindResponse (findUsersByExternalId OwnDomain tok extId) $ \res -> do
      res.json %. "totalResults" `shouldMatchInt` 0
      res.json %. "Resources" `shouldMatch` ([] :: [Value])
    pure updatedScimUser

  -- Verify that updating the user's email works
  do
    let oldEmail = email
    newEmail <- randomEmail
    updatedScimUser <- setField "emails" (toJSON [object ["value" .= newEmail]]) scimUserWith2Updates
    currentExtId <- updatedScimUser %. "externalId" >>= asString
    bindResponse (updateScimUser OwnDomain tok userId updatedScimUser) $ \res -> do
      res.status `shouldMatchInt` 200

    -- before activation the old email should still be present
    checkSparGetUserAndFindByExtId OwnDomain tok currentExtId userId $ \u -> do
      u %. "externalId" `shouldMatch` currentExtId
      (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` newEmail
    bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
      res.status `shouldMatchInt` 200
      u <- res.json & asList >>= assertOne
      u %. "email" `shouldMatch` oldEmail
      subject <- u %. "sso_id.subject" >>= asString
      subject `shouldContainString` currentExtId

    -- after activation the new email should be present
    activateEmail OwnDomain newEmail
    checkSparGetUserAndFindByExtId OwnDomain tok currentExtId userId $ \u -> do
      u %. "externalId" `shouldMatch` currentExtId
      (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` newEmail
    bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
      res.status `shouldMatchInt` 200
      u <- res.json & asList >>= assertOne
      u %. "email" `shouldMatch` newEmail
      subject <- u %. "sso_id.subject" >>= asString
      subject `shouldContainString` currentExtId

testSparExternalIdDifferentFromEmail :: (HasCallStack) => App ()
testSparExternalIdDifferentFromEmail = do
  (owner, tid, _) <- createTeam OwnDomain 1
  tok <- createScimTokenV6 owner def >>= \resp -> resp.json %. "token" >>= asString
  email <- randomEmail
  extId <- randomExternalId
  scimUser <- randomScimUserWithEmail extId email
  userId <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString

  checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \u -> do
    u %. "externalId" `shouldMatch` extId
    (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` email
  bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
    res.status `shouldMatchInt` 200
    res.json & asList >>= shouldBeEmpty

  registerInvitedUser OwnDomain tid email

  checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \u -> do
    u %. "externalId" `shouldMatch` extId
    (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` email
  bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
    res.status `shouldMatchInt` 200
    u <- res.json & asList >>= assertOne
    u %. "email" `shouldMatch` email
    u %. "sso_id.scim_external_id" `shouldMatch` extId
    u %. "handle" `shouldMatch` (scimUser %. "userName")

  -- Verify that updating the scim user works
  scimUserWith1Update <- do
    -- FUTUREWORK: test updating other fields besides handle as well
    newHandle <- randomHandle
    updatedScimUser <- setField "userName" newHandle scimUser
    bindResponse (updateScimUser OwnDomain tok userId updatedScimUser) $ \res -> do
      res.status `shouldMatchInt` 200
      res.json %. "userName" `shouldMatch` newHandle
    checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \u -> do
      u %. "externalId" `shouldMatch` extId
      (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` email
    bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
      res.status `shouldMatchInt` 200
      u <- res.json & asList >>= assertOne
      u %. "handle" `shouldMatch` newHandle
    pure updatedScimUser

  -- Verify that updating the user's external ID works
  scimUserWith2Updates <- do
    newExtId <- randomExternalId
    updatedScimUser <- setField "externalId" newExtId scimUserWith1Update
    bindResponse (updateScimUser OwnDomain tok userId updatedScimUser) $ \res -> do
      res.status `shouldMatchInt` 200
      res.json %. "externalId" `shouldMatch` newExtId
    checkSparGetUserAndFindByExtId OwnDomain tok newExtId userId $ \u -> do
      u %. "externalId" `shouldMatch` newExtId
      (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` email
    bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
      res.status `shouldMatchInt` 200
      u <- res.json & asList >>= assertOne
      u %. "email" `shouldMatch` email
      u %. "sso_id.scim_external_id" `shouldMatch` newExtId
    bindResponse (findUsersByExternalId OwnDomain tok extId) $ \res -> do
      res.json %. "totalResults" `shouldMatchInt` 0
      res.json %. "Resources" `shouldMatch` ([] :: [Value])
    pure updatedScimUser

  -- Verify that updating the user's email works
  do
    let oldEmail = email
    newEmail <- randomEmail
    updatedScimUser <- setField "emails" (toJSON [object ["value" .= newEmail]]) scimUserWith2Updates
    currentExtId <- updatedScimUser %. "externalId" >>= asString
    bindResponse (updateScimUser OwnDomain tok userId updatedScimUser) $ \res -> do
      res.status `shouldMatchInt` 200

    -- before activation the new email should be returned by the SCIM API
    checkSparGetUserAndFindByExtId OwnDomain tok currentExtId userId $ \u -> do
      u %. "externalId" `shouldMatch` currentExtId
      (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` newEmail
    -- however brig should still return the old email
    bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
      res.status `shouldMatchInt` 200
      u <- res.json & asList >>= assertOne
      u %. "email" `shouldMatch` oldEmail
      u %. "sso_id.scim_external_id" `shouldMatch` currentExtId

    -- after activation the new email should be present
    activateEmail OwnDomain newEmail
    checkSparGetUserAndFindByExtId OwnDomain tok currentExtId userId $ \u -> do
      u %. "externalId" `shouldMatch` currentExtId
      (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` newEmail
    bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
      res.status `shouldMatchInt` 200
      u <- res.json & asList >>= assertOne
      u %. "email" `shouldMatch` newEmail
      u %. "sso_id.scim_external_id" `shouldMatch` currentExtId

testSparExternalIdUpdateToANonEmail :: (HasCallStack) => App ()
testSparExternalIdUpdateToANonEmail = do
  (owner, tid, _) <- createTeam OwnDomain 1
  tok <- createScimTokenV6 owner def >>= \resp -> resp.json %. "token" >>= asString
  scimUser <- randomScimUser >>= removeField "emails"
  email <- scimUser %. "externalId" >>= asString
  userId <- bindResponse (createScimUser OwnDomain tok scimUser) $ \resp -> do
    resp.status `shouldMatchInt` 201
    (resp.json %. "emails" >>= asList >>= assertOne >>= (%. "value") >>= asString) `shouldMatch` email
    resp.json %. "id" >>= asString
  registerInvitedUser OwnDomain tid email

  let extId = "notanemailaddress"
  updatedScimUser <- setField "externalId" extId scimUser
  updateScimUser OwnDomain tok userId updatedScimUser >>= assertStatus 400

testSparMigrateFromExternalIdOnlyToEmail :: (HasCallStack) => Tagged "mailUnchanged" Bool -> App ()
testSparMigrateFromExternalIdOnlyToEmail (MkTagged emailUnchanged) = do
  (owner, tid, _) <- createTeam OwnDomain 1
  tok <- createScimTokenV6 owner def >>= \resp -> resp.json %. "token" >>= asString
  scimUser <- randomScimUser >>= removeField "emails"
  email <- scimUser %. "externalId" >>= asString
  userId <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
  registerInvitedUser OwnDomain tid email

  -- Verify that updating a user with an empty emails does not change the email
  bindResponse (updateScimUser OwnDomain tok userId scimUser) $ \resp -> do
    resp.json %. "emails" `shouldMatch` (toJSON [object ["value" .= email]])
    resp.status `shouldMatchInt` 200

  newEmail <- if emailUnchanged then pure email else randomEmail
  let newEmails = (toJSON [object ["value" .= newEmail]])
  updatedScimUser <- setField "emails" newEmails scimUser
  updateScimUser OwnDomain tok userId updatedScimUser `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "externalId" `shouldMatch` (updatedScimUser %. "externalId")
    resp.json %. "emails" `shouldMatch` (updatedScimUser %. "emails")

  -- after activation the new email should be present
  unless emailUnchanged $ activateEmail OwnDomain newEmail

  extId <- scimUser %. "externalId" >>= asString
  checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \u -> do
    u %. "externalId" `shouldMatch` extId
    (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` newEmail
  bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
    res.status `shouldMatchInt` 200
    u <- res.json & asList >>= assertOne
    u %. "email" `shouldMatch` newEmail
    u %. "sso_id.scim_external_id" `shouldMatch` extId

checkSparGetUserAndFindByExtId :: (HasCallStack, MakesValue domain) => domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId domain tok extId uid k = do
  usersByExtIdResp <- findUsersByExternalId domain tok extId
  usersByExtIdResp.status `shouldMatchInt` 200
  userByIdExtId <- usersByExtIdResp.json %. "Resources" >>= asList >>= assertOne
  k userByIdExtId

  userByUid <- getScimUser domain tok uid >>= getJSON 200
  k userByUid

  userByUid `shouldMatch` userByIdExtId

testSparScimTokenLimit :: (HasCallStack) => App ()
testSparScimTokenLimit = withModifiedBackend
  def
    { brigCfg =
        -- Disable password hashing rate limiting, so we can create enable services quickly
        setField @_ @Int "optSettings.setPasswordHashingRateLimit.userLimit.inverseRate" 0
    }
  $ \domain -> do
    (owner, _tid, _) <- createTeam domain 1
    replicateM_ 8 $ createScimToken owner def >>= assertSuccess
    createScimToken owner def `bindResponse` \resp -> do
      resp.status `shouldMatchInt` 403
      resp.json %. "label" `shouldMatch` "token-limit-reached"

testSparCreateScimTokenNoName :: (HasCallStack) => App ()
testSparCreateScimTokenNoName = do
  (owner, _tid, mem : _) <- createTeam OwnDomain 2
  createScimTokenV6 owner def >>= assertSuccess
  createScimTokenV6 owner def >>= assertSuccess
  tokens <- bindResponse (getScimTokens owner) $ \resp -> do
    resp.status `shouldMatchInt` 200
    tokens <- resp.json %. "tokens" >>= asList
    for_ tokens $ \token -> do
      token %. "name" `shouldMatch` (token %. "id")
    pure tokens
  for_ tokens $ \token -> do
    tokenId <- token %. "id" >>= asString
    putScimTokenName mem tokenId "new name" >>= assertStatus 403
    putScimTokenName owner tokenId ("token:" <> tokenId) >>= assertSuccess
  bindResponse (getScimTokens owner) $ \resp -> do
    resp.status `shouldMatchInt` 200
    updatedTokens <- resp.json %. "tokens" >>= asList
    for_ updatedTokens $ \token -> do
      tokenId <- token %. "id" >>= asString
      token %. "name" `shouldMatch` ("token:" <> tokenId)

-- | in V6, create idp then scim without idp id and idp id is unique
testSparCreateScimTokenAssocImplicitly :: (HasCallStack) => App ()
testSparCreateScimTokenAssocImplicitly = do
  (owner, tid, _) <- createTeam OwnDomain 1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  samlIdpId <- bindResponse (registerTestIdPWithMeta owner) $ \resp -> do
    resp.status `shouldMatchInt` 201
    resp.json %. "id"
  bindResponse (createScimTokenV6 owner def) $ \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "info.idp" `shouldMatch` samlIdpId
  bindResponse (getAllIdPs owner tid) $ \resp -> do
    resp.status `shouldMatchInt` 200
    idp <- resp.json %. "providers" >>= asList >>= assertOne
    idp %. "id" `shouldMatch` samlIdpId

-- | in V6, name should be ignored
testSparCreateScimTokenWithName :: (HasCallStack) => App ()
testSparCreateScimTokenWithName = do
  (owner, _tid, _) <- createTeam OwnDomain 1
  let notExpected = "my scim token"
  createScimTokenV6 owner (def {name = Just notExpected}) >>= assertSuccess
  token <- getScimTokens owner >>= getJSON 200 >>= (%. "tokens") >>= asList >>= assertOne
  assoc <- token %. "id"
  token %. "name" `shouldMatch` Just assoc

----------------------------------------------------------------------
-- scim group stuff

testSparScimCreateGetSearchUserGroup :: (HasCallStack) => App ()
testSparScimCreateGetSearchUserGroup = do
  (owner, tid, _) <- createTeam OwnDomain 1
  tok <- createScimTokenV6 owner def >>= \resp -> resp.json %. "token" >>= asString
  assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" "disabled"
  assertSuccess =<< setTeamFeatureStatus owner tid "sso" "enabled"

  assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" "disabled"
  assertSuccess =<< setTeamFeatureStatus owner tid "sso" "enabled"
  void $ registerTestIdPWithMetaWithPrivateCreds owner
  let mkMemberCandidate :: App String
      mkMemberCandidate = do
        scimUserEmail <- randomEmail
        scimUser <- randomScimUserWith def {mkExternalId = pure scimUserEmail}
        uid <- createScimUser owner tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
        quid <- do
          dom <- make OwnDomain >>= asString
          pure $ object ["domain" .= dom, "id" .= uid]

        getScimUser OwnDomain tok uid `bindResponse` \res -> do
          res.status `shouldMatchInt` 200
          res.json %. "id" `shouldMatch` uid

        registerInvitedUser OwnDomain tid scimUserEmail

        getSelf quid `bindResponse` \res -> do
          res.status `shouldMatchInt` 200
          res.json %. "id" `shouldMatch` uid
          res.json %. "team" `shouldMatch` tid
          res.json %. "status" `shouldMatch` "active"
          res.json %. "managed_by" `shouldMatch` "scim"

        pure uid

  scimUserId <- mkMemberCandidate
  scimUserId2 <- mkMemberCandidate
  scimUserId3 <- mkMemberCandidate

  respGroup1 <- createScimUserGroup OwnDomain tok $ mkScimGroup "a group" [mkScimUser scimUserId, mkScimUser scimUserId2]
  respGroup2 <- createScimUserGroup OwnDomain tok $ mkScimGroup "another group" [mkScimUser scimUserId, mkScimUser scimUserId2]
  respGroup3 <- createScimUserGroup OwnDomain tok $ mkScimGroup "yet another group" [mkScimUser scimUserId2, mkScimUser scimUserId3]

  let createdGroup1 = respGroup1.json
      createdGroup2 = respGroup2.json
      createdGroup3 = respGroup3.json

  -- Test getting a single SCIM group by id
  gid <- respGroup1.json %. "id" & asString
  gottenGroup1 <- getScimUserGroup OwnDomain tok gid
  do
    expected <- normalizeValue respGroup1.json
    actual <- normalizeValue gottenGroup1.json
    expected `shouldMatch` actual

  -- Test filter (get in bulk) SCIM groups
  -- 1. Match "group", results in finding all three groups created above.
  filterScimUserGroup OwnDomain tok (Just "displayName co \"group\"") `bindResponse` \allThreeResp -> do
    resources <- (allThreeResp.json %. "Resources" & asList) >>= mapM normalizeValue
    expected <- mapM normalizeValue [createdGroup1, createdGroup2, createdGroup3]
    resources `shouldMatchSet` expected

  -- 2. Match "another group", results in finding "another group" and "yet another group".
  filterScimUserGroup OwnDomain tok (Just "displayName co \"another group\"") `bindResponse` \justTwo -> do
    resources <- (justTwo.json %. "Resources" & asList) >>= mapM normalizeValue
    expected <- mapM normalizeValue [createdGroup2, createdGroup3]
    resources `shouldMatchSet` expected

  -- 3. Empty groups should have empty member list.
  respGroup4 <- createScimUserGroup OwnDomain tok $ mkScimGroup "empty group" []
  filterScimUserGroup OwnDomain tok (Just "displayName co \"empty group\"") `bindResponse` \foundResults -> do
    singleEmptyGroup <- foundResults.json %. "Resources" >>= asList >>= assertOne
    (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
  void $ putSelf alice def {name = Just "alice"}
  tok <- createScimToken alice def >>= getJSON 200 >>= (%. "token") >>= asString
  assertSuccess =<< setTeamFeatureStatus alice tid "validateSAMLemails" "disabled"
  assertSuccess =<< setTeamFeatureStatus alice tid "sso" "enabled"

  let mkMemberCandidate :: String -> App String
      mkMemberCandidate displayName = do
        scimUserEmail <- randomEmail
        scimUser <- randomScimUserWith def {mkExternalId = pure scimUserEmail}
        scimUserNamed <- setField "displayName" displayName scimUser
        uid <- createScimUser alice tok scimUserNamed >>= getJSON 201 >>= (%. "id") >>= asString
        registerInvitedUser OwnDomain tid scimUserEmail
        pure uid

  bobId <- mkMemberCandidate "bob"
  charlieId <- mkMemberCandidate "charlie"
  dianaId <- mkMemberCandidate "diana"

  let scimUserGroup =
        object
          [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:Group"],
            "displayName" .= "My funky group",
            "members"
              .= [ object
                     [ "value" .= bobId,
                       "type" .= "User",
                       "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> bobId)
                     ],
                   object
                     [ "value" .= charlieId,
                       "type" .= "User",
                       "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> charlieId)
                     ]
                 ]
          ]
  gid <- createScimUserGroup OwnDomain tok scimUserGroup >>= getJSON 201 >>= (%. "id") >>= asString
  let scimUserGroupUpdated =
        object
          [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:Group"],
            "displayName" .= "My even funkier group",
            "members"
              .= [ object
                     [ "value" .= charlieId,
                       "type" .= "User",
                       "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> charlieId)
                     ],
                   object
                     [ "value" .= dianaId,
                       "type" .= "User",
                       "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> dianaId)
                     ]
                 ]
          ]
  -- run this twice to check for idempotency
  replicateM_ 2 $ do
    updateScimUserGroup OwnDomain tok gid scimUserGroupUpdated `bindResponse` \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "displayName" `shouldMatch` "My even funkier group"
      let expectedMembers = [charlieId, dianaId]
      actualMembers <- resp.json %. "members" >>= asList >>= mapM ((%. "value") >=> asString)
      actualMembers `shouldMatchSet` expectedMembers
      resp.json %. "id" `shouldMatch` gid
      resp.json %. "schemas" `shouldMatch` (toJSON ["urn:ietf:params:scim:schemas:core:2.0:Group"])
      (isJust <$> lookupField resp.json "meta") `shouldMatch` True
    getScimUserGroup OwnDomain tok gid `bindResponse` \resp -> do
      resp.json %. "displayName" `shouldMatch` "My even funkier group"
      memberValues <- (resp.json %. "members") >>= asListOf (\m -> m %. "value" >>= asString)
      memberValues `shouldMatchSet` [charlieId, dianaId]

-- | Normalize on `Value` level
--
-- Recursively sorts all JSON arrays. This produces a canonical form, where the
-- initial order of elements doesn't matter. Only use this function when that's
-- desired (i.e. there is no value in the order of elements).
normalizeValue :: (MakesValue a) => a -> App A.Value
normalizeValue a = normalizeValueArrays <$> make a
  where
    normalizeValueArrays :: A.Value -> A.Value
    normalizeValueArrays (A.Object o) = A.Object (normalizeValueArrays <$> o)
    normalizeValueArrays (A.Array arr) =
      A.Array . V.fromList . sort $ V.toList (normalizeValueArrays <$> arr)
    normalizeValueArrays v = v

testSparScimUpdateUserGroupRejectsInvalidMembers :: (HasCallStack) => App ()
testSparScimUpdateUserGroupRejectsInvalidMembers = do
  (alice, tid1, []) <- createTeam OwnDomain 1
  void $ setTeamFeatureStatus alice tid1 "sso" "enabled"
  tok1 <- createScimToken alice def >>= getJSON 200 >>= (%. "token") >>= asString

  -- one valid SCIM-managed member in team 1
  let mkTeam1Member name = do
        email <- randomEmail
        su <- randomScimUserWith def {mkExternalId = pure email} >>= setField "displayName" name
        uid <- createScimUser OwnDomain tok1 su >>= getJSON 201 >>= (%. "id") >>= asString
        registerInvitedUser OwnDomain tid1 email
        pure uid
  validId <- mkTeam1Member "charlie"

  -- create the group with one valid member
  let groupBody =
        object
          [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:Group"],
            "displayName" .= "Test Group",
            "members" .= [object ["value" .= validId, "type" .= "User", "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> validId)]]
          ]
  gid <- createScimUserGroup OwnDomain tok1 groupBody >>= getJSON 201 >>= (%. "id") >>= asString

  -- Case 1: user is in team but not managed by SCIM (the owner)
  ownerId <- alice %. "id" >>= asString
  let updateWithNonScim =
        object
          [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:Group"],
            "displayName" .= "Test Group",
            "members"
              .= [ object ["value" .= validId, "type" .= "User", "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> validId)],
                   object ["value" .= ownerId, "type" .= "User", "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> ownerId)]
                 ]
          ]
  bindResponse (updateScimUserGroup OwnDomain tok1 gid updateWithNonScim) $ \resp -> do
    resp.status `shouldMatchInt` 400

  -- Case 2: user is SCIM-managed but not in the team (create in a second team)
  otherId <- do
    (bob, tid2, []) <- createTeam OwnDomain 1
    void $ setTeamFeatureStatus bob tid2 "sso" "enabled"
    tok2 <- createScimToken bob def >>= getJSON 200 >>= (%. "token") >>= asString
    email <- randomEmail
    su <- randomScimUserWith def {mkExternalId = pure email} >>= setField "displayName" "diana"
    uid <- createScimUser OwnDomain tok2 su >>= getJSON 201 >>= (%. "id") >>= asString
    registerInvitedUser OwnDomain tid2 email
    pure uid

  let updateWithOtherTeamMember =
        object
          [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:Group"],
            "displayName" .= "Test Group",
            "members"
              .= [ object ["value" .= validId, "type" .= "User", "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> validId)],
                   object ["value" .= otherId, "type" .= "User", "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> otherId)]
                 ]
          ]
  bindResponse (updateScimUserGroup OwnDomain tok1 gid updateWithOtherTeamMember) $ \resp -> do
    resp.status `shouldMatchInt` 400

  -- Case 3: user does not exist
  nonExistingId <- randomId
  let updateNonExisting =
        object
          [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:Group"],
            "displayName" .= "Test Group",
            "members"
              .= [ object ["value" .= validId, "type" .= "User", "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> validId)],
                   object ["value" .= nonExistingId, "type" .= "User", "$ref" .= ("http://example.com:8088/scim/v2/Users/" <> nonExistingId)]
                 ]
          ]
  bindResponse (updateScimUserGroup OwnDomain tok1 gid updateNonExisting) $ \resp -> do
    resp.status `shouldMatchInt` 404

testSparScimDeleteUserGroup :: (HasCallStack) => App ()
testSparScimDeleteUserGroup = do
  (owner, tid, _) <- createTeam OwnDomain 1
  tok <- createScimTokenV6 owner def >>= \resp -> resp.json %. "token" >>= asString

  assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" "disabled"
  assertSuccess =<< setTeamFeatureStatus owner tid "sso" "enabled"
  void $ registerTestIdPWithMetaWithPrivateCreds owner
  let mkMemberCandidate :: App String
      mkMemberCandidate = do
        scimUserEmail <- randomEmail
        scimUser <- randomScimUserWith def {mkExternalId = pure scimUserEmail}
        uid <- createScimUser owner tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
        void $ make OwnDomain

        getScimUser OwnDomain tok uid `bindResponse` \res -> do
          res.status `shouldMatchInt` 200

        registerInvitedUser OwnDomain tid scimUserEmail

        pure uid

  scimUserId <- mkMemberCandidate
  let scimUserGroup =
        object
          [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:Group"],
            "displayName" .= "ze groop",
            "members"
              .= [ object
                     [ "type" .= "User",
                       "$ref" .= "...", -- something like
                       -- "https://example.org/v2/scim/User/ea2e4bf0-aa5e-11f0-96ad-e776a606779b"?
                       -- but since we're just receiving this it's ok
                       -- to ignore.
                       "value" .= scimUserId
                     ]
                 ]
          ]
  gid <- createScimUserGroup OwnDomain tok scimUserGroup >>= getJSON 201 >>= (%. "id") >>= asString
  deleteScimUserGroup OwnDomain tok gid >>= assertSuccess
  getScimUserGroup OwnDomain tok gid `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 404

testSparScimGroupSearchOnlyReturnsScimGroups :: (HasCallStack) => App ()
testSparScimGroupSearchOnlyReturnsScimGroups = do
  (owner, tid, [regularMember]) <- createTeam OwnDomain 2
  tok <- createScimTokenV6 owner def >>= \resp -> resp.json %. "token" >>= asString

  assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" "disabled"
  assertSuccess =<< setTeamFeatureStatus owner tid "sso" "enabled"
  void $ registerTestIdPWithMetaWithPrivateCreds owner

  let mkScimMemberCandidate :: App String
      mkScimMemberCandidate = do
        scimUserEmail <- randomEmail
        scimUser <- randomScimUserWith def {mkExternalId = pure scimUserEmail}
        uid <- createScimUser owner tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
        registerInvitedUser OwnDomain tid scimUserEmail
        pure uid

  scimUserId <- mkScimMemberCandidate

  -- Create a wire-managed group using the regular team member
  regularMemberId <- regularMember %. "id" >>= asString
  let wireGroupPayload =
        object
          [ "name" .= "wire-managed-group",
            "members" .= [regularMemberId]
          ]
  wireGroupResp <- createUserGroup owner wireGroupPayload
  wireGroupResp.status `shouldMatchInt` 200
  wireGroupId <- wireGroupResp.json %. "id" >>= asString

  -- Verify the wire-managed group was created with managedBy = "wire"
  wireGroupGet <- getUserGroup owner wireGroupId
  wireGroupGet.status `shouldMatchInt` 200
  wireGroupGet.json %. "managedBy" `shouldMatch` "wire"

  -- Create a SCIM-managed group using the SCIM user
  scimGroupResp <- createScimUserGroup OwnDomain tok $ mkScimGroup "scim-managed-group" [mkScimUser scimUserId]
  scimGroupResp.status `shouldMatchInt` 201
  scimGroupId <- scimGroupResp.json %. "id" >>= asString

  -- Call the SCIM groups search endpoint (without filter)
  filterScimUserGroup OwnDomain tok Nothing `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 200
    resources <- resp.json %. "Resources" >>= asList
    resourceIds <- for resources $ \g -> g %. "id" >>= asString

    -- Assert: Only the SCIM-managed group should be returned, not the wire-managed group
    resourceIds `shouldMatch` [scimGroupId]

----------------------------------------------------------------------
-- saml stuff

-- | In this test, the IdP attempts an IdP-initiated login, and the client gets redirected
-- back to IdP from SP with a valid authentication request.  This is to make some hypothetical
-- attacks harder while still supporting login dashboards in IdP UIs.
testSparEmulateSPInitiatedLogin :: (HasCallStack) => App ()
testSparEmulateSPInitiatedLogin = do
  -- set up saml-not-scim team
  (owner, tid, []) <- createTeam OwnDomain 1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (createIdpResp, (_idpmeta, privcreds)) <- registerTestIdPWithMetaWithPrivateCreds owner
  assertSuccess createIdpResp

  -- craft authnresp without req
  idpValue <- withResponse createIdpResp $ \r ->
    assertJust "Response has no JSON body" r.json
  let idp :: SAML.IdPConfig Value
      idp = either error id $ A.parseEither (A.parseJSON @(SAML.IdPConfig A.Value)) idpValue
  authnresp <- getAuthnResponse tid idp privcreds

  -- send to finalize and check redirect response
  finalizeSamlLogin OwnDomain tid authnresp `bindResponse` \resp -> do
    -- the 303 is followed immediately, so the response is already coming from
    -- /sso/initiate-login here.
    resp.status `shouldMatchInt` 200
    (cs resp.body) `shouldContain` "SAMLRequest"

-- | The backend accepts an IdP descriptor whose signing cert is already
-- expired, both at config-import time (POST /identity-providers) and at
-- AuthnResponse verification time (POST /sso/finalize-login).
--
-- This was probably built this way to not force team admins to reconfigure
-- IdPs over and over again (and if they forget, having angry users who cannot
-- login).
testSparExpiredIdpCertStillWorks :: (HasCallStack) => App ()
testSparExpiredIdpCertStillWorks = do
  (owner, tid, _) <- createTeam OwnDomain 1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"

  (idpMeta, privcreds) <- makeSampleIdPMetadataExpired

  createResp <- createIdp owner idpMeta
  assertSuccess createResp
  idpId <- asString =<< (createResp.json %. "id")

  subject <- nextSubject
  (mUid, _authnResponse) <- loginWithSaml True tid subject (idpId, (idpMeta, privcreds))
  void $ assertJust "expected zuid cookie to carry any user id" mUid
  where
    makeSampleIdPMetadataExpired :: App (SAML.IdPMetadata, SAML.SignPrivCreds)
    makeSampleIdPMetadataExpired = do
      now <- liftIO Hourglass.dateCurrent
      let validSince = now `addHours` (-48)
          validUntil = now `addHours` (-24)
      issuer <- SAML.makeIssuer
      uuid <- liftIO nextRandom
      requri <-
        either (error . show) pure
          $ SAML.parseURI' @(Either String) (ST.pack ("https://requri.net/" <> UUID.toString uuid))
      (privcreds, _signcreds, expiredCert) <-
        liftIO $ SAML.mkSignCredsWithCertWithLifespan validSince validUntil 96
      let meta = SAML.IdPMetadata issuer requri (NonEmpty.singleton expiredCert)
      pure (meta, privcreds)

    addHours :: Hourglass.DateTime -> Hourglass.Hours -> Hourglass.DateTime
    addHours t h =
      t
        `Hourglass.timeAdd` mempty
          { Hourglass.durationHours = h
          }

-- | UTF-8 chars (non-Latin-1) caused issues in XML parsing.
testSparSPInitiatedLoginWithUtf8 :: (HasCallStack) => App ()
testSparSPInitiatedLoginWithUtf8 = do
  -- set up saml-not-scim team
  (owner, tid, []) <- createTeam OwnDomain 1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (createIdpResp, (idpMeta, privcreds)) <- registerTestIdPWithMetaWithPrivateCreds owner
  assertSuccess createIdpResp

  -- gather info about idp and account
  idpValue <- withResponse createIdpResp $ \r ->
    assertJust "Response has no JSON body" r.json
  randomness <- randomId
  let idp :: SAML.IdPConfig (Value {- not needed -})
      idp = either error id $ A.parseEither (A.parseJSON @(SAML.IdPConfig A.Value)) idpValue

      userName = "klăusﭲﭳﭴﭵﭶﭷﭸﭹﭺﭻﭼﭽﭾﭿㄖㄗㄘ✈✉♊ႩႪงจฉชซὨὩἈἉἊἋἌἍἎἏຜຝڈډڊڋ" ++ randomness
      Right (subject :: SAML.NameID) =
        SAML.mkNameID
          ((SAML.mkUNameIDUnspecified . ST.pack) userName)
          Nothing
          Nothing
          Nothing

  idpIdString <- asString $ idp ^. SAML.idpId

  -- login
  (Just uidString, _) <- loginWithSaml True tid subject (idpIdString, (idpMeta, privcreds))
  ownDomain <- objDomain OwnDomain
  Brig.getSelf' ownDomain uidString `bindResponse` \resp -> do
    resp.json %. "name" `shouldMatch` userName

-- | in V6, create two idps then one scim should fail
testSparCreateTwoScimTokensForOneIdp :: (HasCallStack) => App ()
testSparCreateTwoScimTokensForOneIdp = do
  (owner, tid, _) <- createTeam OwnDomain 1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  registerTestIdPWithMeta owner >>= assertSuccess
  registerTestIdPWithMeta owner >>= assertSuccess
  createScimTokenV6 owner def >>= assertStatus 400
  tokens <- getScimTokens owner >>= getJSON 200 >>= (%. "tokens") >>= asList
  length tokens `shouldMatchInt` 0

testCheckAdminGetTeamId :: (HasCallStack) => App ()
testCheckAdminGetTeamId = do
  (owner :: Value, tid :: String, [regular] :: [Value]) <- createTeam OwnDomain 2
  void $ setTeamFeatureStatus owner tid "sso" "enabled" -- required for the next request
  SAML.SampleIdP idpMeta _ _ _ <- SAML.makeSampleIdPMetadata
  createIdp owner idpMeta >>= assertSuccess -- Successful API response for owner (admin),
  createIdp regular idpMeta `bindResponse` \resp -> do
    -- insuficient permissions for non-admin, both as expected.
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "insufficient-permissions"

testCheckAdminGetTeamIdV7 :: App ()
testCheckAdminGetTeamIdV7 = withAPIVersion 7 testCheckAdminGetTeamId

testSsoLoginAndEmailVerification :: (HasCallStack) => App ()
testSsoLoginAndEmailVerification = do
  (owner, tid, _) <- createTeam OwnDomain 1
  emailDomain <- randomDomain

  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, idpMeta) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"

  let email = "user@" <> emailDomain
  void $ loginWithSamlEmail True tid email (idpId, idpMeta)
  activateEmail OwnDomain email
  getUsersByEmail OwnDomain [email] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

-- | This test may be covered by `testScimUpdateEmailAddress` and maybe can be removed.
testSsoLoginNoSamlEmailValidation :: (HasCallStack) => TaggedBool "requireExternalEmailVerification" -> App ()
testSsoLoginNoSamlEmailValidation (TaggedBool requireExternalEmailVerification) = do
  (owner, tid, _) <- createTeam OwnDomain 1
  emailDomain <- randomDomain

  let status = if requireExternalEmailVerification then "enabled" else "disabled"
  assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" status

  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, idpMeta) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"

  let email = "user@" <> emailDomain
  (Just uid, authnResp) <- loginWithSamlEmail True tid email (idpId, idpMeta)
  let parsed :: SAML.AuthnResponse =
        fromRight (error "invalid authnResponse")
          . SAMLXML.parseFromDocument
          . SAML.fromSignedAuthnResponse
          $ authnResp
      uref = either (error . show) id $ SAML.assertionsToUserRef (parsed ^. SAML.rspPayload)
      eid = CI.original $ uref ^. SAML.uidSubject . to SAML.unsafeShowNameID
  eid `shouldMatch` email

  when requireExternalEmailVerification $ do
    getUsersId OwnDomain [uid] `bindResponse` \res -> do
      res.status `shouldMatchInt` 200
      user <- res.json & asList >>= assertOne
      user %. "status" `shouldMatch` "active"
      lookupField user "email" `shouldMatch` (Nothing :: Maybe String)

    getUsersByEmail OwnDomain [email] `bindResponse` \res -> do
      res.status `shouldMatchInt` 200
      res.json & asList >>= shouldBeEmpty

    activateEmail OwnDomain email

  getUsersId OwnDomain [uid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

  getUsersByEmail OwnDomain [email] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

-- | create user with non-email externalId.  then use put to add an email address.
testScimUpdateEmailAddress :: (HasCallStack) => TaggedBool "extIdIsEmail" -> TaggedBool "requireExternalEmailVerification" -> App ()
testScimUpdateEmailAddress (TaggedBool extIdIsEmail) (TaggedBool requireExternalEmailVerification) = do
  (owner, tid, _) <- createTeam OwnDomain 1

  let status = if requireExternalEmailVerification then "enabled" else "disabled"
  assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" status

  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, _) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"
  tok <-
    createScimToken owner (def {idp = Just idpId}) `bindResponse` \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "token" >>= asString

  oldEmail <- randomEmail
  scimUser <-
    randomScimUserWith
      def
        { mkExternalId = if extIdIsEmail then pure oldEmail else randomUUIDString,
          prependExternalIdToEmails = False,
          mkOtherEmails = pure []
        }
  uid <- createScimUser owner tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString

  getScimUser OwnDomain tok uid `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "id" `shouldMatch` uid
    lookupField res.json "emails"
      `shouldMatch` ( if extIdIsEmail
                        then Just [object ["value" .= oldEmail]]
                        else Nothing
                    )

  newEmail <- randomEmail
  let newScimUser =
        let addEmailsField :: Value -> Value
            addEmailsField = \case
              Object o ->
                Object
                  ( KeyMap.insert
                      (fromString "emails")
                      (toJSON [object ["value" .= newEmail]])
                      o
                  )
         in addEmailsField scimUser

  updateScimUser OwnDomain tok uid newScimUser `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "emails" `shouldMatch` [object ["value" .= newEmail]]

  getScimUser OwnDomain tok uid `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "emails" `shouldMatch` [object ["value" .= newEmail]]

  when requireExternalEmailVerification $ do
    getUsersId OwnDomain [uid] `bindResponse` \res -> do
      res.status `shouldMatchInt` 200
      user <- res.json & asList >>= assertOne
      user %. "status" `shouldMatch` "active"
      lookupField user "email" `shouldMatch` (Nothing :: Maybe String)

    getUsersByEmail OwnDomain [newEmail] `bindResponse` \res -> do
      res.status `shouldMatchInt` 200
      res.json & asList >>= shouldBeEmpty

    activateEmail OwnDomain newEmail

  getUsersId OwnDomain [uid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail

  getUsersByEmail OwnDomain [newEmail] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail

-- | changing externalId and emails subsequently:
--
-- 1. create user with extid email;
-- 2. add email to emails field;
-- 3. change extId to uuid;
-- 4. change extId back to *other* email.
--
-- (may overlap with `testSsoLoginNoSamlEmailValidation`.)
testScimUpdateEmailAddressAndExternalId :: (HasCallStack) => App ()
testScimUpdateEmailAddressAndExternalId = do
  (owner, tid, _) <- createTeam OwnDomain 1

  let status = "disabled"
  assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" status

  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, _) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"
  tok <-
    createScimToken owner (def {idp = Just idpId}) `bindResponse` \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "token" >>= asString

  -- 1. create user with extid email
  extId1 <- randomEmail
  scimUser <-
    randomScimUserWith
      def
        { mkExternalId = pure extId1,
          prependExternalIdToEmails = False,
          mkOtherEmails = pure []
        }
  brigUserId <- createScimUser owner tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString

  getScimUser OwnDomain tok brigUserId `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "id" `shouldMatch` brigUserId
    res.json %. "emails" `shouldMatch` [object ["value" .= extId1]]

  findUsersByExternalId OwnDomain tok extId1 `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    (res.json %. "Resources") >>= asList >>= \[v] -> v %. "id" `shouldMatch` brigUserId

  -- 2. add email to emails field
  newEmail1 <- randomEmail
  let newScimUser1 =
        let addEmailsField :: Value -> Value
            addEmailsField = \case
              Object o ->
                Object
                  ( KeyMap.insert
                      (fromString "emails")
                      (toJSON [object ["value" .= newEmail1]])
                      o
                  )
         in addEmailsField scimUser

  updateScimUser OwnDomain tok brigUserId newScimUser1 `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "externalId" `shouldMatch` extId1
    res.json %. "emails" `shouldMatch` [object ["value" .= newEmail1]]

  getScimUser OwnDomain tok brigUserId `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "emails" `shouldMatch` [object ["value" .= newEmail1]]

  findUsersByExternalId OwnDomain tok extId1 `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    (res.json %. "Resources") >>= asList >>= \[v] -> v %. "id" `shouldMatch` brigUserId

  getUsersId OwnDomain [brigUserId] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

  getUsersByEmail OwnDomain [newEmail1] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

  -- 3. change extId to uuid
  newExtId2 <- randomUUIDString
  let newScimUser2 =
        let updExtIdField :: Value -> Value
            updExtIdField = \case
              Object o -> Object (KeyMap.insert (fromString "externalId") (toJSON newExtId2) o)
         in updExtIdField newScimUser1

  updateScimUser OwnDomain tok brigUserId newScimUser2 `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "externalId" `shouldMatch` newExtId2
    res.json %. "emails" `shouldMatch` [object ["value" .= newEmail1]]

  getScimUser OwnDomain tok brigUserId `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "emails" `shouldMatch` [object ["value" .= newEmail1]]

  findUsersByExternalId OwnDomain tok newExtId2 `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    (res.json %. "Resources") >>= asList >>= \[v] -> v %. "id" `shouldMatch` {- CRASH (list is empty) -} brigUserId

  getUsersId OwnDomain [brigUserId] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

  getUsersByEmail OwnDomain [newEmail1] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

  -- 4. change extId back to *other* email
  newEmail3 <- randomEmail
  let newScimUser3 =
        let updEmailExtId :: Value -> Value
            updEmailExtId = \case
              Object o -> Object (KeyMap.insert (fromString "externalId") (toJSON newEmail3) o)
         in updEmailExtId newScimUser2

  updateScimUser OwnDomain tok brigUserId newScimUser3 `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "externalId" `shouldMatch` newEmail3
    res.json %. "emails" `shouldMatch` [object ["value" .= newEmail1]]

  getScimUser OwnDomain tok brigUserId `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "emails" `shouldMatch` [object ["value" .= newEmail1]]

  findUsersByExternalId OwnDomain tok newEmail3 `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    (res.json %. "Resources") >>= asList >>= \[v] -> v %. "id" `shouldMatch` brigUserId

  getUsersId OwnDomain [brigUserId] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

  getUsersByEmail OwnDomain [newEmail1] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

testScimLoginNoSamlEmailValidation :: (HasCallStack) => TaggedBool "requireExternalEmailVerification" -> App ()
testScimLoginNoSamlEmailValidation (TaggedBool requireExternalEmailVerification) = do
  (owner, tid, _) <- createTeam OwnDomain 1

  let status = if requireExternalEmailVerification then "enabled" else "disabled"
  assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" status

  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, _) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"
  tok <-
    createScimToken owner (def {idp = Just idpId}) `bindResponse` \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "token" >>= asString

  scimUser <- randomScimUser
  email <- scimUser %. "emails" >>= asList >>= assertOne >>= (%. "value") >>= asString
  uid <- createScimUser owner tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString

  getScimUser OwnDomain tok uid `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json %. "id" `shouldMatch` uid

  when requireExternalEmailVerification $ do
    getUsersId OwnDomain [uid] `bindResponse` \res -> do
      res.status `shouldMatchInt` 200
      user <- res.json & asList >>= assertOne
      user %. "status" `shouldMatch` "active"
      lookupField user "email" `shouldMatch` (Nothing :: Maybe String)

    getUsersByEmail OwnDomain [email] `bindResponse` \res -> do
      res.status `shouldMatchInt` 200
      res.json & asList >>= shouldBeEmpty

    activateEmail OwnDomain email

  getUsersId OwnDomain [uid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

  getUsersByEmail OwnDomain [email] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

testIdpUpdate :: (HasCallStack) => App ()
testIdpUpdate = do
  (owner, tid, []) <- createTeam OwnDomain 1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  -- register an IdP
  idp@(idpId, (idpmeta, pCreds)) <- do
    (resp, meta) <- registerTestIdPWithMetaWithPrivateCreds owner
    (,meta) <$> asString (resp.json %. "id")
  -- create a SCIM token
  tok <-
    createScimToken owner (def {idp = Just idpId}) `bindResponse` \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "token" >>= asString
  -- create SCIM users
  uids <- replicateM 3 $ do
    scimUser <- randomScimUser
    email <- scimUser %. "emails" >>= asList >>= assertOne >>= (%. "value") >>= asString
    uid <- createScimUser owner tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
    void $ loginWithSamlEmail True tid email idp
    activateEmail OwnDomain email
    getScimUser OwnDomain tok uid `bindResponse` \res -> do
      res.status `shouldMatchInt` 200
      res.json %. "id" `shouldMatch` uid
    pure (uid, email)
  -- update the IdP
  idp2 <- do
    (resp, meta) <- updateTestIdpWithMetaWithPrivateCreds owner idpId
    (,meta) <$> asString (resp.json %. "id")
  -- the SCIM users can login
  for_ uids $ \(_, email) -> do
    void $ loginWithSamlEmail True tid email idp2
  -- update the IdP again and use the original metadata
  idp3 <- do
    resp <- updateIdp owner idpId idpmeta
    (,(idpmeta, pCreds)) <$> asString (resp.json %. "id")
  -- the SCIM users can still login
  for_ uids $ \(_, email) -> do
    void $ loginWithSamlEmail True tid email idp3

-- @SF.Provisioning @TSFI.RESTfulAPI @S2
--
-- Allow updates of E2EI enabled users only via SCIM
testAllowUpdatesBySCIMWhenE2EIdEnabled :: (HasCallStack) => TaggedBool "sso-enabled" -> App ()
testAllowUpdatesBySCIMWhenE2EIdEnabled (TaggedBool ssoEnabled) = do
  (tok, uid, su) <- if ssoEnabled then setupWithSSO else setupWithoutSSO
  user <- getUsersId OwnDomain [uid] >>= getJSON 200 >>= asList >>= assertOne

  checkUpdateHandleByUserFails user
  su1 <- checkUpdateHandleByScimSucceeds tok uid su
  checkUpdateDisplayNameByUserFails user
  su2 <- checkUpdateDisplayNameByScimSucceeds tok uid su1

  -- the following should not be part of the e2eid certification, but are checked here anyway
  checkUpdateLocaleByUserFails user
  su3 <- checkUpdateLocaleByScimSucceeds tok uid su2
  unless ssoEnabled $ checkUpdateEmailByUserFails user
  su4 <- checkUpdateEmailByScimSucceeds tok uid su3
  -- external ID cannot be updated by the user, only by SCIM
  void $ checkUpdateExternalIdByScimSucceeds tok uid su4
  where
    setupWithSSO :: App (String, String, Value)
    setupWithSSO = do
      (owner, tid, _) <- createTeam OwnDomain 1
      setTeamFeatureStatus owner tid "sso" "enabled" >>= assertSuccess
      setTeamFeatureStatus owner tid "mlsE2EId" "enabled" >>= assertSuccess
      void $ registerTestIdPWithMeta owner >>= getJSON 201
      tok <- createScimTokenV6 owner def >>= getJSON 200 >>= (%. "token") >>= asString
      scimUser <- randomScimUser
      email <- scimUser %. "emails" >>= asList >>= assertOne >>= (%. "value") >>= asString
      uid <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
      activateEmail OwnDomain email
      pure (tok, uid, scimUser)

    setupWithoutSSO :: App (String, String, Value)
    setupWithoutSSO = do
      (owner, tid, _) <- createTeam OwnDomain 1
      setTeamFeatureStatus owner tid "mlsE2EId" "enabled" >>= assertSuccess
      tok <- createScimTokenV6 owner def >>= getJSON 200 >>= (%. "token") >>= asString
      scimUser <- randomScimUser
      email <- scimUser %. "emails" >>= asList >>= assertOne >>= (%. "value") >>= asString
      uid <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
      registerInvitedUser OwnDomain tid email
      pure (tok, uid, scimUser)

    checkUpdateHandleByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateHandleByScimSucceeds tok uid scimUser = do
      newHandle <- randomHandle
      su <- setField "userName" newHandle scimUser
      bindResponse (updateScimUser OwnDomain tok uid su) $ \res -> do
        res.status `shouldMatchInt` 200
        res.json %. "userName" `shouldMatch` newHandle
      bindResponse (getUsersId OwnDomain [uid]) $ \res -> do
        res.status `shouldMatchInt` 200
        u <- res.json & asList >>= assertOne
        u %. "handle" `shouldMatch` newHandle
      pure su

    checkUpdateHandleByUserFails :: (HasCallStack, MakesValue user) => user -> App ()
    checkUpdateHandleByUserFails user = do
      putHandle user "new-handle" `bindResponse` \res -> do
        res.status `shouldMatchInt` 403
        res.json %. "label" `shouldMatch` "managed-by-scim"

    checkUpdateDisplayNameByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateDisplayNameByScimSucceeds tok uid scimUser = do
      let displayName = "Alice in Wonderland"
      su <- setField "displayName" displayName scimUser
      bindResponse (updateScimUser OwnDomain tok uid su) $ \res -> do
        res.status `shouldMatchInt` 200
        res.json %. "displayName" `shouldMatch` displayName
      bindResponse (getUsersId OwnDomain [uid]) $ \res -> do
        res.status `shouldMatchInt` 200
        u <- res.json & asList >>= assertOne
        u %. "name" `shouldMatch` displayName
      pure su

    checkUpdateDisplayNameByUserFails :: (HasCallStack, MakesValue user) => user -> App ()
    checkUpdateDisplayNameByUserFails user = do
      putSelf user def {name = Just "Bob the Builder"} `bindResponse` \res -> do
        res.status `shouldMatchInt` 403
        res.json %. "label" `shouldMatch` "managed-by-scim"

    checkUpdateLocaleByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateLocaleByScimSucceeds tok uid scimUser = do
      su <- setField "preferredLanguage" "fr" scimUser
      bindResponse (updateScimUser OwnDomain tok uid su) $ \res -> do
        res.status `shouldMatchInt` 200
        res.json %. "preferredLanguage" `shouldMatch` "fr"
      bindResponse (getUsersId OwnDomain [uid]) $ \res -> do
        res.status `shouldMatchInt` 200
        u <- res.json & asList >>= assertOne
        u %. "locale" `shouldMatch` "fr"
      pure su

    checkUpdateLocaleByUserFails :: (HasCallStack, MakesValue user) => user -> App ()
    checkUpdateLocaleByUserFails user = do
      putSelfLocale user "de" `bindResponse` \res -> do
        res.status `shouldMatchInt` 403
        res.json %. "label" `shouldMatch` "managed-by-scim"

    checkUpdateEmailByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateEmailByScimSucceeds tok uid scimUser = do
      newEmail <- randomEmail
      su <- setField "emails" [object ["value" .= newEmail]] scimUser
      bindResponse (updateScimUser OwnDomain tok uid su) $ \res -> do
        res.status `shouldMatchInt` 200
        res.json %. "emails" `shouldMatch` [object ["value" .= newEmail]]
      activateEmail OwnDomain newEmail
      bindResponse (getUsersId OwnDomain [uid]) $ \res -> do
        res.status `shouldMatchInt` 200
        u <- res.json & asList >>= assertOne
        u %. "email" `shouldMatch` newEmail
      pure su

    checkUpdateEmailByUserFails :: (HasCallStack, MakesValue user) => user -> App ()
    checkUpdateEmailByUserFails user = do
      email <- make user %. "email" >>= asString
      (cookie, token) <-
        login OwnDomain email defPassword `bindResponse` \resp -> do
          resp.status `shouldMatchInt` 200
          token <- resp.json %. "access_token" & asString
          let cookie = fromJust $ getCookie "zuid" resp
          pure ("zuid=" <> cookie, token)
      newEmail <- randomEmail
      updateEmail user newEmail cookie token `bindResponse` \res -> do
        res.status `shouldMatchInt` 403
        res.json %. "label" `shouldMatch` "managed-by-scim"

    checkUpdateExternalIdByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateExternalIdByScimSucceeds tok uid scimUser = do
      newExtId <- randomUUIDString
      su <- setField "externalId" newExtId scimUser
      bindResponse (updateScimUser OwnDomain tok uid su) $ \res -> do
        res.status `shouldMatchInt` 200
        res.json %. "externalId" `shouldMatch` newExtId
      bindResponse (getUsersId OwnDomain [uid]) $ \res -> do
        res.status `shouldMatchInt` 200
        u <- res.json & asList >>= assertOne
        subject <-
          if ssoEnabled
            then
              u %. "sso_id.subject" >>= asString
            else
              u %. "sso_id.scim_external_id" >>= asString
        subject `shouldContainString` newExtId
      pure su

-- @END

testNoPasswordResetForSAMLUser :: (HasCallStack) => App ()
testNoPasswordResetForSAMLUser = do
  (owner, tid, _) <- createTeam OwnDomain 1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  void $ setTeamFeatureStatus owner tid "validateSAMLemails" "enabled"
  (idp, _) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"
  tok <- createScimToken owner def {idp = Just idpId} >>= getJSON 200 >>= (%. "token") >>= asString
  scimUser <- randomScimUser
  email <- scimUser %. "emails" >>= asList >>= assertOne >>= (%. "value") >>= asString
  _uid <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
  activateEmail OwnDomain email
  -- login with password should fail
  Nginz.login OwnDomain email defPassword `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 403
  -- password reset returns 201 always to not leak any account information
  passwordReset OwnDomain email `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 201
  -- however no password reset code and key should be generated
  getPasswordResetCode OwnDomain email `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 400
    resp.json %. "label" `shouldMatch` "invalid-key"

testScimUserIsNotAllowedToChangeName :: (HasCallStack) => App ()
testScimUserIsNotAllowedToChangeName = do
  (owner, tid, _) <- createTeam OwnDomain 1
  tok <- createScimToken owner def >>= getJSON 200 >>= (%. "token") >>= asString
  scimUser <- randomScimUser
  email <- scimUser %. "emails" >>= asList >>= assertOne >>= (%. "value") >>= asString
  void $ createScimUser OwnDomain tok scimUser >>= assertSuccess
  registerInvitedUser OwnDomain tid email
  user <- getUsersByEmail OwnDomain [email] >>= getJSON 200 >>= asList >>= assertOne
  putHandle user "foo" `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "managed-by-scim"
  putSelf user def {name = Just "foo"} `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "managed-by-scim"

testScimUserIsNotAllowedToChangeNameOnRegistering :: (HasCallStack) => App ()
testScimUserIsNotAllowedToChangeNameOnRegistering = do
  (owner, tid, _) <- createTeam OwnDomain 1
  tok <- createScimToken owner def >>= getJSON 200 >>= (%. "token") >>= asString
  scimUser <- randomScimUser
  scimUserDisplayName <- scimUser %. "displayName"
  email <- scimUser %. "emails" >>= asList >>= assertOne >>= (%. "value") >>= asString
  scimUserId <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
  code <-
    getInvitationByEmail OwnDomain email
      >>= getJSON 200
      >>= getInvitationCodeForTeam OwnDomain tid
      >>= getJSON 200
      >>= (%. "code")
      >>= asString
  getInvitationByCode OwnDomain code `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "id" `shouldMatch` scimUserId
    resp.json %. "managed_by" `shouldMatch` "scim"
    resp.json %. "name" `shouldMatch` scimUserDisplayName

  let newProfilename = "Takemiya Masaki"
  registerUserWith OwnDomain email code newProfilename `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "managed-by-scim"

testScimUserChangeNameOnRegisteringIgnoredV16 :: (HasCallStack) => App ()
testScimUserChangeNameOnRegisteringIgnoredV16 = do
  (owner, tid, _) <- createTeam OwnDomain 1
  tok <- createScimToken owner def >>= getJSON 200 >>= (%. "token") >>= asString
  scimUser <- randomScimUser
  scimUserDisplayName <- scimUser %. "displayName"
  email <- scimUser %. "emails" >>= asList >>= assertOne >>= (%. "value") >>= asString
  scimUserId <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
  code <-
    getInvitationByEmail OwnDomain email
      >>= getJSON 200
      >>= getInvitationCodeForTeam OwnDomain tid
      >>= getJSON 200
      >>= (%. "code")
      >>= asString
  getInvitationByCode OwnDomain code `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "id" `shouldMatch` scimUserId
    resp.json %. "managed_by" `shouldMatch` "scim"
    resp.json %. "name" `shouldMatch` scimUserDisplayName

  let newProfilename = "Takemiya Masaki"
  registerUserWithVersioned (ExplicitVersion 16) OwnDomain email code newProfilename `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 201
    resp.json %. "name" `shouldMatch` scimUserDisplayName

-- | A pending email update (emailUnvalidated + activation code) must be
-- invalidated when the user transitions to SCIM control.  Getting a Wire-managed
-- user via the SCIM API triggers 'getUserById' -> 'synthesizeStoredUser' ->
-- 'ManagedByScim' -> 'deletePendingEmailUpdate' in spar, which calls the brig
-- internal endpoint that deletes both the activation code and the pending
-- email entry.  See WPB-21744 / PR #5333.
testSparScimInvalidatesPendingEmail :: (HasCallStack) => App ()
testSparScimInvalidatesPendingEmail = do
  -- 1. Create a team with an owner and one Wire-managed member.
  (owner, _tid, [mem]) <- createTeam OwnDomain 2
  memberId <- mem %. "id" >>= asString
  memberEmail <- mem %. "email" >>= asString

  -- 2. Login as the member and initiate an email update.  This creates a
  --    pending emailUnvalidated entry plus an activation code for the new email.
  (cookie, token) <-
    login mem memberEmail defPassword `bindResponse` \resp -> do
      resp.status `shouldMatchInt` 200
      tok <- resp.json %. "access_token" & asString
      let c = fromJust $ getCookie "zuid" resp
      pure ("zuid=" <> c, tok)
  newEmail <- randomEmail
  updateEmail mem newEmail cookie token >>= assertSuccess

  -- 3. Verify the activation code exists for the pending (unvalidated) email.
  getActivationCode OwnDomain newEmail >>= assertStatus 200

  -- 4. Transition the member to SCIM control.  Reading the user through the
  --    SCIM API triggers getUserById -> synthesizeStoredUser -> (since the user
  --    is email-only and not yet SCIM-managed) setManagedBy ManagedByScim and
  --    deletePendingEmailUpdate.
  tok <- createScimTokenV6 owner def >>= getJSON 200 >>= (%. "token") >>= asString
  getScimUser OwnDomain tok memberId >>= assertStatus 200

  -- 5. The activation code for the pending email has been invalidated.
  getActivationCode OwnDomain newEmail >>= assertStatus 404

  -- 6. The member's email is unchanged: the SCIM transition must not promote
  --    the unvalidated email, only drop the pending update.
  bindResponse (getUsersId OwnDomain [memberId]) $ \resp -> do
    resp.status `shouldMatchInt` 200
    u <- resp.json & asList >>= assertOne
    u %. "email" `shouldMatch` memberEmail
