{-# 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
  (Value
owner, String
_tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= \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
  Value
scimUser <- App Value
randomScimUser
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok Value
scimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok Value
scimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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.
  IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (Int
2_000_000)

  -- ...we should be able to create the user again
  App () -> App ()
forall a. App a -> App a
retryT (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok Value
scimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
registerTestIdPWithMeta Value
owner App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 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
"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
  String
email <- App String
randomEmail
  String
extId <- App String
randomExternalId
  Value
scimUser <- String -> String -> App Value
randomScimUserWithEmail String
extId String
email
  String
userId <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
  Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
email
  Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
extId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
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
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
    String
subject <- Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.subject" 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
    String
subject HasCallStack => String -> String -> App ()
String -> String -> App ()
`shouldContainString` String
extId
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"handle" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"userName")

  -- Verify that updating `userName` (handle) works
  Value
scimUserWith1Update <- do
    String
newHandle <- App String
randomHandle
    Value
updatedScimUser <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"userName" String
newHandle Value
scimUser
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
userId Value
updatedScimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
extId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Value
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
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
updatedScimUser

  -- Verify that updating the user's external ID works
  Value
scimUserWith2Updates <- do
    String
newExtId <- App String
randomExternalId
    Value
updatedScimUser <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"externalId" String
newExtId Value
scimUserWith1Update
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
userId Value
updatedScimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
newExtId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Value
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
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
      String
subject <- Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.subject" 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
      String
subject HasCallStack => String -> String -> App ()
String -> String -> App ()
`shouldContainString` String
newExtId
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
findUsersByExternalId Domain
OwnDomain String
tok String
extId) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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])
    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
updatedScimUser

  -- Verify that updating the user's email works
  do
    let oldEmail :: String
oldEmail = String
email
    String
newEmail <- App String
randomEmail
    Value
updatedScimUser <- String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField 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]]) Value
scimUserWith2Updates
    String
currentExtId <- Value
updatedScimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" 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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
userId Value
updatedScimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
currentExtId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Value
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
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
oldEmail
      String
subject <- Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.subject" 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
      String
subject HasCallStack => String -> String -> App ()
String -> String -> App ()
`shouldContainString` String
currentExtId

    -- after activation the new email should be present
    Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
newEmail
    Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
currentExtId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Value
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
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
      String
subject <- Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.subject" 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
      String
subject HasCallStack => String -> String -> App ()
String -> String -> App ()
`shouldContainString` String
currentExtId

testSparExternalIdDifferentFromEmail :: (HasCallStack) => App ()
testSparExternalIdDifferentFromEmail :: HasCallStack => App ()
testSparExternalIdDifferentFromEmail = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= \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
  String
email <- App String
randomEmail
  String
extId <- App String
randomExternalId
  Value
scimUser <- String -> String -> App Value
randomScimUserWithEmail String
extId String
email
  String
userId <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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

  Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
extId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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

  Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid String
email

  Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
extId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
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
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.scim_external_id" 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
"handle" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"userName")

  -- Verify that updating the scim user works
  Value
scimUserWith1Update <- do
    -- FUTUREWORK: test updating other fields besides handle as well
    String
newHandle <- App String
randomHandle
    Value
updatedScimUser <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"userName" String
newHandle Value
scimUser
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
userId Value
updatedScimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
extId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Value
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
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
updatedScimUser

  -- Verify that updating the user's external ID works
  Value
scimUserWith2Updates <- do
    String
newExtId <- App String
randomExternalId
    Value
updatedScimUser <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"externalId" String
newExtId Value
scimUserWith1Update
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
userId Value
updatedScimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
newExtId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Value
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
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.scim_external_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newExtId
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
findUsersByExternalId Domain
OwnDomain String
tok String
extId) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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])
    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
updatedScimUser

  -- Verify that updating the user's email works
  do
    let oldEmail :: String
oldEmail = String
email
    String
newEmail <- App String
randomEmail
    Value
updatedScimUser <- String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField 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]]) Value
scimUserWith2Updates
    String
currentExtId <- Value
updatedScimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" 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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
userId Value
updatedScimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
currentExtId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Value
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
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
oldEmail
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.scim_external_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
currentExtId

    -- after activation the new email should be present
    Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
newEmail
    Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
currentExtId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Value
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
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
      Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.scim_external_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
currentExtId

testSparExternalIdUpdateToANonEmail :: (HasCallStack) => App ()
testSparExternalIdUpdateToANonEmail :: HasCallStack => App ()
testSparExternalIdUpdateToANonEmail = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= \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
  Value
scimUser <- App Value
randomScimUser 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
>>= String -> Value -> App Value
forall a. (HasCallStack, MakesValue a) => String -> a -> App Value
removeField String
"emails"
  String
email <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" 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
  String
userId <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok Value
scimUser) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
forall a b. (a -> b) -> a -> b
$ \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
  Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid String
email

  let extId :: String
extId = String
"notanemailaddress"
  Value
updatedScimUser <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"externalId" String
extId Value
scimUser
  Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
userId Value
updatedScimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
400

testSparMigrateFromExternalIdOnlyToEmail :: (HasCallStack) => Tagged "mailUnchanged" Bool -> App ()
testSparMigrateFromExternalIdOnlyToEmail :: HasCallStack => Tagged "mailUnchanged" Bool -> App ()
testSparMigrateFromExternalIdOnlyToEmail (MkTagged Bool
emailUnchanged) = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= \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
  Value
scimUser <- App Value
randomScimUser 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
>>= String -> Value -> App Value
forall a. (HasCallStack, MakesValue a) => String -> a -> App Value
removeField String
"emails"
  String
email <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" 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
  String
userId <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
  Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid String
email

  -- Verify that updating a user with an empty emails does not change the email
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
userId Value
scimUser) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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

  String
newEmail <- if Bool
emailUnchanged then String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
email else App String
randomEmail
  let newEmails :: Value
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]])
  Value
updatedScimUser <- String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"emails" Value
newEmails Value
scimUser
  Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
userId Value
updatedScimUser App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json 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
  Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
emailUnchanged (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
newEmail

  String
extId <- Value
scimUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"externalId" 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
  Domain -> String -> String -> String -> (Value -> App ()) -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> (Value -> App ()) -> App ()
checkSparGetUserAndFindByExtId Domain
OwnDomain String
tok String
extId String
userId ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
userId]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
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
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.scim_external_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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
  Response
usersByExtIdResp <- domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
findUsersByExternalId domain
domain String
tok String
extId
  Response
usersByExtIdResp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  Value
userByIdExtId <- Response
usersByExtIdResp.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
  Value -> App ()
k Value
userByIdExtId

  Response
userByUidResp <- domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser domain
domain String
tok String
uid
  Response
userByUidResp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  Value
userByUid <- Response
userByUidResp.json
  Value -> App ()
k Value
userByUid

  Value
userByUid Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
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
    (Value
owner, String
_tid, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
    Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
8 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
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
  (Value
owner, String
_tid, Value
mem : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  [Value]
tokens <- App Response -> (Response -> App [Value]) -> App [Value]
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
getScimTokens Value
owner) ((Response -> App [Value]) -> App [Value])
-> (Response -> App [Value]) -> App [Value]
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
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
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
tokens ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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")
    [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
tokens
  [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
tokens ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
token -> do
    String
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
    Value -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
putScimTokenName Value
mem String
tokenId String
"new name" App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
403
    Value -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
putScimTokenName Value
owner String
tokenId (String
"token:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tokenId) App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
getScimTokens Value
owner) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
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
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
updatedTokens ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
token -> do
      String
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
      Value
token 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
"token:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tokenId)

-- | in V6, create idp then scim without idp id and idp id is unique
testSparCreateScimTokenAssocImplicitly :: (HasCallStack) => App ()
testSparCreateScimTokenAssocImplicitly :: HasCallStack => App ()
testSparCreateScimTokenAssocImplicitly = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  Value
samlIdpId <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
registerTestIdPWithMeta Value
owner) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \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"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getAllIdPs Value
owner String
tid) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
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
    Value
idp Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
samlIdpId

-- | in V6, name should be ignored
testSparCreateScimTokenWithName :: (HasCallStack) => App ()
testSparCreateScimTokenWithName :: HasCallStack => App ()
testSparCreateScimTokenWithName = do
  (Value
owner, String
_tid, [Value]
_) <- 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
notExpected = String
"my scim token"
  Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner (CreateScimToken
forall a. Default a => a
def {name = Just notExpected}) App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  Value
token <- Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
getScimTokens Value
owner App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 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
"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 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
  Value
assoc <- Value
token Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  Value
token Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> Maybe Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> Maybe Value
forall a. a -> Maybe a
Just Value
assoc

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

testSparScimCreateGetSearchUserGroup :: (HasCallStack) => App ()
testSparScimCreateGetSearchUserGroup :: HasCallStack => App ()
testSparScimCreateGetSearchUserGroup = do
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= \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
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"validateSAMLemails" String
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"

  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"validateSAMLemails" String
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  App (Response, (IdPMetadata, SignPrivCreds)) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Response, (IdPMetadata, SignPrivCreds)) -> App ())
-> App (Response, (IdPMetadata, SignPrivCreds)) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  let mkMemberCandidate :: App String
      mkMemberCandidate :: App String
mkMemberCandidate = do
        String
scimUserEmail <- App String
randomEmail
        Value
scimUser <- HasCallStack => RandomScimUserParams -> App Value
RandomScimUserParams -> App Value
randomScimUserWith RandomScimUserParams
forall a. Default a => a
def {mkExternalId = pure scimUserEmail}
        String
uid <- Value -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Value
owner String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
        Value
quid <- do
          String
dom <- Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain 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
          Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
dom, String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid]

        Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
uid 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
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

        Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid String
scimUserEmail

        Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
getSelf Value
quid 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
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"

        String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
uid

  String
scimUserId <- App String
mkMemberCandidate
  String
scimUserId2 <- App String
mkMemberCandidate
  String
scimUserId3 <- App String
mkMemberCandidate

  Response
respGroup1 <- 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
"a group" [String -> Value
mkScimUser String
scimUserId, String -> Value
mkScimUser String
scimUserId2]
  Response
respGroup2 <- 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
"another group" [String -> Value
mkScimUser String
scimUserId, String -> Value
mkScimUser String
scimUserId2]
  Response
respGroup3 <- 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
"yet another group" [String -> Value
mkScimUser String
scimUserId2, String -> Value
mkScimUser String
scimUserId3]

  Value
createdGroup1 <- Response
respGroup1.json
  Value
createdGroup2 <- Response
respGroup2.json
  Value
createdGroup3 <- Response
respGroup3.json

  -- Test getting a single SCIM group by id
  String
gid <- Response
respGroup1.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  Response
gottenGroup1 <- Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUserGroup Domain
OwnDomain String
tok String
gid
  Response
respGroup1.json App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Response
gottenGroup1.json

  -- Test filter (get in bulk) SCIM groups
  -- 1. Match "group", results in finding all three groups created above.
  Domain -> String -> Maybe String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> App Response
filterScimUserGroup Domain
OwnDomain String
tok (String -> Maybe String
forall a. a -> Maybe a
Just String
"displayName co \"group\"") App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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".
  Domain -> String -> Maybe String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> App Response
filterScimUserGroup Domain
OwnDomain String
tok (String -> Maybe String
forall a. a -> Maybe a
Just String
"displayName co \"another group\"") App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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.
  Response
respGroup4 <- 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
"empty group" []
  Domain -> String -> Maybe String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> App Response
filterScimUserGroup Domain
OwnDomain String
tok (String -> Maybe String
forall a. a -> Maybe a
Just String
"displayName co \"empty group\"") App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
foundResults -> do
    Value
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
    (Value
singleEmptyGroup Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members" 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 ()
`shouldMatch` ([] :: [Value])
    Response
respGroup4.json App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
singleEmptyGroup

testSparScimUpdateUserGroup :: (HasCallStack) => App ()
testSparScimUpdateUserGroup :: HasCallStack => App ()
testSparScimUpdateUserGroup = do
  (Value
alice, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> PutSelf -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> PutSelf -> App Response
putSelf Value
alice PutSelf
forall a. Default a => a
def {name = Just "alice"}
  String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
alice CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 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
"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
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
alice String
tid String
"validateSAMLemails" String
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
alice String
tid String
"sso" String
"enabled"

  let mkMemberCandidate :: String -> App String
      mkMemberCandidate :: String -> App String
mkMemberCandidate String
displayName = do
        String
scimUserEmail <- App String
randomEmail
        Value
scimUser <- HasCallStack => RandomScimUserParams -> App Value
RandomScimUserParams -> App Value
randomScimUserWith RandomScimUserParams
forall a. Default a => a
def {mkExternalId = pure scimUserEmail}
        Value
scimUserNamed <- 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
        String
uid <- Value -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Value
alice String
tok Value
scimUserNamed App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
        Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid String
scimUserEmail
        String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
uid

  String
bobId <- String -> App String
mkMemberCandidate String
"bob"
  String
charlieId <- String -> App String
mkMemberCandidate String
"charlie"
  String
dianaId <- String -> App String
mkMemberCandidate String
"diana"

  let scimUserGroup :: Value
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)
                     ]
                 ]
          ]
  String
gid <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUserGroup Domain
OwnDomain String
tok Value
scimUserGroup App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
  let scimUserGroupUpdated :: Value
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
  Int -> App () -> App ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUserGroup Domain
OwnDomain String
tok String
gid Value
scimUserGroupUpdated App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json 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]
      [String]
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)
      [String]
actualMembers [String] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String]
expectedMembers
      Response
resp.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
gid
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"schemas" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([String] -> Value
forall a. ToJSON a => a -> Value
toJSON [String
"urn:ietf:params:scim:schemas:core:2.0:Group"])
      (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> App (Maybe Value) -> App Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"meta") App Bool -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True
    Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUserGroup Domain
OwnDomain String
tok String
gid 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
"displayName" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"My even funkier group"
      [String]
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)
      [String]
memberValues [String] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
charlieId, String
dianaId]

testSparScimUpdateUserGroupRejectsInvalidMembers :: (HasCallStack) => App ()
testSparScimUpdateUserGroupRejectsInvalidMembers :: HasCallStack => App ()
testSparScimUpdateUserGroupRejectsInvalidMembers = do
  (Value
alice, String
tid1, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
alice String
tid1 String
"sso" String
"enabled"
  String
tok1 <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
alice CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 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
"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

  -- one valid SCIM-managed member in team 1
  let mkTeam1Member :: String -> App String
mkTeam1Member String
name = do
        String
email <- App String
randomEmail
        Value
su <- HasCallStack => RandomScimUserParams -> App Value
RandomScimUserParams -> App Value
randomScimUserWith RandomScimUserParams
forall a. Default a => a
def {mkExternalId = pure email} 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
>>= String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"displayName" String
name
        String
uid <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok1 Value
su App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
        Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid1 String
email
        String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
uid
  String
validId <- String -> App String
mkTeam1Member String
"charlie"

  -- create the group with one valid member
  let groupBody :: Value
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)]]
          ]
  String
gid <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUserGroup Domain
OwnDomain String
tok1 Value
groupBody App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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

  -- Case 1: user is in team but not managed by SCIM (the owner)
  String
ownerId <- Value
alice 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
  let updateWithNonScim :: Value
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)]
                 ]
          ]
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUserGroup Domain
OwnDomain String
tok1 String
gid Value
updateWithNonScim) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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)
  String
otherId <- do
    (Value
bob, String
tid2, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
    App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
bob String
tid2 String
"sso" String
"enabled"
    String
tok2 <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
bob CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 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
"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
    String
email <- App String
randomEmail
    Value
su <- HasCallStack => RandomScimUserParams -> App Value
RandomScimUserParams -> App Value
randomScimUserWith RandomScimUserParams
forall a. Default a => a
def {mkExternalId = pure email} 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
>>= String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"displayName" String
"diana"
    String
uid <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok2 Value
su App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
    Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid2 String
email
    String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
uid

  let updateWithOtherTeamMember :: Value
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)]
                 ]
          ]
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUserGroup Domain
OwnDomain String
tok1 String
gid Value
updateWithOtherTeamMember) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  String
nonExistingId <- App String
HasCallStack => App String
randomId
  let updateNonExisting :: Value
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)]
                 ]
          ]
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUserGroup Domain
OwnDomain String
tok1 String
gid Value
updateNonExisting) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= \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

  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"validateSAMLemails" String
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  App (Response, (IdPMetadata, SignPrivCreds)) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Response, (IdPMetadata, SignPrivCreds)) -> App ())
-> App (Response, (IdPMetadata, SignPrivCreds)) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  let mkMemberCandidate :: App String
      mkMemberCandidate :: App String
mkMemberCandidate = do
        String
scimUserEmail <- App String
randomEmail
        Value
scimUser <- HasCallStack => RandomScimUserParams -> App Value
RandomScimUserParams -> App Value
randomScimUserWith RandomScimUserParams
forall a. Default a => a
def {mkExternalId = pure scimUserEmail}
        String
uid <- Value -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Value
owner String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
        App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OwnDomain

        Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
uid 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
200

        Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid String
scimUserEmail

        String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
uid

  String
scimUserId <- App String
mkMemberCandidate
  let scimUserGroup :: Value
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
                     ]
                 ]
          ]
  String
gid <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUserGroup Domain
OwnDomain String
tok Value
scimUserGroup App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
deleteScimUserGroup Domain
OwnDomain String
tok String
gid App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUserGroup Domain
OwnDomain String
tok String
gid App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testSparScimGroupSearchOnlyReturnsScimGroups :: (HasCallStack) => App ()
testSparScimGroupSearchOnlyReturnsScimGroups :: HasCallStack => App ()
testSparScimGroupSearchOnlyReturnsScimGroups = do
  (Value
owner, String
tid, [Value
regularMember]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= \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

  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"validateSAMLemails" String
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  App (Response, (IdPMetadata, SignPrivCreds)) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Response, (IdPMetadata, SignPrivCreds)) -> App ())
-> App (Response, (IdPMetadata, SignPrivCreds)) -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner

  let mkScimMemberCandidate :: App String
      mkScimMemberCandidate :: App String
mkScimMemberCandidate = do
        String
scimUserEmail <- App String
randomEmail
        Value
scimUser <- HasCallStack => RandomScimUserParams -> App Value
RandomScimUserParams -> App Value
randomScimUserWith RandomScimUserParams
forall a. Default a => a
def {mkExternalId = pure scimUserEmail}
        String
uid <- Value -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Value
owner String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
        Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid String
scimUserEmail
        String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
uid

  String
scimUserId <- App String
mkScimMemberCandidate

  -- Create a wire-managed group using the regular team member
  String
regularMemberId <- Value
regularMember 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
  let wireGroupPayload :: Value
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]
          ]
  Response
wireGroupResp <- Value -> Value -> App Response
forall user newUserGroup.
(MakesValue user, MakesValue newUserGroup) =>
user -> newUserGroup -> App Response
createUserGroup Value
owner Value
wireGroupPayload
  Response
wireGroupResp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  String
wireGroupId <- Response
wireGroupResp.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

  -- Verify the wire-managed group was created with managedBy = "wire"
  Response
wireGroupGet <- Value -> String -> App Response
forall user. MakesValue user => user -> String -> App Response
getUserGroup Value
owner String
wireGroupId
  Response
wireGroupGet.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  Response
wireGroupGet.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"managedBy" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire"

  -- Create a SCIM-managed group using the SCIM user
  Response
scimGroupResp <- 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
"scim-managed-group" [String -> Value
mkScimUser String
scimUserId]
  Response
scimGroupResp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
  String
scimGroupId <- Response
scimGroupResp.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

  -- Call the SCIM groups search endpoint (without filter)
  Domain -> String -> Maybe String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> App Response
filterScimUserGroup Domain
OwnDomain String
tok Maybe String
forall a. Maybe a
Nothing App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
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
    [String]
resourceIds <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
resources ((Value -> App String) -> App [String])
-> (Value -> App String) -> App [String]
forall a b. (a -> b) -> a -> b
$ \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
    [String]
resourceIds [String] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
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
  (Value
owner, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  (Response
createIdpResp, (IdPMetadata
_idpmeta, SignPrivCreds
privcreds)) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess Response
createIdpResp

  -- craft authnresp without req
  Value
idpValue :: A.Value <- Response
createIdpResp.json
  let idp :: SAML.IdPConfig Value
      idp :: 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
  SignedAuthnResponse
authnresp <- String
-> IdPConfig Value -> SignPrivCreds -> App SignedAuthnResponse
forall extra.
String
-> IdPConfig extra -> SignPrivCreds -> App SignedAuthnResponse
getAuthnResponse String
tid IdPConfig Value
idp SignPrivCreds
privcreds

  -- send to finalize and check redirect response
  Domain -> String -> SignedAuthnResponse -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> SignedAuthnResponse -> App Response
finalizeSamlLogin Domain
OwnDomain String
tid SignedAuthnResponse
authnresp App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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
  (Value
owner, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  (Response
createIdpResp, (IdPMetadata
idpMeta, SignPrivCreds
privcreds)) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess Response
createIdpResp

  -- gather info about idp and account
  Value
idpValue :: A.Value <- Response
createIdpResp.json
  String
randomness <- App String
HasCallStack => App String
randomId
  let idp :: SAML.IdPConfig (Value {- not needed -})
      idp :: 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

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

  String
idpIdString <- IdPId -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (IdPId -> App String) -> IdPId -> App String
forall a b. (a -> b) -> a -> b
$ IdPConfig Value
idp IdPConfig Value -> Getting IdPId (IdPConfig Value) IdPId -> IdPId
forall s a. s -> Getting a s a -> a
^. Getting IdPId (IdPConfig Value) IdPId
forall extra (f :: * -> *).
Functor f =>
(IdPId -> f IdPId) -> IdPConfig extra -> f (IdPConfig extra)
SAML.idpId

  -- login
  (Just String
uidString, SignedAuthnResponse
_) <- HasCallStack =>
Bool
-> String
-> NameID
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
Bool
-> String
-> NameID
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSaml Bool
True String
tid NameID
subject (String
idpIdString, (IdPMetadata
idpMeta, SignPrivCreds
privcreds))
  String
ownDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain Domain
OwnDomain
  HasCallStack => String -> String -> App Response
String -> String -> App Response
Brig.getSelf' String
ownDomain String
uidString 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
"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
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
registerTestIdPWithMeta Value
owner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
registerTestIdPWithMeta Value
owner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
  Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
400
  [Value]
tokens <- Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
getScimTokens Value
owner App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 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
"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
  [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
tokens Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0

testCheckAdminGetTeamId :: (HasCallStack) => App ()
testCheckAdminGetTeamId :: HasCallStack => App ()
testCheckAdminGetTeamId = do
  (Value
owner :: Value, String
tid :: String, [Value
regular] :: [Value]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled" -- required for the next request
  SAML.SampleIdP IdPMetadata
idpMeta SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
  Value -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> IdPMetadata -> App Response
createIdp Value
owner IdPMetadata
idpMeta App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess -- Successful API response for owner (admin),
  Value -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> IdPMetadata -> App Response
createIdp Value
regular IdPMetadata
idpMeta App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`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
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String
emailDomain <- App String
randomDomain

  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  (Response
idp, (IdPMetadata, SignPrivCreds)
idpMeta) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"

  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  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
idpId, (IdPMetadata, SignPrivCreds)
idpMeta)
  Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
email
  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
email] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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
  (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String
emailDomain <- App String
randomDomain

  let status :: String
status = if Bool
validateSAMLEmails then String
"enabled" else String
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"validateSAMLemails" String
status

  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  (Response
idp, (IdPMetadata, SignPrivCreds)
idpMeta) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"

  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  (Just String
uid, SignedAuthnResponse
authnResp) <- 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
idpId, (IdPMetadata, SignPrivCreds)
idpMeta)
  let AuthnResponse
parsed :: SAML.AuthnResponse =
        AuthnResponse -> Either String AuthnResponse -> AuthnResponse
forall b a. b -> Either a b -> b
fromRight (String -> AuthnResponse
forall a. HasCallStack => String -> a
error String
"invalid authnResponse")
          (Either String AuthnResponse -> AuthnResponse)
-> (SignedAuthnResponse -> Either String AuthnResponse)
-> SignedAuthnResponse
-> AuthnResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Either String AuthnResponse
forall a (m :: * -> *).
(HasXML a, MonadError String m) =>
Document -> m a
SAMLXML.parseFromDocument
          (Document -> Either String AuthnResponse)
-> (SignedAuthnResponse -> Document)
-> SignedAuthnResponse
-> Either String AuthnResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedAuthnResponse -> Document
SAML.fromSignedAuthnResponse
          (SignedAuthnResponse -> AuthnResponse)
-> SignedAuthnResponse -> AuthnResponse
forall a b. (a -> b) -> a -> b
$ SignedAuthnResponse
authnResp
      uref :: UserRef
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 :: ST
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
  ST
eid ST -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

  Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
validateSAMLEmails (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] 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
200
      Value
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
      Value
user 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"
      Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
user String
"email" App (Maybe Value) -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe String
forall a. Maybe a
Nothing :: Maybe String)

    Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
email] 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
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

    Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
email

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
email] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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
  (Value
owner, String
tid, [Value]
_) <- 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
status = if Bool
validateSAMLEmails then String
"enabled" else String
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"validateSAMLemails" String
status

  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  (Response
idp, (IdPMetadata, SignPrivCreds)
_) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  String
tok <-
    Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner (CreateScimToken
forall a. Default a => a
def {idp = Just idpId}) App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json 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

  String
oldEmail <- App String
randomEmail
  Value
scimUser <-
    HasCallStack => RandomScimUserParams -> App Value
RandomScimUserParams -> App Value
randomScimUserWith
      RandomScimUserParams
forall a. Default a => a
def
        { mkExternalId = if extIdIsEmail then pure oldEmail else randomUUIDString,
          prependExternalIdToEmails = False,
          mkOtherEmails = pure []
        }
  String
uid <- Value -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Value
owner String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
uid 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
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
                    )

  String
newEmail <- App String
randomEmail
  let newScimUser :: Value
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

  Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
uid Value
newScimUser 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
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]]

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
uid 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
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]]

  Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
validateSAMLEmails (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] 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
200
      Value
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
      Value
user 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"
      Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
user String
"email" App (Maybe Value) -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe String
forall a. Maybe a
Nothing :: Maybe String)

    Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
newEmail] 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
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

    Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
newEmail

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
newEmail] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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
  (Value
owner, String
tid, [Value]
_) <- 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
status = String
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"validateSAMLemails" String
status

  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  (Response
idp, (IdPMetadata, SignPrivCreds)
_) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  String
tok <-
    Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner (CreateScimToken
forall a. Default a => a
def {idp = Just idpId}) App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json 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
  String
extId1 <- App String
randomEmail
  Value
scimUser <-
    HasCallStack => RandomScimUserParams -> App Value
RandomScimUserParams -> App Value
randomScimUserWith
      RandomScimUserParams
forall a. Default a => a
def
        { mkExternalId = pure extId1,
          prependExternalIdToEmails = False,
          mkOtherEmails = pure []
        }
  String
brigUserId <- Value -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Value
owner String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
brigUserId 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
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]]

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
findUsersByExternalId Domain
OwnDomain String
tok String
extId1 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
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
  String
newEmail1 <- App String
randomEmail
  let newScimUser1 :: Value
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

  Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
brigUserId Value
newScimUser1 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
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]]

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
brigUserId 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
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]]

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
findUsersByExternalId Domain
OwnDomain String
tok String
extId1 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
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

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
brigUserId] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail1

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
newEmail1] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail1

  -- 3. change extId to uuid
  String
newExtId2 <- App String
randomUUIDString
  let newScimUser2 :: Value
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

  Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
brigUserId Value
newScimUser2 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
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]]

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
brigUserId 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
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]]

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
findUsersByExternalId Domain
OwnDomain String
tok String
newExtId2 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
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

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
brigUserId] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail1

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
newEmail1] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail1

  -- 4. change extId back to *other* email
  String
newEmail3 <- App String
randomEmail
  let newScimUser3 :: Value
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

  Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
brigUserId Value
newScimUser3 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
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]]

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
brigUserId 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
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]]

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
findUsersByExternalId Domain
OwnDomain String
tok String
newEmail3 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
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

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
brigUserId] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail1

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
newEmail1] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail1

testScimLoginNoSamlEmailValidation :: (HasCallStack) => TaggedBool "validateSAMLEmails" -> App ()
testScimLoginNoSamlEmailValidation :: HasCallStack => TaggedBool "validateSAMLEmails" -> App ()
testScimLoginNoSamlEmailValidation (TaggedBool Bool
validateSAMLEmails) = do
  (Value
owner, String
tid, [Value]
_) <- 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
status = if Bool
validateSAMLEmails then String
"enabled" else String
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"validateSAMLemails" String
status

  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  (Response
idp, (IdPMetadata, SignPrivCreds)
_) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  String
tok <-
    Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner (CreateScimToken
forall a. Default a => a
def {idp = Just idpId}) App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json 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

  Value
scimUser <- App Value
randomScimUser
  String
email <- Value
scimUser 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
  String
uid <- Value -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Value
owner String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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

  Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
uid 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
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

  Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
validateSAMLEmails (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] 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
200
      Value
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
      Value
user 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"
      Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
user String
"email" App (Maybe Value) -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe String
forall a. Maybe a
Nothing :: Maybe String)

    Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
email] 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
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

    Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
email

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
email] 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
200
    Value
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
    Value
user 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"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

testIdpUpdate :: (HasCallStack) => App ()
testIdpUpdate :: HasCallStack => App ()
testIdpUpdate = do
  (Value
owner, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  -- register an IdP
  idp :: (String, (IdPMetadata, SignPrivCreds))
idp@(String
idpId, (IdPMetadata
idpmeta, SignPrivCreds
pCreds)) <- do
    (Response
resp, (IdPMetadata, SignPrivCreds)
meta) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
    (,(IdPMetadata, SignPrivCreds)
meta) (String -> (String, (IdPMetadata, SignPrivCreds)))
-> App String -> App (String, (IdPMetadata, SignPrivCreds))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
  -- create a SCIM token
  String
tok <-
    Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner (CreateScimToken
forall a. Default a => a
def {idp = Just idpId}) App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json 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
  [(String, String)]
uids <- Int -> App (String, String) -> App [(String, String)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (App (String, String) -> App [(String, String)])
-> App (String, String) -> App [(String, String)]
forall a b. (a -> b) -> a -> b
$ do
    Value
scimUser <- App Value
randomScimUser
    String
email <- Value
scimUser 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
    String
uid <- Value -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Value
owner String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
    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))
idp
    Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
email
    Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getScimUser Domain
OwnDomain String
tok String
uid 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
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
    (String, String) -> App (String, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
uid, String
email)
  -- update the IdP
  (String, (IdPMetadata, SignPrivCreds))
idp2 <- do
    (Response
resp, (IdPMetadata, SignPrivCreds)
meta) <- Value -> String -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> String -> App (Response, (IdPMetadata, SignPrivCreds))
updateTestIdpWithMetaWithPrivateCreds Value
owner String
idpId
    (,(IdPMetadata, SignPrivCreds)
meta) (String -> (String, (IdPMetadata, SignPrivCreds)))
-> App String -> App (String, (IdPMetadata, SignPrivCreds))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
  -- the SCIM users can login
  [(String, String)] -> ((String, String) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(String, String)]
uids (((String, String) -> App ()) -> App ())
-> ((String, String) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(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
  (String, (IdPMetadata, SignPrivCreds))
idp3 <- do
    Response
resp <- Value -> String -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> IdPMetadata -> App Response
updateIdp Value
owner String
idpId IdPMetadata
idpmeta
    (,(IdPMetadata
idpmeta, SignPrivCreds
pCreds)) (String -> (String, (IdPMetadata, SignPrivCreds)))
-> App String -> App (String, (IdPMetadata, SignPrivCreds))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
  -- the SCIM users can still login
  [(String, String)] -> ((String, String) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(String, String)]
uids (((String, String) -> App ()) -> App ())
-> ((String, String) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(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
  (String
tok, String
uid, Value
su) <- if Bool
ssoEnabled then App (String, String, Value)
setupWithSSO else App (String, String, Value)
setupWithoutSSO
  Value
user <- Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 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

  Value -> App ()
forall user. (HasCallStack, MakesValue user) => user -> App ()
checkUpdateHandleByUserFails Value
user
  Value
su1 <- HasCallStack => String -> String -> Value -> App Value
String -> String -> Value -> App Value
checkUpdateHandleByScimSucceeds String
tok String
uid Value
su
  Value -> App ()
forall user. (HasCallStack, MakesValue user) => user -> App ()
checkUpdateDisplayNameByUserFails Value
user
  Value
su2 <- HasCallStack => String -> String -> Value -> App Value
String -> String -> Value -> App Value
checkUpdateDisplayNameByScimSucceeds String
tok String
uid Value
su1

  -- the following should not be part of the e2eid certification, but are checked here anyway
  Value -> App ()
forall user. (HasCallStack, MakesValue user) => user -> App ()
checkUpdateLocaleByUserFails Value
user
  Value
su3 <- HasCallStack => String -> String -> Value -> App Value
String -> String -> Value -> App Value
checkUpdateLocaleByScimSucceeds String
tok String
uid Value
su2
  Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ssoEnabled (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> App ()
forall user. (HasCallStack, MakesValue user) => user -> App ()
checkUpdateEmailByUserFails Value
user
  Value
su4 <- HasCallStack => String -> String -> Value -> App Value
String -> String -> Value -> App Value
checkUpdateEmailByScimSucceeds String
tok String
uid Value
su3
  -- external ID cannot be updated by the user, only by SCIM
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> String -> Value -> App Value
String -> String -> Value -> App Value
checkUpdateExternalIdByScimSucceeds String
tok String
uid Value
su4
  where
    setupWithSSO :: App (String, String, Value)
    setupWithSSO :: App (String, String, Value)
setupWithSSO = do
      (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
      Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled" App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"mlsE2EId" String
"enabled" App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
registerTestIdPWithMeta Value
owner App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
      String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 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
"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
      Value
scimUser <- App Value
randomScimUser
      String
email <- Value
scimUser 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
      String
uid <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
      Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
email
      (String, String, Value) -> App (String, String, Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
tok, String
uid, Value
scimUser)

    setupWithoutSSO :: App (String, String, Value)
    setupWithoutSSO :: App (String, String, Value)
setupWithoutSSO = do
      (Value
owner, String
tid, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
      Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"mlsE2EId" String
"enabled" App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      String
tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 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
"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
      Value
scimUser <- App Value
randomScimUser
      String
email <- Value
scimUser 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
      String
uid <- Domain -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> scimUser -> App Response
createScimUser Domain
OwnDomain String
tok Value
scimUser App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201 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
"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
      Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid String
email
      (String, String, Value) -> App (String, String, Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
tok, String
uid, Value
scimUser)

    checkUpdateHandleByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateHandleByScimSucceeds :: HasCallStack => String -> String -> Value -> App Value
checkUpdateHandleByScimSucceeds String
tok String
uid Value
scimUser = do
      String
newHandle <- App String
randomHandle
      Value
su <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"userName" String
newHandle Value
scimUser
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
uid Value
su) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Value
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
        Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"handle" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newHandle
      Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
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"
      Value
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
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
uid Value
su) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Value
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
        Value
u 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
displayName
      Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
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
      Value
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
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
uid Value
su) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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"
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Value
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
        Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"locale" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"fr"
      Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
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
      String
newEmail <- App String
randomEmail
      Value
su <- String -> [Value] -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"emails" [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
newEmail]] Value
scimUser
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
uid Value
su) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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]]
      Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
newEmail
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Value
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
        Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newEmail
      Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
su

    checkUpdateEmailByUserFails :: (HasCallStack, MakesValue user) => user -> App ()
    checkUpdateEmailByUserFails :: forall user. (HasCallStack, MakesValue user) => user -> App ()
checkUpdateEmailByUserFails user
user = do
      String
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
      (String
cookie, String
token) <-
        Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
login Domain
OwnDomain String
email String
defPassword App Response
-> (Response -> App (String, String)) -> App (String, String)
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          String
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 :: String
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
          (String, String) -> App (String, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
"zuid=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cookie, String
token)
      String
newEmail <- App String
randomEmail
      user -> String -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> String -> App Response
updateEmail user
user String
newEmail String
cookie String
token 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"

    checkUpdateExternalIdByScimSucceeds :: (HasCallStack) => String -> String -> Value -> App Value
    checkUpdateExternalIdByScimSucceeds :: HasCallStack => String -> String -> Value -> App Value
checkUpdateExternalIdByScimSucceeds String
tok String
uid Value
scimUser = do
      String
newExtId <- App String
randomUUIDString
      Value
su <- String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"externalId" String
newExtId Value
scimUser
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> Value -> App Response
forall domain scimUser.
(HasCallStack, MakesValue domain, MakesValue scimUser) =>
domain -> String -> String -> scimUser -> App Response
updateScimUser Domain
OwnDomain String
tok String
uid Value
su) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \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
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Value
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
        String
subject <-
          if Bool
ssoEnabled
            then
              Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.subject" 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
            else
              Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_id.scim_external_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
        String
subject HasCallStack => String -> String -> App ()
String -> String -> App ()
`shouldContainString` String
newExtId
      Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
su

-- @END