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
      (owner, tid, _) <- [Char] -> Int -> App (Value, [Char], [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, [Char], [Value])
createTeam [Char]
domain Int
1
      void $ setTeamFeatureStatus owner tid "sso" "enabled"

      -- Create IdP for one domain
      SAML.SampleIdP idpmeta _ _ _ <- SAML.makeSampleIdPMetadata
      idpId <-
        createIdpWithZHost owner (Just ernieZHost) idpmeta `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

      getIdp owner idpId `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
      updateIdpWithZHost owner (Just bertZHost) idpId idpmeta `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

      getIdp owner idpId `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
      (owner, tid, _) <- [Char] -> Int -> App (Value, [Char], [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, [Char], [Value])
createTeam [Char]
domain Int
1
      void $ setTeamFeatureStatus owner tid "sso" "enabled"

      SAML.SampleIdP idpmeta1 _ _ _ <- SAML.makeSampleIdPMetadata
      idpId1 <-
        createIdpWithZHost owner (Just ernieZHost) idpmeta1 `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
      updateIdpWithZHost owner (unconfiguredZHost) idpId1 idpmeta1 `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

      getIdp owner idpId1 `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
      updateIdpWithZHost owner (Just ernieZHost) idpId1 idpmeta1 `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

      getIdp owner idpId1 `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 idpmeta2 _ _ _ <- SAML.makeSampleIdPMetadata
      idpId2 <-
        createIdpWithZHost owner (unconfiguredZHost) idpmeta2 `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

      getIdp owner idpId2 `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 idpmeta3 _ _ _ <- SAML.makeSampleIdPMetadata
      idpId3 <-
        createIdpWithZHost owner (unconfiguredZHost) idpmeta3 `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

      getIdp owner idpId3 `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
      (owner, tid, _) <- [Char] -> Int -> App (Value, [Char], [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, [Char], [Value])
createTeam [Char]
domain Int
1
      void $ setTeamFeatureStatus owner tid "sso" "enabled"

      SAML.SampleIdP idpmeta1 _ _ _ <- SAML.makeSampleIdPMetadata
      idpId1 <-
        createIdpWithZHost owner (Just ernieZHost) idpmeta1 `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 idpmeta2 _ _ _ <- SAML.makeSampleIdPMetadata
      _idpId2 <-
        createIdpWithZHost owner (Just ernieZHost) idpmeta2 `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 idpmeta3 _ _ _ <- SAML.makeSampleIdPMetadata
      idpId3 <-
        createIdpWithZHost owner (Just bertZHost) idpmeta2 `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

      updateIdpWithZHost owner (Just ernieZHost) idpId3 idpmeta3
        `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 idpmeta4 _ _ _ <- SAML.makeSampleIdPMetadata
      idpId4 <-
        createIdpWithZHost owner Nothing idpmeta4 `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

      updateIdpWithZHost owner (Just ernieZHost) idpId4 idpmeta4
        `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
      updateIdpWithZHost
        owner
        (Just ernieZHost)
        idpId1
        -- The edIssuer needs to stay unchanged. Otherwise, deletion will fail
        -- with a 404 (see bug https://wearezeta.atlassian.net/browse/WPB-20407)
        (idpmeta2 & SAML.edIssuer .~ (idpmeta1 ^. SAML.edIssuer))
        `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
      deleteIdp owner idpId1 `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204

      SAML.SampleIdP idpmeta5 _ _ _ <- SAML.makeSampleIdPMetadata
      idpId5 <-
        createIdpWithZHost owner (Just ernieZHost) idpmeta5 `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 idpmeta6 _ _ _ <- SAML.makeSampleIdPMetadata
      createIdpWithZHost owner (Just bertZHost) idpmeta6 `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"

      deleteIdp owner idpId3 `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204

      idpId6 <-
        createIdpWithZHost owner (Just bertZHost) idpmeta6 `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

      updateIdpWithZHost owner (Just ernieZHost) idpId6 idpmeta6 `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"

      deleteIdp owner idpId5 `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
204

      updateIdpWithZHost owner (Just ernieZHost) idpId6 idpmeta6
        `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
  (owner, tid, _) <- Domain -> Int -> App (Value, [Char], [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, [Char], [Value])
createTeam Domain
OwnDomain Int
1
  void $ setTeamFeatureStatus owner tid "sso" "enabled"

  -- With Z-Host header
  SAML.SampleIdP idpmeta1 _ _ _ <- SAML.makeSampleIdPMetadata
  idpId1 <-
    createIdpWithZHost owner (Just ernieZHost) idpmeta1 `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 idpmeta2 _ _ _ <- SAML.makeSampleIdPMetadata
  idpId2 <-
    createIdpWithZHost owner (Just ernieZHost) idpmeta2 `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 idpmeta3 _ _ _ <- SAML.makeSampleIdPMetadata
  updateIdpWithZHost owner (Just ernieZHost) idpId1 idpmeta3 `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 idpmeta4 _ _ _ <- SAML.makeSampleIdPMetadata
  updateIdpWithZHost owner (Just ernieZHost) idpId2 idpmeta4 `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 idpmeta5 _ _ _ <- SAML.makeSampleIdPMetadata
  idpId5 <-
    createIdpWithZHost owner Nothing idpmeta5 `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 idpmeta6 _ _ _ <- SAML.makeSampleIdPMetadata
  idpId6 <-
    createIdpWithZHost owner Nothing idpmeta6 `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 idpmeta7 _ _ _ <- SAML.makeSampleIdPMetadata
  updateIdpWithZHost owner Nothing idpId5 idpmeta7 `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 idpmeta8 _ _ _ <- SAML.makeSampleIdPMetadata
  updateIdpWithZHost owner Nothing idpId6 idpmeta8 `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