{-# 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 API.Spar
import API.SparInternal
import Control.Concurrent (threadDelay)
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 Data.String.Conversions (cs)
import qualified Data.Text as ST
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.JSON
import Testlib.PTest
import Testlib.Prelude

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

testSparUserCreationInvitationTimeout :: (HasCallStack) => App ()
testSparUserCreationInvitationTimeout :: HasCallStack => App ()
testSparUserCreationInvitationTimeout = do
  (owner, _tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  tok <- createScimTokenV6 owner def >>= \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  scimUser <- randomScimUser
  bindResponse (createScimUser OwnDomain tok scimUser) $ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

  -- Trying to create the same user again right away should fail
  bindResponse (createScimUser OwnDomain tok scimUser) $ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409

  -- However, if we wait until the invitation timeout has passed
  -- It's currently configured to 1s local/CI.
  liftIO $ threadDelay (2_000_000)

  -- ...we should be able to create the user again
  retryT $ bindResponse (createScimUser OwnDomain tok scimUser) $ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

testSparExternalIdDifferentFromEmailWithIdp :: (HasCallStack) => App ()
testSparExternalIdDifferentFromEmailWithIdp :: HasCallStack => App ()
testSparExternalIdDifferentFromEmailWithIdp = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
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 $ \Value
u -> do
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
extId
    (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
  bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"userName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
    checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \Value
u -> do
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
extId
      (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
    bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newExtId
    checkSparGetUserAndFindByExtId OwnDomain tok newExtId userId $ \Value
u -> do
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newExtId
      (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
    bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
      u %. "email" `shouldMatch` email
      subject <- u %. "sso_id.subject" >>= asString
      subject `shouldContainString` newExtId
    bindResponse (findUsersByExternalId OwnDomain tok extId) $ \Response
res -> do
      Response
res.json App 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
0
      Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Resources" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])
    pure updatedScimUser

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

    -- before activation the old email should still be present
    checkSparGetUserAndFindByExtId OwnDomain tok currentExtId userId $ \Value
u -> do
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
currentExtId
      (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
    bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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 $ \Value
u -> do
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
currentExtId
      (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
    bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
      u %. "email" `shouldMatch` newEmail
      subject <- u %. "sso_id.subject" >>= asString
      subject `shouldContainString` currentExtId

testSparExternalIdDifferentFromEmail :: (HasCallStack) => App ()
testSparExternalIdDifferentFromEmail :: HasCallStack => App ()
testSparExternalIdDifferentFromEmail = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  tok <- createScimTokenV6 owner def >>= \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  email <- randomEmail
  extId <- randomExternalId
  scimUser <- randomScimUserWithEmail extId email
  userId <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString

  checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \Value
u -> do
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
extId
    (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
  bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty

  registerInvitedUser OwnDomain tid email

  checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \Value
u -> do
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
extId
    (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
  bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"userName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
    checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \Value
u -> do
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
extId
      (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
    bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newExtId
    checkSparGetUserAndFindByExtId OwnDomain tok newExtId userId $ \Value
u -> do
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newExtId
      (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
    bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
      u %. "email" `shouldMatch` email
      u %. "sso_id.scim_external_id" `shouldMatch` newExtId
    bindResponse (findUsersByExternalId OwnDomain tok extId) $ \Response
res -> do
      Response
res.json App 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
0
      Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Resources" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] :: [Value])
    pure updatedScimUser

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

    -- before activation the new email should be returned by the SCIM API
    checkSparGetUserAndFindByExtId OwnDomain tok currentExtId userId $ \Value
u -> do
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
currentExtId
      (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
    -- however brig should still return the old email
    bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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 $ \Value
u -> do
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
currentExtId
      (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
    bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
      u %. "email" `shouldMatch` newEmail
      u %. "sso_id.scim_external_id" `shouldMatch` currentExtId

testSparExternalIdUpdateToANonEmail :: (HasCallStack) => App ()
testSparExternalIdUpdateToANonEmail :: HasCallStack => App ()
testSparExternalIdUpdateToANonEmail = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  tok <- createScimTokenV6 owner def >>= \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  scimUser <- randomScimUser >>= removeField "emails"
  email <- scimUser %. "externalId" >>= asString
  userId <- bindResponse (createScimUser OwnDomain tok scimUser) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
    (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value") App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString) App String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  registerInvitedUser OwnDomain tid email

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

testSparMigrateFromExternalIdOnlyToEmail :: (HasCallStack) => Tagged "mailUnchanged" Bool -> App ()
testSparMigrateFromExternalIdOnlyToEmail :: HasCallStack => Tagged "mailUnchanged" Bool -> App ()
testSparMigrateFromExternalIdOnlyToEmail (MkTagged Bool
emailUnchanged) = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  tok <- createScimTokenV6 owner def >>= \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
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) $ \Response
resp -> do
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([Value] -> Value
forall a. ToJSON a => a -> Value
toJSON [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
email]])
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  newEmail <- if emailUnchanged then pure email else randomEmail
  let newEmails = ([Value] -> Value
forall a. ToJSON a => a -> Value
toJSON [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail]])
  updatedScimUser <- setField "emails" newEmails scimUser
  updateScimUser OwnDomain tok userId updatedScimUser `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
updatedScimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId")
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
updatedScimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails")

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

  extId <- scimUser %. "externalId" >>= asString
  checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \Value
u -> do
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
extId
    (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value")) App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
  bindResponse (getUsersId OwnDomain [userId]) $ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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 :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId domain
domain String
tok String
extId String
uid Value -> App ()
k = do
  usersByExtIdResp <- domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
findUsersByExternalId domain
domain String
tok String
extId
  usersByExtIdResp.status `shouldMatchInt` 200
  userByIdExtId <- usersByExtIdResp.json %. "Resources" >>= asList >>= assertOne
  k userByIdExtId

  userByUidResp <- getScimUser domain tok uid
  userByUidResp.status `shouldMatchInt` 200
  userByUid <- userByUidResp.json
  k userByUid

  userByUid `shouldMatch` userByIdExtId

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

testSparCreateScimTokenNoName :: (HasCallStack) => App ()
testSparCreateScimTokenNoName :: HasCallStack => App ()
testSparCreateScimTokenNoName = do
  (owner, _tid, mem : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  createScimTokenV6 owner def >>= assertSuccess
  createScimTokenV6 owner def >>= assertSuccess
  tokens <- bindResponse (getScimTokens owner) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    tokens <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"tokens" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    for_ tokens $ \Value
token -> do
      Value
token Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
token Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
    pure tokens
  for_ tokens $ \Value
token -> do
    tokenId <- Value
token Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
    putScimTokenName mem tokenId "new name" >>= assertStatus 403
    putScimTokenName owner tokenId ("token:" <> tokenId) >>= assertSuccess
  bindResponse (getScimTokens owner) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    updatedTokens <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"tokens" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    for_ updatedTokens $ \Value
token -> do
      tokenId <- Value
token Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      token %. "name" `shouldMatch` ("token:" <> tokenId)

-- | in V6, create idp then scim without idp id and idp id is unique
testSparCreateScimTokenAssocImplicitly :: (HasCallStack) => App ()
testSparCreateScimTokenAssocImplicitly :: HasCallStack => App ()
testSparCreateScimTokenAssocImplicitly = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  samlIdpId <- bindResponse (registerTestIdPWithMeta owner) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  bindResponse (createScimTokenV6 owner def) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"info.idp" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
samlIdpId
  bindResponse (getAllIdPs owner tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    idp <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"providers" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    idp %. "id" `shouldMatch` samlIdpId

-- | in V6, name should be ignored
testSparCreateScimTokenWithName :: (HasCallStack) => App ()
testSparCreateScimTokenWithName :: HasCallStack => App ()
testSparCreateScimTokenWithName = do
  (owner, _tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  let notExpected = String
"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 :: HasCallStack => App ()
testSparScimCreateGetSearchUserGroup = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  tok <- createScimTokenV6 owner def >>= \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
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 <- App String
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` \Response
res -> do
          Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
uid

        registerInvitedUser OwnDomain tid scimUserEmail

        getSelf quid `bindResponse` \Response
res -> do
          Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
uid
          Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
          Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"active"
          Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"managed_by" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"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]

  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
  respGroup1.json `shouldMatch` gottenGroup1.json

  -- 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` \Response
allThreeResp ->
    (Response
allThreeResp.json App 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) App [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value
createdGroup1, Value
createdGroup2, Value
createdGroup3]

  -- 2. Match "another group", results in finding "another group" and "yet another group".
  filterScimUserGroup OwnDomain tok (Just "displayName co \"another group\"") `bindResponse` \Response
justTwo ->
    (Response
justTwo.json App 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) App [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value
createdGroup2, Value
createdGroup3]

  -- 3. Empty groups should have empty member list.
  respGroup4 <- createScimUserGroup OwnDomain tok $ mkScimGroup "empty group" []
  filterScimUserGroup OwnDomain tok (Just "displayName co \"empty group\"") `bindResponse` \Response
foundResults -> do
    singleEmptyGroup <- Response
foundResults.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Resources" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    (singleEmptyGroup %. "members" & asList) `shouldMatch` ([] :: [Value])
    respGroup4.json `shouldMatch` singleEmptyGroup

  -- 4. Pagination
  let searchPage String
substr Int
startIndex Int
count =
        Domain
-> String -> Maybe String -> Maybe Int -> Maybe Int -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> String -> Maybe String -> Maybe Int -> Maybe Int -> App Response
filterScimUserGroupPaginate
          Domain
OwnDomain
          String
tok
          (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"displayName co \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
substr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\"")
          (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
startIndex)
          (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count)
      createGroup String
name = Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUserGroup Domain
OwnDomain String
tok (Value -> App Response) -> Value -> App Response
forall a b. (a -> b) -> a -> b
$ String -> [Value] -> Value
mkScimGroup String
name [String -> Value
mkScimUser String
scimUserId]

  -- Create 20 groups
  let expectedTotalResults = Int
20 :: Int
  forM_ [1 .. expectedTotalResults] $ \Int
n -> String -> App Response
createGroup (String
"newGroupNo" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n)

  -- Go through 4 pages (the last one is an empty page)
  forM_ [1 .. 4] $ \Int
p ->
    let startIndex :: Int
startIndex = (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 -- 1-based index
        count :: Int
count = Int
7
        expectedItemsPerPage :: Int
expectedItemsPerPage = 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
expectedTotalResults Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) -- expected between 0 and `count` depending on if it's a full, half or empty page
     in String -> Int -> Int -> App Response
searchPage String
"newGroupNo" Int
startIndex Int
count App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
          Response
resp.json App 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
startIndex
          Response
resp.json App 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
expectedTotalResults
          Response
resp.json App 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
expectedItemsPerPage
          resources <- Response
resp.json App 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` 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` \Response
resp -> do
    Response
resp.json App 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
1
    resources <- Response
resp.json App 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` 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` \Response
resp -> do
    Response
resp.json App 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
1
    resources <- Response
resp.json App 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` 9

  -- Only startIndex, no count
  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"newGroupNo\"") (Just 5) Nothing `bindResponse` \Response
resp -> do
    Response
resp.json App 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
5
    Response
resp.json App 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
expectedTotalResults

  -- Only count, no startIndex
  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"newGroupNo\"") Nothing (Just 3) `bindResponse` \Response
resp -> do
    Response
resp.json App 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
1
    Response
resp.json App 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
3
    resources <- Response
resp.json App 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` 3

  -- Filter with empty result
  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"nonexistent-filter-xyz\"") (Just 1) (Just 10) `bindResponse` \Response
resp -> do
    Response
resp.json App 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
1
    Response
resp.json App 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
0
    Response
resp.json App 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
0
    resources <- Response
resp.json App 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` 0

  -- All results in one page
  filterScimUserGroupPaginate OwnDomain tok (Just "displayName co \"newGroupNo\"") (Just 1) (Just 100) `bindResponse` \Response
resp -> do
    Response
resp.json App 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
1
    Response
resp.json App 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
expectedTotalResults
    Response
resp.json App 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
expectedTotalResults
    resources <- Response
resp.json App 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` expectedTotalResults

testSparScimUpdateUserGroup :: (HasCallStack) => App ()
testSparScimUpdateUserGroup :: HasCallStack => App ()
testSparScimUpdateUserGroup = do
  (alice, tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
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 String
displayName = do
        scimUserEmail <- App String
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 =
        [Pair] -> Value
object
          [ String
"schemas" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"urn:ietf:params:scim:schemas:core:2.0:Group"],
            String
"displayName" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"My funky group",
            String
"members"
              String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [ [Pair] -> Value
object
                     [ String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
bobId,
                       String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User",
                       String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"http://example.com:8088/scim/v2/Users/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
bobId)
                     ],
                   [Pair] -> Value
object
                     [ String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
charlieId,
                       String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User",
                       String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"http://example.com:8088/scim/v2/Users/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
charlieId)
                     ]
                 ]
          ]
  gid <- createScimUserGroup OwnDomain tok scimUserGroup >>= getJSON 201 >>= (%. "id") >>= asString
  let scimUserGroupUpdated =
        [Pair] -> Value
object
          [ String
"schemas" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"urn:ietf:params:scim:schemas:core:2.0:Group"],
            String
"displayName" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"My even funkier group",
            String
"members"
              String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [ [Pair] -> Value
object
                     [ String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
charlieId,
                       String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User",
                       String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"http://example.com:8088/scim/v2/Users/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
charlieId)
                     ],
                   [Pair] -> Value
object
                     [ String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
dianaId,
                       String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User",
                       String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"http://example.com:8088/scim/v2/Users/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dianaId)
                     ]
                 ]
          ]
  -- run this twice to check for idempotency
  replicateM_ 2 $ do
    updateScimUserGroup OwnDomain tok gid scimUserGroupUpdated `bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"displayName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"My even funkier group"
      let expectedMembers :: [String]
expectedMembers = [String
charlieId, String
dianaId]
      actualMembers <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App [String]) -> App [String]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App String) -> [Value] -> App [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value") (Value -> App Value)
-> (Value -> App String) -> Value -> App String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
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` \Response
resp -> do
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"displayName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"My even funkier group"
      memberValues <- (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members") App Value -> (Value -> App [String]) -> App [String]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App String) -> MakesValue Value => Value -> App [String]
forall b a.
HasCallStack =>
(Value -> App b) -> MakesValue a => a -> App [b]
asListOf (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"value" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
      memberValues `shouldMatchSet` [charlieId, dianaId]

testSparScimUpdateUserGroupRejectsInvalidMembers :: (HasCallStack) => App ()
testSparScimUpdateUserGroupRejectsInvalidMembers :: HasCallStack => App ()
testSparScimUpdateUserGroupRejectsInvalidMembers = do
  (alice, tid1, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
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 String
name = do
        email <- App String
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 =
        [Pair] -> Value
object
          [ String
"schemas" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"urn:ietf:params:scim:schemas:core:2.0:Group"],
            String
"displayName" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"Test Group",
            String
"members" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
validId, String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User", String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"http://example.com:8088/scim/v2/Users/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
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 =
        [Pair] -> Value
object
          [ String
"schemas" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"urn:ietf:params:scim:schemas:core:2.0:Group"],
            String
"displayName" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"Test Group",
            String
"members"
              String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [ [Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
validId, String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User", String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"http://example.com:8088/scim/v2/Users/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
validId)],
                   [Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
ownerId, String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User", String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"http://example.com:8088/scim/v2/Users/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ownerId)]
                 ]
          ]
  bindResponse (updateScimUserGroup OwnDomain tok1 gid updateWithNonScim) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
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 =
        [Pair] -> Value
object
          [ String
"schemas" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"urn:ietf:params:scim:schemas:core:2.0:Group"],
            String
"displayName" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"Test Group",
            String
"members"
              String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [ [Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
validId, String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User", String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"http://example.com:8088/scim/v2/Users/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
validId)],
                   [Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
otherId, String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User", String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"http://example.com:8088/scim/v2/Users/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
otherId)]
                 ]
          ]
  bindResponse (updateScimUserGroup OwnDomain tok1 gid updateWithOtherTeamMember) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400

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

testSparScimDeleteUserGroup :: (HasCallStack) => App ()
testSparScimDeleteUserGroup :: HasCallStack => App ()
testSparScimDeleteUserGroup = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  tok <- createScimTokenV6 owner def >>= \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString

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

        getScimUser OwnDomain tok uid `bindResponse` \Response
res -> do
          Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

        registerInvitedUser OwnDomain tid scimUserEmail

        pure uid

  scimUserId <- mkMemberCandidate
  let scimUserGroup =
        [Pair] -> Value
object
          [ String
"schemas" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"urn:ietf:params:scim:schemas:core:2.0:Group"],
            String
"displayName" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"ze groop",
            String
"members"
              String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [ [Pair] -> Value
object
                     [ String
"type" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"User",
                       String
"$ref" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"...", -- 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.
                       String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
scimUserId
                     ]
                 ]
          ]
  gid <- createScimUserGroup OwnDomain tok scimUserGroup >>= getJSON 201 >>= (%. "id") >>= asString
  deleteScimUserGroup OwnDomain tok gid >>= assertSuccess
  getScimUserGroup OwnDomain tok gid `bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testSparScimGroupSearchOnlyReturnsScimGroups :: (HasCallStack) => App ()
testSparScimGroupSearchOnlyReturnsScimGroups :: HasCallStack => App ()
testSparScimGroupSearchOnlyReturnsScimGroups = do
  (owner, tid, [regularMember]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  tok <- createScimTokenV6 owner def >>= \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString

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

  let mkScimMemberCandidate :: App String
      mkScimMemberCandidate = do
        scimUserEmail <- App String
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 =
        [Pair] -> Value
object
          [ String
"name" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"wire-managed-group",
            String
"members" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
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` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    resources <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Resources" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    resourceIds <- for resources $ \Value
g -> Value
g Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
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 :: HasCallStack => App ()
testSparEmulateSPInitiatedLogin = do
  -- set up saml-not-scim team
  (owner, tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (createIdpResp, (_idpmeta, privcreds)) <- registerTestIdPWithMetaWithPrivateCreds owner
  assertSuccess createIdpResp

  -- craft authnresp without req
  idpValue :: A.Value <- createIdpResp.json
  let idp :: SAML.IdPConfig Value
      idp = (String -> IdPConfig Value)
-> (IdPConfig Value -> IdPConfig Value)
-> Either String (IdPConfig Value)
-> IdPConfig Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IdPConfig Value
forall a. HasCallStack => String -> a
error IdPConfig Value -> IdPConfig Value
forall a. a -> a
id (Either String (IdPConfig Value) -> IdPConfig Value)
-> Either String (IdPConfig Value) -> IdPConfig Value
forall a b. (a -> b) -> a -> b
$ (Value -> Parser (IdPConfig Value))
-> Value -> Either String (IdPConfig Value)
forall a b. (a -> Parser b) -> a -> Either String b
A.parseEither (forall a. FromJSON a => Value -> Parser a
A.parseJSON @(SAML.IdPConfig A.Value)) Value
idpValue
  authnresp <- getAuthnResponse tid idp privcreds

  -- send to finalize and check redirect response
  finalizeSamlLogin OwnDomain tid authnresp `bindResponse` \Response
resp -> do
    -- the 303 is followed immediately, so the response is already coming from
    -- /sso/initiate-login here.
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs Response
resp.body) String -> String -> App ()
forall a. (Eq a, Show a, HasCallStack) => [a] -> [a] -> App ()
`shouldContain` String
"SAMLRequest"

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

  -- gather info about idp and account
  idpValue :: A.Value <- createIdpResp.json
  randomness <- randomId
  let idp :: SAML.IdPConfig (Value {- not needed -})
      idp = (String -> IdPConfig Value)
-> (IdPConfig Value -> IdPConfig Value)
-> Either String (IdPConfig Value)
-> IdPConfig Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IdPConfig Value
forall a. HasCallStack => String -> a
error IdPConfig Value -> IdPConfig Value
forall a. a -> a
id (Either String (IdPConfig Value) -> IdPConfig Value)
-> Either String (IdPConfig Value) -> IdPConfig Value
forall a b. (a -> b) -> a -> b
$ (Value -> Parser (IdPConfig Value))
-> Value -> Either String (IdPConfig Value)
forall a b. (a -> Parser b) -> a -> Either String b
A.parseEither (forall a. FromJSON a => Value -> Parser a
A.parseJSON @(SAML.IdPConfig A.Value)) Value
idpValue

      userName = String
"klăusﭲﭳﭴﭵﭶﭷﭸﭹﭺﭻﭼﭽﭾﭿㄖㄗㄘ✈✉♊ႩႪงจฉชซὨὩἈἉἊἋἌἍἎἏຜຝڈډڊڋ" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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` \Response
resp -> do
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
userName

-- | in V6, create two idps then one scim should fail
testSparCreateTwoScimTokensForOneIdp :: (HasCallStack) => App ()
testSparCreateTwoScimTokensForOneIdp :: HasCallStack => App ()
testSparCreateTwoScimTokensForOneIdp = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
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 :: HasCallStack => App ()
testCheckAdminGetTeamId = do
  (owner :: Value, tid :: String, [regular] :: [Value]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
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` \Response
resp -> do
    -- insuficient permissions for non-admin, both as expected.
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"insufficient-permissions"

testCheckAdminGetTeamIdV7 :: App ()
testCheckAdminGetTeamIdV7 :: App ()
testCheckAdminGetTeamIdV7 = Int -> App () -> App ()
forall a. Int -> App a -> App a
withAPIVersion Int
7 App ()
HasCallStack => App ()
testCheckAdminGetTeamId

testSsoLoginAndEmailVerification :: (HasCallStack) => App ()
testSsoLoginAndEmailVerification :: HasCallStack => App ()
testSsoLoginAndEmailVerification = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  emailDomain <- randomDomain

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

  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  void $ loginWithSamlEmail True tid email (idpId, idpMeta)
  activateEmail OwnDomain email
  getUsersByEmail OwnDomain [email] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

-- | This test may be covered by `testScimUpdateEmailAddress` and maybe can be removed.
testSsoLoginNoSamlEmailValidation :: (HasCallStack) => TaggedBool "validateSAMLEmails" -> App ()
testSsoLoginNoSamlEmailValidation :: HasCallStack => TaggedBool "validateSAMLEmails" -> App ()
testSsoLoginNoSamlEmailValidation (TaggedBool Bool
validateSAMLEmails) = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  emailDomain <- randomDomain

  let status = if Bool
validateSAMLEmails then String
"enabled" else String
"disabled"
  assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" status

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

  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  (Just uid, authnResp) <- loginWithSamlEmail True tid email (idpId, idpMeta)
  let parsed :: SAML.AuthnResponse =
        fromRight (error "invalid authnResponse")
          . SAMLXML.parseFromDocument
          . SAML.fromSignedAuthnResponse
          $ authnResp
      uref = ([UserRef] -> UserRef)
-> (UserRef -> UserRef) -> Either [UserRef] UserRef -> UserRef
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> UserRef
forall a. HasCallStack => String -> a
error (String -> UserRef)
-> ([UserRef] -> String) -> [UserRef] -> UserRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UserRef] -> String
forall a. Show a => a -> String
show) UserRef -> UserRef
forall a. a -> a
id (Either [UserRef] UserRef -> UserRef)
-> Either [UserRef] UserRef -> UserRef
forall a b. (a -> b) -> a -> b
$ NonEmpty Assertion -> Either [UserRef] UserRef
SAML.assertionsToUserRef (AuthnResponse
parsed AuthnResponse
-> Getting (NonEmpty Assertion) AuthnResponse (NonEmpty Assertion)
-> NonEmpty Assertion
forall s a. s -> Getting a s a -> a
^. Getting (NonEmpty Assertion) AuthnResponse (NonEmpty Assertion)
forall payload (f :: * -> *).
Functor f =>
(payload -> f payload) -> Response payload -> f (Response payload)
SAML.rspPayload)
      eid = CI ST -> ST
forall s. CI s -> s
CI.original (CI ST -> ST) -> CI ST -> ST
forall a b. (a -> b) -> a -> b
$ UserRef
uref UserRef -> Getting (CI ST) UserRef (CI ST) -> CI ST
forall s a. s -> Getting a s a -> a
^. (NameID -> Const (CI ST) NameID)
-> UserRef -> Const (CI ST) UserRef
Lens' UserRef NameID
SAML.uidSubject ((NameID -> Const (CI ST) NameID)
 -> UserRef -> Const (CI ST) UserRef)
-> ((CI ST -> Const (CI ST) (CI ST))
    -> NameID -> Const (CI ST) NameID)
-> Getting (CI ST) UserRef (CI ST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameID -> CI ST)
-> (CI ST -> Const (CI ST) (CI ST))
-> NameID
-> Const (CI ST) NameID
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to NameID -> CI ST
SAML.unsafeShowNameID
  eid `shouldMatch` email

  when validateSAMLEmails $ do
    getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
      user %. "status" `shouldMatch` "active"
      lookupField user "email" `shouldMatch` (Nothing :: Maybe String)

    getUsersByEmail OwnDomain [email] `bindResponse` \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty

    activateEmail OwnDomain email

  getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

  getUsersByEmail OwnDomain [email] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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 "validateSAMLEmails" -> App ()
testScimUpdateEmailAddress :: HasCallStack =>
TaggedBool "extIdIsEmail"
-> TaggedBool "validateSAMLEmails" -> App ()
testScimUpdateEmailAddress (TaggedBool Bool
extIdIsEmail) (TaggedBool Bool
validateSAMLEmails) = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  let status = if Bool
validateSAMLEmails then String
"enabled" else String
"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` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
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` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
uid
    App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
res.json String
"emails"
      App (Maybe Value) -> Maybe [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ( if Bool
extIdIsEmail
                        then [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
oldEmail]]
                        else Maybe [Value]
forall a. Maybe a
Nothing
                    )

  newEmail <- randomEmail
  let newScimUser =
        let addEmailsField :: Value -> Value
            addEmailsField :: Value -> Value
addEmailsField = \case
              Object Object
o ->
                Object -> Value
Object
                  ( Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert
                      (String -> Key
forall a. IsString a => String -> a
fromString String
"emails")
                      ([Value] -> Value
forall a. ToJSON a => a -> Value
toJSON [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail]])
                      Object
o
                  )
         in Value -> Value
addEmailsField Value
scimUser

  updateScimUser OwnDomain tok uid newScimUser `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail]]

  getScimUser OwnDomain tok uid `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail]]

  when validateSAMLEmails $ do
    getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
      user %. "status" `shouldMatch` "active"
      lookupField user "email" `shouldMatch` (Nothing :: Maybe String)

    getUsersByEmail OwnDomain [newEmail] `bindResponse` \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty

    activateEmail OwnDomain newEmail

  getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail

  getUsersByEmail OwnDomain [newEmail] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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 :: HasCallStack => App ()
testScimUpdateEmailAddressAndExternalId = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  let status = String
"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` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
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` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
brigUserId
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
extId1]]

  findUsersByExternalId OwnDomain tok extId1 `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    (Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Resources") App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Value
v] -> Value
v Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
brigUserId

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

  updateScimUser OwnDomain tok brigUserId newScimUser1 `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
extId1
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail1]]

  getScimUser OwnDomain tok brigUserId `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail1]]

  findUsersByExternalId OwnDomain tok extId1 `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    (Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Resources") App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Value
v] -> Value
v Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
brigUserId

  getUsersId OwnDomain [brigUserId] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

  getUsersByEmail OwnDomain [newEmail1] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

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

  updateScimUser OwnDomain tok brigUserId newScimUser2 `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newExtId2
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail1]]

  getScimUser OwnDomain tok brigUserId `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail1]]

  findUsersByExternalId OwnDomain tok newExtId2 `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    (Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Resources") App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Value
v] -> Value
v Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` {- CRASH (list is empty) -} String
brigUserId

  getUsersId OwnDomain [brigUserId] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

  getUsersByEmail OwnDomain [newEmail1] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
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 :: Value -> Value
updEmailExtId = \case
              Object Object
o -> Object -> Value
Object (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert (String -> Key
forall a. IsString a => String -> a
fromString String
"externalId") (String -> Value
forall a. ToJSON a => a -> Value
toJSON String
newEmail3) Object
o)
         in Value -> Value
updEmailExtId Value
newScimUser2

  updateScimUser OwnDomain tok brigUserId newScimUser3 `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail3
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail1]]

  getScimUser OwnDomain tok brigUserId `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail1]]

  findUsersByExternalId OwnDomain tok newEmail3 `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    (Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"Resources") App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Value
v] -> Value
v Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
brigUserId

  getUsersId OwnDomain [brigUserId] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

  getUsersByEmail OwnDomain [newEmail1] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` newEmail1

testScimLoginNoSamlEmailValidation :: (HasCallStack) => TaggedBool "validateSAMLEmails" -> App ()
testScimLoginNoSamlEmailValidation :: HasCallStack => TaggedBool "validateSAMLEmails" -> App ()
testScimLoginNoSamlEmailValidation (TaggedBool Bool
validateSAMLEmails) = do
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  let status = if Bool
validateSAMLEmails then String
"enabled" else String
"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` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString

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

  getScimUser OwnDomain tok uid `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
uid

  when validateSAMLEmails $ do
    getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
      user %. "status" `shouldMatch` "active"
      lookupField user "email" `shouldMatch` (Nothing :: Maybe String)

    getUsersByEmail OwnDomain [email] `bindResponse` \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty

    activateEmail OwnDomain email

  getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

  getUsersByEmail OwnDomain [email] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    user <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

testIdpUpdate :: (HasCallStack) => App ()
testIdpUpdate :: HasCallStack => App ()
testIdpUpdate = do
  (owner, tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
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` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
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` \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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 $ \(String
_, String
email) -> do
    App (Maybe String, SignedAuthnResponse) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Maybe String, SignedAuthnResponse) -> App ())
-> App (Maybe String, SignedAuthnResponse) -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSamlEmail Bool
True String
tid String
email (String, (IdPMetadata, SignPrivCreds))
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 $ \(String
_, String
email) -> do
    App (Maybe String, SignedAuthnResponse) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Maybe String, SignedAuthnResponse) -> App ())
-> App (Maybe String, SignedAuthnResponse) -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSamlEmail Bool
True String
tid String
email (String, (IdPMetadata, SignPrivCreds))
idp3

-- @SF.Provisioning @TSFI.RESTfulAPI @S2
--
-- Allow updates of E2EI enabled users only via SCIM
testAllowUpdatesBySCIMWhenE2EIdEnabled :: (HasCallStack) => TaggedBool "sso-enabled" -> App ()
testAllowUpdatesBySCIMWhenE2EIdEnabled :: HasCallStack => TaggedBool "sso-enabled" -> App ()
testAllowUpdatesBySCIMWhenE2EIdEnabled (TaggedBool Bool
ssoEnabled) = do
  (tok, uid, su) <- if Bool
ssoEnabled then App (String, String, Value)
setupWithSSO else App (String, String, Value)
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 :: App (String, String, Value)
setupWithSSO = do
      (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
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 :: App (String, String, Value)
setupWithoutSSO = do
      (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
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 :: HasCallStack => String -> String -> Value -> App Value
checkUpdateHandleByScimSucceeds String
tok String
uid Value
scimUser = do
      newHandle <- App String
randomHandle
      su <- setField "userName" newHandle scimUser
      bindResponse (updateScimUser OwnDomain tok uid su) $ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"userName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
      bindResponse (getUsersId OwnDomain [uid]) $ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
        u %. "handle" `shouldMatch` newHandle
      pure su

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

    checkUpdateDisplayNameByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateDisplayNameByScimSucceeds :: HasCallStack => String -> String -> Value -> App Value
checkUpdateDisplayNameByScimSucceeds String
tok String
uid Value
scimUser = do
      let displayName :: String
displayName = String
"Alice in Wonderland"
      su <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"displayName" String
displayName Value
scimUser
      bindResponse (updateScimUser OwnDomain tok uid su) $ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"displayName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
displayName
      bindResponse (getUsersId OwnDomain [uid]) $ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
        u %. "name" `shouldMatch` displayName
      pure su

    checkUpdateDisplayNameByUserFails :: (HasCallStack, MakesValue user) => user -> App ()
    checkUpdateDisplayNameByUserFails :: forall user. (HasCallStack, MakesValue user) => user -> App ()
checkUpdateDisplayNameByUserFails user
user = do
      user -> PutSelf -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> PutSelf -> App Response
putSelf user
user PutSelf
forall a. Default a => a
def {name = Just "Bob the Builder"} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
        Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"managed-by-scim"

    checkUpdateLocaleByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateLocaleByScimSucceeds :: HasCallStack => String -> String -> Value -> App Value
checkUpdateLocaleByScimSucceeds String
tok String
uid Value
scimUser = do
      su <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"preferredLanguage" String
"fr" Value
scimUser
      bindResponse (updateScimUser OwnDomain tok uid su) $ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"preferredLanguage" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"fr"
      bindResponse (getUsersId OwnDomain [uid]) $ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
        u %. "locale" `shouldMatch` "fr"
      pure su

    checkUpdateLocaleByUserFails :: (HasCallStack, MakesValue user) => user -> App ()
    checkUpdateLocaleByUserFails :: forall user. (HasCallStack, MakesValue user) => user -> App ()
checkUpdateLocaleByUserFails user
user = do
      user -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
putSelfLocale user
user String
"de" App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
        Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"managed-by-scim"

    checkUpdateEmailByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateEmailByScimSucceeds :: HasCallStack => String -> String -> Value -> App Value
checkUpdateEmailByScimSucceeds String
tok String
uid Value
scimUser = do
      newEmail <- App String
randomEmail
      su <- setField "emails" [object ["value" .= newEmail]] scimUser
      bindResponse (updateScimUser OwnDomain tok uid su) $ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"emails" App Value -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail]]
      activateEmail OwnDomain newEmail
      bindResponse (getUsersId OwnDomain [uid]) $ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        u <- Response
res.json App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
        u %. "email" `shouldMatch` newEmail
      pure su

    checkUpdateEmailByUserFails :: (HasCallStack, MakesValue user) => user -> App ()
    checkUpdateEmailByUserFails :: forall user. (HasCallStack, MakesValue user) => user -> App ()
checkUpdateEmailByUserFails user
user = do
      email <- user -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make user
user App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      (cookie, token) <-
        login OwnDomain email defPassword `bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          token <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"access_token" 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
          let cookie = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Response -> Maybe String
getCookie String
"zuid" Response
resp
          pure ("zuid=" <> cookie, token)
      newEmail <- randomEmail
      updateEmail user newEmail cookie token `bindResponse` \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
        Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"managed-by-scim"

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

-- @END