module Test.Spar.MultiIngressIdp where

import API.GalleyInternal
import API.Spar
import Control.Lens ((.~), (^.))
import qualified SAML2.WebSSO.Test.Util as SAML
import qualified SAML2.WebSSO.Types as SAML
import SetupHelpers
import Testlib.Prelude

ernieZHost :: String
ernieZHost :: [Char]
ernieZHost = [Char]
"nginz-https.ernie.example.com"

bertZHost :: String
bertZHost :: [Char]
bertZHost = [Char]
"nginz-https.bert.example.com"

kermitZHost :: String
kermitZHost :: [Char]
kermitZHost = [Char]
"nginz-https.kermit.example.com"

-- | Create a `MultiIngressDomainConfig` JSON object with the given @zhost@
makeSpDomainConfig :: String -> Value
makeSpDomainConfig :: [Char] -> Value
makeSpDomainConfig [Char]
zhost =
  [Pair] -> Value
object
    [ [Char]
"spAppUri" [Char] -> [Char] -> Pair
forall a. ToJSON a => [Char] -> a -> Pair
.= ([Char]
"https://webapp." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
zhost),
      [Char]
"spSsoUri" [Char] -> [Char] -> Pair
forall a. ToJSON a => [Char] -> a -> Pair
.= ([Char]
"https://nginz-https." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
zhost [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/sso"),
      [Char]
"contacts" [Char] -> [Value] -> Pair
forall a. ToJSON a => [Char] -> a -> Pair
.= [[Pair] -> Value
object [[Char]
"type" [Char] -> [Char] -> Pair
forall a. ToJSON a => [Char] -> a -> Pair
.= ([Char]
"ContactTechnical" :: String)]]
    ]

testMultiIngressIdpSimpleCase :: (HasCallStack) => App ()
testMultiIngressIdpSimpleCase :: HasCallStack => App ()
testMultiIngressIdpSimpleCase = do
  ServiceOverrides -> (HasCallStack => [Char] -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => [Char] -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def
      { sparCfg =
          removeField "saml.spSsoUri"
            >=> removeField "saml.spAppUri"
            >=> removeField "saml.contacts"
            >=> setField
              "saml.spDomainConfigs"
              ( object
                  [ ernieZHost .= makeSpDomainConfig ernieZHost,
                    bertZHost .= makeSpDomainConfig bertZHost
                  ]
              )
      }
    ((HasCallStack => [Char] -> App ()) -> App ())
-> (HasCallStack => [Char] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[Char]
domain -> do
      (Value
owner, [Char]
tid, [Value]
_) <- [Char] -> Int -> App (Value, [Char], [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, [Char], [Value])
createTeam [Char]
domain 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 -> [Char] -> [Char] -> [Char] -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> [Char] -> [Char] -> App Response
setTeamFeatureStatus Value
owner [Char]
tid [Char]
"sso" [Char]
"enabled"

      -- Create IdP for one domain
      SAML.SampleIdP IdPMetadata
idpmeta SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      [Char]
idpId <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) IdPMetadata
idpmeta App Response -> (Response -> App [Char]) -> App [Char]
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
201
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
ernieZHost
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

      Value -> [Char] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [Char] -> App Response
getIdp Value
owner [Char]
idpId 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
ernieZHost

      -- Update IdP for another domain
      Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
bertZHost) [Char]
idpId IdPMetadata
idpmeta 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
bertZHost

      Value -> [Char] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [Char] -> App Response
getIdp Value
owner [Char]
idpId 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
bertZHost

-- We must guard against domains being filled up with multiple IdPs and then
-- being configured as multi-ingress domains. Then, we'd have multiple IdPs for
-- a multi-ingress domain and cannot decide which one to choose. The solution
-- to this is that unconfigured domains' IdPs store no domain. I.e. the
-- assignment of domains to IdPs begins when the domain is configured as
-- multi-ingress domain.
testUnconfiguredDomain :: (HasCallStack) => App ()
testUnconfiguredDomain :: HasCallStack => App ()
testUnconfiguredDomain = [Maybe [Char]] -> (Maybe [Char] -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Maybe [Char]
forall a. Maybe a
Nothing, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
kermitZHost] ((Maybe [Char] -> App ()) -> App ())
-> (Maybe [Char] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Maybe [Char]
unconfiguredZHost -> do
  ServiceOverrides -> (HasCallStack => [Char] -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => [Char] -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def
      { sparCfg =
          removeField "saml.spSsoUri"
            >=> removeField "saml.spAppUri"
            >=> removeField "saml.contacts"
            >=> setField
              "saml.spDomainConfigs"
              (object [ernieZHost .= makeSpDomainConfig ernieZHost])
      }
    ((HasCallStack => [Char] -> App ()) -> App ())
-> (HasCallStack => [Char] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[Char]
domain -> do
      (Value
owner, [Char]
tid, [Value]
_) <- [Char] -> Int -> App (Value, [Char], [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, [Char], [Value])
createTeam [Char]
domain 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 -> [Char] -> [Char] -> [Char] -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> [Char] -> [Char] -> App Response
setTeamFeatureStatus Value
owner [Char]
tid [Char]
"sso" [Char]
"enabled"

      SAML.SampleIdP IdPMetadata
idpmeta1 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      [Char]
idpId1 <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) IdPMetadata
idpmeta1 App Response -> (Response -> App [Char]) -> App [Char]
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
201
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
ernieZHost
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

      -- From configured domain to unconfigured -> no multi-ingress domain
      Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner (Maybe [Char]
unconfiguredZHost) [Char]
idpId1 IdPMetadata
idpmeta1 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null

      Value -> [Char] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [Char] -> App Response
getIdp Value
owner [Char]
idpId1 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null

      -- From unconfigured back to configured -> add multi-ingress domain
      Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) [Char]
idpId1 IdPMetadata
idpmeta1 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
ernieZHost

      Value -> [Char] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [Char] -> App Response
getIdp Value
owner [Char]
idpId1 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
ernieZHost

      -- Create unconfigured -> no multi-ingress domain
      SAML.SampleIdP IdPMetadata
idpmeta2 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      [Char]
idpId2 <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner (Maybe [Char]
unconfiguredZHost) IdPMetadata
idpmeta2 App Response -> (Response -> App [Char]) -> App [Char]
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
201
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

      Value -> [Char] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [Char] -> App Response
getIdp Value
owner [Char]
idpId2 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null

      -- Create a second unconfigured -> no multi-ingress domain
      SAML.SampleIdP IdPMetadata
idpmeta3 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      [Char]
idpId3 <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner (Maybe [Char]
unconfiguredZHost) IdPMetadata
idpmeta3 App Response -> (Response -> App [Char]) -> App [Char]
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
201
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

      Value -> [Char] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [Char] -> App Response
getIdp Value
owner [Char]
idpId3 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null

testMultiIngressAtMostOneIdPPerDomain :: (HasCallStack) => App ()
testMultiIngressAtMostOneIdPPerDomain :: HasCallStack => App ()
testMultiIngressAtMostOneIdPPerDomain = do
  ServiceOverrides -> (HasCallStack => [Char] -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => [Char] -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def
      { sparCfg =
          removeField "saml.spSsoUri"
            >=> removeField "saml.spAppUri"
            >=> removeField "saml.contacts"
            >=> setField
              "saml.spDomainConfigs"
              ( object
                  [ ernieZHost .= makeSpDomainConfig ernieZHost,
                    bertZHost .= makeSpDomainConfig bertZHost
                  ]
              )
      }
    ((HasCallStack => [Char] -> App ()) -> App ())
-> (HasCallStack => [Char] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[Char]
domain -> do
      (Value
owner, [Char]
tid, [Value]
_) <- [Char] -> Int -> App (Value, [Char], [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, [Char], [Value])
createTeam [Char]
domain 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 -> [Char] -> [Char] -> [Char] -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> [Char] -> [Char] -> App Response
setTeamFeatureStatus Value
owner [Char]
tid [Char]
"sso" [Char]
"enabled"

      SAML.SampleIdP IdPMetadata
idpmeta1 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      [Char]
idpId1 <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) IdPMetadata
idpmeta1 App Response -> (Response -> App [Char]) -> App [Char]
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
201
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

      -- Creating a second IdP for the same domain -> failure
      SAML.SampleIdP IdPMetadata
idpmeta2 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      ()
_idpId2 <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) IdPMetadata
idpmeta2 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
409
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"label" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
"idp-duplicate-domain-for-team"

      -- Create an IdP for one domain and update it to another that already has one -> failure
      SAML.SampleIdP IdPMetadata
idpmeta3 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      [Char]
idpId3 <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
bertZHost) IdPMetadata
idpmeta2 App Response -> (Response -> App [Char]) -> App [Char]
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
201
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

      Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) [Char]
idpId3 IdPMetadata
idpmeta3
        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
409
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"label" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
"idp-duplicate-domain-for-team"

      -- Create an IdP with no domain and update it to a domain that already has one -> failure
      SAML.SampleIdP IdPMetadata
idpmeta4 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      [Char]
idpId4 <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner Maybe [Char]
forall a. Maybe a
Nothing IdPMetadata
idpmeta4 App Response -> (Response -> App [Char]) -> App [Char]
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
201
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

      Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) [Char]
idpId4 IdPMetadata
idpmeta4
        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
409
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"label" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
"idp-duplicate-domain-for-team"

      -- Updating an IdP itself should still work
      Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost
        Value
owner
        ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost)
        [Char]
idpId1
        -- The edIssuer needs to stay unchanged. Otherwise, deletion will fail
        -- with a 404 (see bug https://wearezeta.atlassian.net/browse/WPB-20407)
        (IdPMetadata
idpmeta2 IdPMetadata -> (IdPMetadata -> IdPMetadata) -> IdPMetadata
forall a b. a -> (a -> b) -> b
& (Issuer -> Identity Issuer) -> IdPMetadata -> Identity IdPMetadata
Lens' IdPMetadata Issuer
SAML.edIssuer ((Issuer -> Identity Issuer)
 -> IdPMetadata -> Identity IdPMetadata)
-> Issuer -> IdPMetadata -> IdPMetadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (IdPMetadata
idpmeta1 IdPMetadata -> Getting Issuer IdPMetadata Issuer -> Issuer
forall s a. s -> Getting a s a -> a
^. Getting Issuer IdPMetadata Issuer
Lens' IdPMetadata Issuer
SAML.edIssuer))
        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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
ernieZHost

      -- After deletion of the IdP of a domain, a new one can be created
      Value -> [Char] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [Char] -> App Response
deleteIdp Value
owner [Char]
idpId1 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
204

      SAML.SampleIdP IdPMetadata
idpmeta5 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      [Char]
idpId5 <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) IdPMetadata
idpmeta5 App Response -> (Response -> App [Char]) -> App [Char]
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
201
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
ernieZHost
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

      -- After deletion of the IdP of a domain, one can be moved from another domain
      SAML.SampleIdP IdPMetadata
idpmeta6 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
      Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
bertZHost) IdPMetadata
idpmeta6 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
409
        Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"label" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
"idp-duplicate-domain-for-team"

      Value -> [Char] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [Char] -> App Response
deleteIdp Value
owner [Char]
idpId3 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
204

      [Char]
idpId6 <-
        Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
bertZHost) IdPMetadata
idpmeta6 App Response -> (Response -> App [Char]) -> App [Char]
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
201
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
bertZHost
          Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

      Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) [Char]
idpId6 IdPMetadata
idpmeta6 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
409
        Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"label" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
"idp-duplicate-domain-for-team"

      Value -> [Char] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [Char] -> App Response
deleteIdp Value
owner [Char]
idpId5 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
204

      Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) [Char]
idpId6 IdPMetadata
idpmeta6
        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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> [Char] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Char]
ernieZHost

-- We only record the domain for multi-ingress setups.
testNonMultiIngressSetupsCanHaveMoreIdPsPerDomain :: (HasCallStack) => App ()
testNonMultiIngressSetupsCanHaveMoreIdPsPerDomain :: HasCallStack => App ()
testNonMultiIngressSetupsCanHaveMoreIdPsPerDomain = do
  (Value
owner, [Char]
tid, [Value]
_) <- Domain -> Int -> App (Value, [Char], [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, [Char], [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 -> [Char] -> [Char] -> [Char] -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> [Char] -> [Char] -> App Response
setTeamFeatureStatus Value
owner [Char]
tid [Char]
"sso" [Char]
"enabled"

  -- With Z-Host header
  SAML.SampleIdP IdPMetadata
idpmeta1 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
  [Char]
idpId1 <-
    Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) IdPMetadata
idpmeta1 App Response -> (Response -> App [Char]) -> App [Char]
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
201
      Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
      Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

  SAML.SampleIdP IdPMetadata
idpmeta2 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
  [Char]
idpId2 <-
    Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) IdPMetadata
idpmeta2 App Response -> (Response -> App [Char]) -> App [Char]
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
201
      Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
      Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

  SAML.SampleIdP IdPMetadata
idpmeta3 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
  Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) [Char]
idpId1 IdPMetadata
idpmeta3 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null

  SAML.SampleIdP IdPMetadata
idpmeta4 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
  Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
ernieZHost) [Char]
idpId2 IdPMetadata
idpmeta4 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null

  -- Without Z-Host header
  SAML.SampleIdP IdPMetadata
idpmeta5 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
  [Char]
idpId5 <-
    Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner Maybe [Char]
forall a. Maybe a
Nothing IdPMetadata
idpmeta5 App Response -> (Response -> App [Char]) -> App [Char]
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
201
      Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
      Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

  SAML.SampleIdP IdPMetadata
idpmeta6 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
  [Char]
idpId6 <-
    Value -> Maybe [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> IdPMetadata -> App Response
createIdpWithZHost Value
owner Maybe [Char]
forall a. Maybe a
Nothing IdPMetadata
idpmeta6 App Response -> (Response -> App [Char]) -> App [Char]
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
201
      Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null
      Response
resp.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"id" App Value -> (Value -> App [Char]) -> App [Char]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Char]
forall a. (HasCallStack, MakesValue a) => a -> App [Char]
asString

  SAML.SampleIdP IdPMetadata
idpmeta7 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
  Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner Maybe [Char]
forall a. Maybe a
Nothing [Char]
idpId5 IdPMetadata
idpmeta7 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null

  SAML.SampleIdP IdPMetadata
idpmeta8 SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
SAML.makeSampleIdPMetadata
  Value -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe [Char] -> [Char] -> IdPMetadata -> App Response
updateIdpWithZHost Value
owner Maybe [Char]
forall a. Maybe a
Nothing [Char]
idpId6 IdPMetadata
idpmeta8 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.jsonBody Maybe Value -> [Char] -> App Value
forall a. (HasCallStack, MakesValue a) => a -> [Char] -> App Value
%. [Char]
"extraInfo.domain" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
Null