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.Certs (fingerprintHex)
import Testlib.Prelude
import qualified Text.XML.DSig as XMLDSig

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
  credsWithCert@(_, _, signedCert) <- Maybe DateTime
-> Int -> App (SignPrivCreds, SignCreds, SignedCertificate)
forall (m :: * -> *).
(MonadRandom m, MonadIO m) =>
Maybe DateTime
-> Int -> m (SignPrivCreds, SignCreds, SignedCertificate)
XMLDSig.mkSignCredsWithCert Maybe DateTime
forall a. Maybe a
Nothing Int
96
  withModifiedBackend
    def
      { sparCfg =
          removeField "saml.spSsoUri"
            >=> removeField "saml.spAppUri"
            >=> removeField "saml.contacts"
            >=> setField
              "saml.spDomainConfigs"
              ( object
                  [ ernieZHost .= makeSpDomainConfig ernieZHost,
                    bertZHost .= makeSpDomainConfig bertZHost,
                    kermitZHost .= makeSpDomainConfig kermitZHost
                  ]
              )
            >=> setField "idpCertFingerprintAllowlist" [fingerprintHex signedCert]
      }
    $ \[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.makeSampleIdPMetadataWithCert credsWithCert
      idpId <-
        createIdpWithZHostV2 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.json 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.json 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.json 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.json 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.json 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
  credsWithCert1@(_, _, signedCert1) <- Maybe DateTime
-> Int -> App (SignPrivCreds, SignCreds, SignedCertificate)
forall (m :: * -> *).
(MonadRandom m, MonadIO m) =>
Maybe DateTime
-> Int -> m (SignPrivCreds, SignCreds, SignedCertificate)
XMLDSig.mkSignCredsWithCert Maybe DateTime
forall a. Maybe a
Nothing Int
96
  credsWithCert2@(_, _, signedCert2) <- XMLDSig.mkSignCredsWithCert Nothing 96
  credsWithCert3@(_, _, signedCert3) <- XMLDSig.mkSignCredsWithCert Nothing 96
  withModifiedBackend
    def
      { sparCfg =
          removeField "saml.spSsoUri"
            >=> removeField "saml.spAppUri"
            >=> removeField "saml.contacts"
            >=> setField
              "saml.spDomainConfigs"
              (object [ernieZHost .= makeSpDomainConfig ernieZHost])
            >=> setField "idpCertFingerprintAllowlist" (fingerprintHex <$> [signedCert1, signedCert2, signedCert3])
      }
    $ \[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.makeSampleIdPMetadataWithCert credsWithCert1
      idpId1 <-
        createIdpWithZHostV2 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.json 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.json 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.json 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.json 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.json 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.json 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.makeSampleIdPMetadataWithCert credsWithCert2
      idpId2 <-
        createIdpWithZHostV2 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.json 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.json 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.json 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.makeSampleIdPMetadataWithCert credsWithCert3
      idpId3 <-
        createIdpWithZHostV2 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.json 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.json 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.json 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
  credsWithCert1@(_, _, signedCert1) <- Maybe DateTime
-> Int -> App (SignPrivCreds, SignCreds, SignedCertificate)
forall (m :: * -> *).
(MonadRandom m, MonadIO m) =>
Maybe DateTime
-> Int -> m (SignPrivCreds, SignCreds, SignedCertificate)
XMLDSig.mkSignCredsWithCert Maybe DateTime
forall a. Maybe a
Nothing Int
96
  credsWithCert2@(_, _, signedCert2) <- XMLDSig.mkSignCredsWithCert Nothing 96
  credsWithCert3@(_, _, signedCert3) <- XMLDSig.mkSignCredsWithCert Nothing 96
  credsWithCert4@(_, _, signedCert4) <- XMLDSig.mkSignCredsWithCert Nothing 96
  credsWithCert5@(_, _, signedCert5) <- XMLDSig.mkSignCredsWithCert Nothing 96
  credsWithCert6@(_, _, signedCert6) <- XMLDSig.mkSignCredsWithCert Nothing 96
  withModifiedBackend
    def
      { sparCfg =
          removeField "saml.spSsoUri"
            >=> removeField "saml.spAppUri"
            >=> removeField "saml.contacts"
            >=> setField
              "saml.spDomainConfigs"
              ( object
                  [ ernieZHost .= makeSpDomainConfig ernieZHost,
                    bertZHost .= makeSpDomainConfig bertZHost,
                    kermitZHost .= makeSpDomainConfig kermitZHost
                  ]
              )
            >=> setField
              "idpCertFingerprintAllowlist"
              ( fingerprintHex
                  <$> [signedCert1, signedCert2, signedCert3, signedCert4, signedCert5, signedCert6]
              )
      }
    $ \[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.makeSampleIdPMetadataWithCert credsWithCert1
      idpId1 <-
        createIdpWithZHostV2 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.json 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.makeSampleIdPMetadataWithCert credsWithCert2
      _idpId2 <-
        createIdpWithZHostV2 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.json 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.makeSampleIdPMetadataWithCert credsWithCert3
      idpId3 <-
        createIdpWithZHostV2 owner (Just bertZHost) idpmeta3 `bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
          Response
resp.json 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.json 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.makeSampleIdPMetadataWithCert credsWithCert4
      idpId4 <-
        createIdpWithZHostV2 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.json 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.json 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.json 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.makeSampleIdPMetadataWithCert credsWithCert5
      idpId5 <-
        createIdpWithZHostV2 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.json 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.json 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.makeSampleIdPMetadataWithCert credsWithCert6
      createIdpWithZHostV2 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.json 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 <-
        createIdpWithZHostV2 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.json 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.json 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.json 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.json 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 <-
    createIdpWithZHostV2 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.json 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.json 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 <-
    createIdpWithZHostV2 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.json 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.json 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.json 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.json 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 <-
    createIdpWithZHostV2 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.json 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.json 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 <-
    createIdpWithZHostV2 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.json 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.json 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.json 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.json 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

-- | The `validateNewIdP` rules for IdP creation apply to multi-ingress setups as
-- well. Depending on the IdP API version, IdP issuers have to be either unique
-- per backend (V1) or per team (V2).
--
-- Note: In multi-ingress setups, one might wonder why the same IdP metadata /
-- issuer cannot be used for the same team across multiple domains. Supporting
-- this would require redesigning spar's database schema (e.g., there would be
-- a race condition on the `spar.issuer_idp_v2` table). Furthermore, IdP
-- configs are strongly URL-related on IdP-side: issuers correspond to e.g.
-- Keycloak realms, which have a specific return-URL. Given the limited
-- practical benefit, this complexity is not justified for now.
testMultiIngressIdPIssuerDifferentDomains :: (HasCallStack) => App ()
testMultiIngressIdPIssuerDifferentDomains :: HasCallStack => App ()
testMultiIngressIdPIssuerDifferentDomains = do
  credsWithCertV1@(_, _, signedCertV1) <- Maybe DateTime
-> Int -> App (SignPrivCreds, SignCreds, SignedCertificate)
forall (m :: * -> *).
(MonadRandom m, MonadIO m) =>
Maybe DateTime
-> Int -> m (SignPrivCreds, SignCreds, SignedCertificate)
XMLDSig.mkSignCredsWithCert Maybe DateTime
forall a. Maybe a
Nothing Int
96
  credsWithCertV1_alt@(_, _, signedCertV1_alt) <- XMLDSig.mkSignCredsWithCert Nothing 96
  credsWithCertV1_differentIssuer@(_, _, signedCertV1_differentIssuer) <- XMLDSig.mkSignCredsWithCert Nothing 96
  credsWithCertV2@(_, _, signedCertV2) <- XMLDSig.mkSignCredsWithCert Nothing 96
  credsWithCertV2_alt@(_, _, signedCertV2_alt) <- XMLDSig.mkSignCredsWithCert Nothing 96
  withModifiedBackend
    def
      { sparCfg =
          removeField "saml.spSsoUri"
            >=> removeField "saml.spAppUri"
            >=> removeField "saml.contacts"
            >=> setField
              "saml.spDomainConfigs"
              ( object
                  [ ernieZHost .= makeSpDomainConfig ernieZHost,
                    bertZHost .= makeSpDomainConfig bertZHost,
                    kermitZHost .= makeSpDomainConfig kermitZHost
                  ]
              )
            >=> setField
              "idpCertFingerprintAllowlist"
              ( fingerprintHex
                  <$> [ signedCertV1,
                        signedCertV1_alt,
                        signedCertV1_differentIssuer,
                        signedCertV2,
                        signedCertV2_alt
                      ]
              )
      }
    $ \[Char]
domain -> do
      -- V1 API: Issuers must be unique per backend (across all teams)
      (owner1, tid1, _) <- [Char] -> Int -> App (Value, [Char], [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, [Char], [Value])
createTeam [Char]
domain Int
1
      void $ setTeamFeatureStatus owner1 tid1 "sso" "enabled"

      -- Create first IdP metadata for V1
      SAML.SampleIdP idpmetaV1 _ _ _ <- SAML.makeSampleIdPMetadataWithCert credsWithCertV1
      _idpId1 <-
        createIdpWithZHostV1 owner1 (Just ernieZHost) idpmetaV1 `bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
          Response
resp.json 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.json 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

      -- Try to create V1 IdP on a different team with different metadata but same issuer -> failure
      -- Test with different domains to show constraint is domain-independent
      (owner2, tid2, _) <- createTeam domain 1
      void $ setTeamFeatureStatus owner2 tid2 "sso" "enabled"

      -- Try with same domain as original -> should fail (V1 global uniqueness)
      SAML.SampleIdP idpmetaV1_alt _ _ _ <- SAML.makeSampleIdPMetadataWithCert credsWithCertV1_alt
      let idpmetaV1_alt_sameIssuer = IdPMetadata
idpmetaV1_alt 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
idpmetaV1 IdPMetadata -> Getting Issuer IdPMetadata Issuer -> Issuer
forall s a. s -> Getting a s a -> a
^. Getting Issuer IdPMetadata Issuer
Lens' IdPMetadata Issuer
SAML.edIssuer)

      createIdpWithZHostV1 owner2 (Just ernieZHost) idpmetaV1_alt_sameIssuer `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
        Response
resp.json 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-already-in-use"

      -- Try with different domain -> should also fail (V1 global uniqueness)
      createIdpWithZHostV1 owner2 (Just bertZHost) idpmetaV1_alt_sameIssuer `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
        Response
resp.json 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-already-in-use"

      -- Try with no domain -> should also fail (V1 global uniqueness)
      createIdpWithZHostV1 owner2 Nothing idpmetaV1_alt_sameIssuer `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
        Response
resp.json 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-already-in-use"

      -- Counter-example: V1 IdP with different issuer -> success
      SAML.SampleIdP idpmetaV1_differentIssuer _ _ _ <- SAML.makeSampleIdPMetadataWithCert credsWithCertV1_differentIssuer
      void
        $ createIdpWithZHostV1 owner2 (Just ernieZHost) idpmetaV1_differentIssuer
        `bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

      -- V2 API: Issuers must be unique per team (but can be reused across teams)
      -- Use a different issuer than V1 to avoid API version mixing errors
      (owner3, tid3, _) <- createTeam domain 1
      void $ setTeamFeatureStatus owner3 tid3 "sso" "enabled"

      -- Create V2 IdP on team 3 with new issuer
      SAML.SampleIdP idpmetaV2 _ _ _ <- SAML.makeSampleIdPMetadataWithCert credsWithCertV2

      _idpId3 <-
        createIdpWithZHostV2 owner3 (Just ernieZHost) idpmetaV2 `bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
          Response
resp.json 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.json 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

      -- Try to create another V2 IdP on same team with different metadata but same issuer -> failure
      -- First, try with the same domain -> hits domain constraint (409)
      SAML.SampleIdP idpmetaV2_alt _ _ _ <- SAML.makeSampleIdPMetadataWithCert credsWithCertV2_alt
      let idpmetaV2_alt_sameIssuer = IdPMetadata
idpmetaV2_alt 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
idpmetaV2 IdPMetadata -> Getting Issuer IdPMetadata Issuer -> Issuer
forall s a. s -> Getting a s a -> a
^. Getting Issuer IdPMetadata Issuer
Lens' IdPMetadata Issuer
SAML.edIssuer)

      createIdpWithZHostV2 owner3 (Just ernieZHost) idpmetaV2_alt_sameIssuer `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
409
        Response
resp.json 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"

      -- Try with a different domain -> hits issuer constraint (400)
      createIdpWithZHostV2 owner3 (Just bertZHost) idpmetaV2_alt_sameIssuer `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
        Response
resp.json 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-already-in-use"

      -- Try with no domain -> hits issuer constraint (400)
      createIdpWithZHostV2 owner3 Nothing idpmetaV2_alt_sameIssuer `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
        Response
resp.json 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-already-in-use"

      -- Counter-example: V2 IdP with same issuer on different team -> success (different team)
      (owner4, tid4, _) <- createTeam domain 1
      void $ setTeamFeatureStatus owner4 tid4 "sso" "enabled"

      void
        $ createIdpWithZHostV2 owner4 (Just ernieZHost) idpmetaV2_alt_sameIssuer
        `bindResponse` \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
          Response
resp.json 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