diff --git a/integration/integration.cabal b/integration/integration.cabal index 2a4fb71b60d..9121baea9b2 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -206,6 +206,7 @@ library Test.Shape Test.Spar Test.Spar.GetByEmail + Test.Spar.MultiIngressCrossIdpSso Test.Spar.MultiIngressIdp Test.Spar.MultiIngressSSO Test.Spar.STM diff --git a/integration/test/Test/Spar/MultiIngressCrossIdpSso.hs b/integration/test/Test/Spar/MultiIngressCrossIdpSso.hs new file mode 100644 index 00000000000..0e5e052bb7c --- /dev/null +++ b/integration/test/Test/Spar/MultiIngressCrossIdpSso.hs @@ -0,0 +1,620 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.Spar.MultiIngressCrossIdpSso where + +import API.BrigInternal (getUsersId) +import API.Common (randomEmail) +import API.GalleyInternal (setTeamFeatureStatus) +import API.Spar (CreateScimToken (..), createIdpWithZHostV2, createScimToken, createScimUser, getSsoCodeByEmailWithZHost) +import Data.Either.Extra +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Text (pack) +import GHC.Stack +import qualified SAML2.WebSSO as SAML +import SAML2.WebSSO.Test.Util (SampleIdP (..)) +import SetupHelpers +import Testlib.Prelude +import qualified Text.XML.DSig as SAML + +-- TODO: +-- - Test New user creation with email (user has NO representation in spar) +-- - Test with wrong IdP + +-- | Test that demonstrates username-based NameID behavior in multi-ingress SSO. +-- +-- When using username-based (unspecified) NameID, logging in via different +-- ingresses with different IdPs creates SEPARATE user accounts, even with the +-- same NameID. We decided this because username NameIDs are more likely +-- ambiguous across IdPs than email addresses. +testCrossIdpSsoCreatesDistinctUsers :: (HasCallStack) => App () +testCrossIdpSsoCreatesDistinctUsers = do + let ernieZHost = "nginz-https.ernie.example.com" + bertZHost = "nginz-https.bert.example.com" + + withModifiedBackend + def + { sparCfg = + removeField "saml.spSsoUri" + >=> removeField "saml.spAppUri" + >=> removeField "saml.contacts" + >=> setField + "saml.spDomainConfigs" + ( object + [ ernieZHost + .= object + [ "spAppUri" .= ("https://webapp.ernie.example.com" :: String), + "spSsoUri" .= ("https://nginz-https.ernie.example.com/sso" :: String), + "contacts" .= [object ["type" .= ("ContactTechnical" :: String)]] + ], + bertZHost + .= object + [ "spAppUri" .= ("https://webapp.bert.example.com" :: String), + "spSsoUri" .= ("https://nginz-https.bert.example.com/sso" :: String), + "contacts" .= [object ["type" .= ("ContactTechnical" :: String)]] + ] + ] + ) + >=> setField "enableIdPByEmailDiscovery" True + } + $ \domain -> do + -- Create team and enable SSO + (owner, tid, _) <- createTeam domain 1 + void $ setTeamFeatureStatus owner tid "sso" "enabled" + + -- Register IdP for Ernie domain + (idpErnie, idpMetaErnie) <- registerTestIdPWithMetaWithPrivateCredsForZHost owner (Just ernieZHost) + idpIdErnie <- asString $ idpErnie.json %. "id" + + -- Register IdP for Bert domain + (idpBert, idpMetaBert) <- registerTestIdPWithMetaWithPrivateCredsForZHost owner (Just bertZHost) + idpIdBert <- asString $ idpBert.json %. "id" + + -- Create user identity "bibo" - this same person will login on both ingresses + -- Use unspecified NameID format (not email) to avoid email uniqueness constraint + suffix <- take 8 <$> randomId + let biboNameId = + fromRight (error "could not create name id") + $ SAML.mkNameID (SAML.mkUNameIDUnspecified (pack ("bibo" <> suffix))) Nothing Nothing Nothing + + -- Step 2: Bibo logs in on Ernie ingress + userIdErnie <- + loginWithSamlWithZHost + (Just ernieZHost) + domain + True + tid + biboNameId + (idpIdErnie, idpMetaErnie) + >>= maybe (error "Expected user ID from SSO login on Ernie domain") pure + . fst + + -- No email activation needed - using username-based NameID + + -- Verify user was created + getUsersId domain [userIdErnie] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + + -- Step 2.5: Verify re-login on Ernie domain (prove SSO works correctly) + (mUserIdErnieAgain, _) <- + loginWithSamlWithZHost + (Just ernieZHost) + domain + True + tid + biboNameId + (idpIdErnie, idpMetaErnie) + + -- Verify it's the same user ID (no new user created) + case mUserIdErnieAgain of + Just uid -> uid `shouldMatch` userIdErnie + Nothing -> error "Expected user ID from re-login on Ernie domain" + + -- Step 3: SAME Bibo logs in on Bert ingress WITH THE SAME NAMEID + -- This is the core of the test: same identity, different ingress → duplicate user! + userIdBert <- + loginWithSamlWithZHost + (Just bertZHost) + domain + True + tid + biboNameId -- SAME NameID! + (idpIdBert, idpMetaBert) + >>= maybe (error "Expected user ID from SSO login on Bert domain") pure + . fst + + -- Verify user was created + getUsersId domain [userIdBert] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + + -- Step 4: Verification - CORE ASSERTION + -- This is the key finding: same person (conceptually) has two separate Wire accounts + userIdErnie `shouldNotMatch` userIdBert + + -- Verify both users exist independently and each user is bound to their respective IdP + getUsersId domain [userIdErnie] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + idpErnieIssuer <- idpErnie.json %. "metadata.issuer" >>= asString + -- tenant contains XML with issuer inside + ssoIdTenant `shouldContain` idpErnieIssuer + + getUsersId domain [userIdBert] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + idpBertIssuer <- idpBert.json %. "metadata.issuer" >>= asString + -- tenant contains XML with issuer inside + ssoIdTenant `shouldContain` idpBertIssuer + + -- Verify both users can re-login on their original ingresses + -- Same biboNameId, but each ingress returns a different user! + (mUidErnieFinal, _) <- + loginWithSamlWithZHost + (Just ernieZHost) + domain + True + tid + biboNameId + (idpIdErnie, idpMetaErnie) + + case mUidErnieFinal of + Just uid -> uid `shouldMatch` userIdErnie + Nothing -> error "Expected user ID from Ernie final re-login" + + (mUidBertFinal, _) <- + loginWithSamlWithZHost + (Just bertZHost) + domain + True + tid + biboNameId + (idpIdBert, idpMetaBert) + + case mUidBertFinal of + Just uid -> uid `shouldMatch` userIdBert + Nothing -> error "Expected user ID from Bert final re-login" + +-- | Test that demonstrates cross-IdP login with an email address +-- +-- User can login with different IdPs. This is different from username-based +-- NameID (tested above) where duplicate users are created. +testCrossIdpSsoEmailConflict :: (HasCallStack) => Bool -> App () +testCrossIdpSsoEmailConflict useSCIM = do + let ernieZHost = "nginz-https.ernie.example.com" + bertZHost = "nginz-https.bert.example.com" + + withModifiedBackend + def + { sparCfg = + removeField "saml.spSsoUri" + >=> removeField "saml.spAppUri" + >=> removeField "saml.contacts" + >=> setField + "saml.spDomainConfigs" + ( object + [ ernieZHost + .= object + [ "spAppUri" .= ("https://webapp.ernie.example.com" :: String), + "spSsoUri" .= ("https://nginz-https.ernie.example.com/sso" :: String), + "contacts" .= [object ["type" .= ("ContactTechnical" :: String)]] + ], + bertZHost + .= object + [ "spAppUri" .= ("https://webapp.bert.example.com" :: String), + "spSsoUri" .= ("https://nginz-https.bert.example.com/sso" :: String), + "contacts" .= [object ["type" .= ("ContactTechnical" :: String)]] + ] + ] + ) + >=> setField "enableIdPByEmailDiscovery" True + } + $ \domain -> do + -- Create team and enable SSO + (owner, tid, _) <- createTeam domain 1 + void $ setTeamFeatureStatus owner tid "sso" "enabled" + + -- Register IdP for Ernie domain with fixed issuer "ernie" + SampleIdP idpMetaErnie pCredsErnie _ _ <- makeSampleIdPMetadataWithIssuer "ernie" + idpErnie <- createIdpWithZHostV2 owner (Just ernieZHost) idpMetaErnie + idpIdErnie <- asString $ idpErnie.json %. "id" + + -- Register IdP for Bert domain with fixed issuer "bert" + SampleIdP idpMetaBert pCredsBert _ _ <- makeSampleIdPMetadataWithIssuer "bert" + idpBert <- createIdpWithZHostV2 owner (Just bertZHost) idpMetaBert + idpIdBert <- asString $ idpBert.json %. "id" + + -- Create email-based NameID for "bibo" + biboEmail <- randomEmail + let biboNameId = + fromRight (error "could not create name id") + $ SAML.emailNameID (pack biboEmail) + + -- Optionally create the user via SCIM (and not automatically) + mScimUserId <- + if useSCIM + then do + -- Create SCIM token associated with Ernie's IdP + scimTok <- createScimToken owner (def {idp = Just idpIdErnie}) + scimToken <- scimTok.json %. "token" & asString + + -- Create SCIM user with the email + scimUser <- randomScimUserWithEmail biboEmail biboEmail + scimUid <- bindResponse (createScimUser domain scimToken scimUser) $ \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "id" >>= asString + + activateEmail domain biboEmail + + pure (Just scimUid) + else pure Nothing + + -- Step 1: Bibo logs in on Ernie ingress (should succeed) + userIdErnie <- + loginWithSamlWithZHost + (Just ernieZHost) + domain + True -- expect success + tid + biboNameId + (idpIdErnie, (idpMetaErnie, pCredsErnie)) + >>= maybe (error "Expected user ID from SSO login on Ernie domain") pure + . fst + + case mScimUserId of + Just scimUid -> + -- Validate that SCIM-created user matches SSO login user + scimUid `shouldMatch` userIdErnie + Nothing -> activateEmail domain biboEmail + + -- Verify user's SSO ID has Ernie's issuer (not Bert's) + getUsersId domain [userIdErnie] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + ernieIssuer <- idpErnie.json %. "metadata.issuer" >>= asString + bertIssuer <- idpBert.json %. "metadata.issuer" >>= asString + ssoIdTenant `shouldContain` ernieIssuer + ssoIdTenant `shouldNotMatch` bertIssuer + + -- Verify sso/get-by-email returns Ernie's IdP + getSsoCodeByEmailWithZHost domain (Just ernieZHost) biboEmail `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoCodeStr <- resp.json %. "sso_code" >>= asString + ssoCodeStr `shouldMatch` idpIdErnie + + -- Step 1.5: Bibo re-logs in on Ernie (should succeed - proves SSO works on same ingress) + (mUserIdErnieAgain, _) <- + loginWithSamlWithZHost + (Just ernieZHost) + domain + True -- expect success + tid + biboNameId + (idpIdErnie, (idpMetaErnie, pCredsErnie)) + + case mUserIdErnieAgain of + Just uid -> uid `shouldMatch` userIdErnie + Nothing -> error "Expected user ID from re-login on Ernie domain" + + -- Step 2: Same Bibo logs in on Bert ingress with SAME email + -- This should SUCCEED because cross-IdP SSO migration is enabled: + -- the email matches an existing user in the team, so we return that user + (mUserIdBert, _) <- + loginWithSamlWithZHost + (Just bertZHost) + domain + True -- expect success + tid + biboNameId + (idpIdBert, (idpMetaBert, pCredsBert)) + + -- Verify the same user ID is returned (cross-IdP SSO migration worked) + case mUserIdBert of + Just uid -> uid `shouldMatch` userIdErnie + Nothing -> error "Expected user ID from cross-IdP SSO login on Bert domain" + + -- Verify user's SSO ID was migrated to Bert's issuer (not Ernie's anymore) + getUsersId domain [userIdErnie] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + ernieIssuer <- idpErnie.json %. "metadata.issuer" >>= asString + bertIssuer <- idpBert.json %. "metadata.issuer" >>= asString + ssoIdTenant `shouldContain` bertIssuer + ssoIdTenant `shouldNotMatch` ernieIssuer + + -- Verify sso/get-by-email returns Bert's IdP after migration + getSsoCodeByEmailWithZHost domain (Just bertZHost) biboEmail `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoCodeStr <- resp.json %. "sso_code" >>= asString + ssoCodeStr `shouldMatch` idpIdBert + + -- Step 3: Login on Ernie again to show back-and-forth migration works + (mUserIdErnieFinal, _) <- + loginWithSamlWithZHost + (Just ernieZHost) + domain + True -- expect success + tid + biboNameId + (idpIdErnie, (idpMetaErnie, pCredsErnie)) + + case mUserIdErnieFinal of + Just uid -> uid `shouldMatch` userIdErnie + Nothing -> error "Expected user ID from final login on Ernie domain" + + -- Verify user's SSO ID was migrated back to Ernie's issuer + getUsersId domain [userIdErnie] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + ernieIssuer <- idpErnie.json %. "metadata.issuer" >>= asString + bertIssuer <- idpBert.json %. "metadata.issuer" >>= asString + ssoIdTenant `shouldContain` ernieIssuer + ssoIdTenant `shouldNotMatch` bertIssuer + + -- Verify sso/get-by-email returns Ernie's IdP after migration back + getSsoCodeByEmailWithZHost domain (Just ernieZHost) biboEmail `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoCodeStr <- resp.json %. "sso_code" >>= asString + ssoCodeStr `shouldMatch` idpIdErnie + +-- | Test that demonstrates cross-IdP SSO migration when a SCIM user provisioned for one IdP +-- logs in for the first time via a different IdP. +-- +-- Scenario: +-- 1. SCIM user is provisioned for Ernie's IdP (has SSO credentials for Ernie) +-- 2. User has NEVER logged in via SSO before (only provisioned via SCIM) +-- 3. User logs in for the FIRST time via Bert's IdP (different IdP) +-- 4. Expected: Cross-IdP SSO migration should work, user should be migrated to Bert's IdP +testScimUserLoginsDifferentIdP :: (HasCallStack) => App () +testScimUserLoginsDifferentIdP = do + let ernieZHost = "nginz-https.ernie.example.com" + bertZHost = "nginz-https.bert.example.com" + + withModifiedBackend + def + { sparCfg = + removeField "saml.spSsoUri" + >=> removeField "saml.spAppUri" + >=> removeField "saml.contacts" + >=> setField + "saml.spDomainConfigs" + ( object + [ ernieZHost + .= object + [ "spAppUri" .= ("https://webapp.ernie.example.com" :: String), + "spSsoUri" .= ("https://nginz-https.ernie.example.com/sso" :: String), + "contacts" .= [object ["type" .= ("ContactTechnical" :: String)]] + ], + bertZHost + .= object + [ "spAppUri" .= ("https://webapp.bert.example.com" :: String), + "spSsoUri" .= ("https://nginz-https.bert.example.com/sso" :: String), + "contacts" .= [object ["type" .= ("ContactTechnical" :: String)]] + ] + ] + ) + >=> setField "enableIdPByEmailDiscovery" True + } + $ \domain -> do + -- Create team and enable SSO + (owner, tid, _) <- createTeam domain 1 + void $ setTeamFeatureStatus owner tid "sso" "enabled" + + -- Register IdP for Ernie domain with fixed issuer "ernie" + SampleIdP idpMetaErnie pCredsErnie _ _ <- makeSampleIdPMetadataWithIssuer "ernie" + idpErnie <- createIdpWithZHostV2 owner (Just ernieZHost) idpMetaErnie + idpIdErnie <- asString $ idpErnie.json %. "id" + + -- Register IdP for Bert domain with fixed issuer "bert" + SampleIdP idpMetaBert pCredsBert _ _ <- makeSampleIdPMetadataWithIssuer "bert" + idpBert <- createIdpWithZHostV2 owner (Just bertZHost) idpMetaBert + idpIdBert <- asString $ idpBert.json %. "id" + + -- Create email-based NameID for "bibo" + biboEmail <- randomEmail + let biboNameId = + fromRight (error "could not create name id") + $ SAML.emailNameID (pack biboEmail) + + -- Provision SCIM user for Ernie's IdP + scimTok <- createScimToken owner (def {idp = Just idpIdErnie}) + scimToken <- scimTok.json %. "token" & asString + + -- Create SCIM user with the email (associated with Ernie's IdP) + scimUser <- randomScimUserWithEmail biboEmail biboEmail + biboUid <- bindResponse (createScimUser domain scimToken scimUser) $ \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "id" >>= asString + + -- Activate the email + activateEmail domain biboEmail + + -- Verify user was created with Ernie's SSO ID + getUsersId domain [biboUid] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + ernieIssuer <- idpErnie.json %. "metadata.issuer" >>= asString + ssoIdTenant `shouldContain` ernieIssuer + + -- Step 1: Bibo logs in for the FIRST time on Bert's IdP (NOT Ernie!) + -- This tests cross-IdP migration when user has never logged in before (only SCIM provisioned) + userIdBert <- + loginWithSamlWithZHost + (Just bertZHost) + domain + True -- expect success + tid + biboNameId + (idpIdBert, (idpMetaBert, pCredsBert)) + >>= maybe (error "Expected user ID from cross-IdP SSO login on Bert domain") pure + . fst + + -- Verify the same user ID is returned (cross-IdP SSO migration worked) + userIdBert `shouldMatch` biboUid + + -- Verify user's SSO ID was migrated to Bert's issuer + getUsersId domain [userIdBert] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + ernieIssuer <- idpErnie.json %. "metadata.issuer" >>= asString + bertIssuer <- idpBert.json %. "metadata.issuer" >>= asString + ssoIdTenant `shouldContain` bertIssuer + ssoIdTenant `shouldNotMatch` ernieIssuer + + -- Verify sso/get-by-email returns Bert's IdP after migration + getSsoCodeByEmailWithZHost domain (Just bertZHost) biboEmail `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoCodeStr <- resp.json %. "sso_code" >>= asString + ssoCodeStr `shouldMatch` idpIdBert + + -- Step 2: Login on Ernie to verify back-migration also works + (mUserIdErnie, _) <- + loginWithSamlWithZHost + (Just ernieZHost) + domain + True -- expect success + tid + biboNameId + (idpIdErnie, (idpMetaErnie, pCredsErnie)) + + case mUserIdErnie of + Just uid -> uid `shouldMatch` biboUid + Nothing -> error "Expected user ID from login on Ernie domain" + + -- Verify user's SSO ID was migrated back to Ernie's issuer + getUsersId domain [biboUid] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + ernieIssuer <- idpErnie.json %. "metadata.issuer" >>= asString + bertIssuer <- idpBert.json %. "metadata.issuer" >>= asString + ssoIdTenant `shouldContain` ernieIssuer + ssoIdTenant `shouldNotMatch` bertIssuer + +-- | Test cross-domain login when team has a single IdP. +-- +-- As IdPs cannot be deleted when users are bound to them, having a single IdP +-- implies that all SSO users are bound to it. +testSingleIdp :: (HasCallStack) => App () +testSingleIdp = do + let ernieZHost = "nginz-https.ernie.example.com" + bertZHost = "nginz-https.bert.example.com" + + withModifiedBackend + def + { sparCfg = + removeField "saml.spSsoUri" + >=> removeField "saml.spAppUri" + >=> removeField "saml.contacts" + >=> setField + "saml.spDomainConfigs" + ( object + [ ernieZHost + .= object + [ "spAppUri" .= ("https://webapp.ernie.example.com" :: String), + "spSsoUri" .= ("https://nginz-https.ernie.example.com/sso" :: String), + "contacts" .= [object ["type" .= ("ContactTechnical" :: String)]] + ], + bertZHost + .= object + [ "spAppUri" .= ("https://webapp.bert.example.com" :: String), + "spSsoUri" .= ("https://nginz-https.bert.example.com/sso" :: String), + "contacts" .= [object ["type" .= ("ContactTechnical" :: String)]] + ] + ] + ) + >=> setField "enableIdPByEmailDiscovery" True + } + $ \domain -> do + -- Create team and enable SSO + (owner, tid, _) <- createTeam domain 1 + void $ setTeamFeatureStatus owner tid "sso" "enabled" + + -- Register ONLY ONE IdP for Bert domain + -- This is the key: there's only a single IdP for the team + SampleIdP idpMetaBert pCredsBert _ _ <- makeSampleIdPMetadataWithIssuer "bert" + idpBert <- createIdpWithZHostV2 owner (Just bertZHost) idpMetaBert + idpIdBert <- asString $ idpBert.json %. "id" + + -- Create email-based NameID for "bibo" + biboEmail <- randomEmail + let biboNameId = + fromRight (error "could not create name id") + $ SAML.emailNameID (pack biboEmail) + + -- Provision SCIM user for Bert's IdP + scimTok <- createScimToken owner (def {idp = Just idpIdBert}) + scimToken <- scimTok.json %. "token" & asString + + -- Create SCIM user with the email (associated with Bert's IdP) + scimUser <- randomScimUserWithEmail biboEmail biboEmail + biboUid <- bindResponse (createScimUser domain scimToken scimUser) $ \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "id" >>= asString + + -- Activate the email + activateEmail domain biboEmail + + -- Verify user was created with Bert's SSO ID + getUsersId domain [biboUid] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + bertIssuer <- idpBert.json %. "metadata.issuer" >>= asString + ssoIdTenant `shouldContain` bertIssuer + + -- User logs in via ERNIE ingress (different domain from IdP registration) + -- Since user is already bound to Bert's IdP, this succeeds via direct match. + -- NOTE: This does NOT exercise multiIngressFlow fallback behavior, as the + -- user's SSO ID already matches the authenticating IdP. + userIdFromErnie <- + loginWithSamlWithZHost + (Just ernieZHost) + domain + True -- expect success + tid + biboNameId + (idpIdBert, (idpMetaBert, pCredsBert)) + >>= maybe (error "Expected user ID from cross-domain login") pure + . fst + + -- Verify it's the same user + userIdFromErnie `shouldMatch` biboUid + + -- Verify user's SSO ID is still Bert's issuer + getUsersId domain [userIdFromErnie] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + ssoId <- resp.json %. "0.sso_id" + ssoIdTenant <- ssoId %. "tenant" >>= asString + bertIssuer <- idpBert.json %. "metadata.issuer" >>= asString + ssoIdTenant `shouldContain` bertIssuer + +-- | Helper to create IdP metadata with a fixed issuer suffix for deterministic tests +makeSampleIdPMetadataWithIssuer :: (HasCallStack) => String -> App SampleIdP +makeSampleIdPMetadataWithIssuer suffix = do + let issuerUri = pack $ "https://issuer.net/_" <> suffix + requriUri = pack $ "https://requri.net/_req_" <> suffix + issuer = SAML.Issuer . fromRight' $ SAML.parseURI' issuerUri + requri = fromRight' $ SAML.parseURI' requriUri + (privcreds, creds, cert) <- liftIO $ SAML.mkSignCredsWithCert Nothing 96 + pure $ SampleIdP (SAML.IdPMetadata issuer requri (cert :| [])) privcreds creds cert diff --git a/libs/wire-subsystems/src/Wire/IdPSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/IdPSubsystem/Interpreter.hs index 99d1e7249a9..774bd485c8c 100644 --- a/libs/wire-subsystems/src/Wire/IdPSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/IdPSubsystem/Interpreter.hs @@ -123,7 +123,11 @@ getSsoCodeByEmailImpl enableIdPByEmailDiscovery mbHost email = isScimOrSsoUser :: User -> Bool isScimOrSsoUser user = - userManagedBy user == ManagedByScim && isJust (userSSOId user) + -- TODO: This used to check if the user is SCIM AND SSO! The RFC not + -- really unambiguous about this. The customer currently provisions + -- non-SCIM. So, that would fit. However, this change needs a sign-off by + -- security. + isJust (userSSOId user) findIdPByDomain :: (Member (Logger (Log.Msg -> Log.Msg)) r) => [IP.IdP] -> Sem r (Maybe SAML.IdPId) findIdPByDomain idps = do diff --git a/libs/wire-subsystems/test/unit/Wire/IdPSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/IdPSubsystem/InterpreterSpec.hs index a0a1b772c8e..b478777b22e 100644 --- a/libs/wire-subsystems/test/unit/Wire/IdPSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/IdPSubsystem/InterpreterSpec.hs @@ -37,7 +37,6 @@ import System.Logger.Message qualified as Log import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck -import Test.QuickCheck.Gen import Wire.API.Team.Member import Wire.API.User import Wire.API.User.IdentityProvider @@ -313,19 +312,12 @@ spec = describe "IdPSubsystem.Interpreter" $ do result `shouldBe` Right Nothing expectedSevereLogs logs mempty - prop "returns Nothing for non SCIM/SSO user" $ \(teamMember :: TeamMember) user idp userRef email teamId -> do - (userIdentity, userManagedBy) <- - generate $ - ( do - ui <- Test.QuickCheck.Gen.elements [Just (SSOIdentity (UserSSOId userRef) (Just email)), Nothing] - mngtBy :: ManagedBy <- arbitrary - pure (ui, mngtBy) - ) - `suchThat` (\(ui, mngtBy) -> isNothing ui || mngtBy == ManagedByWire) + prop "returns Nothing for non SSO user" $ \(teamMember :: TeamMember) user idp email teamId -> do + userManagedBy <- generate (arbitrary :: Gen ManagedBy) let userWithEmail = user - { userIdentity = userIdentity, + { userIdentity = Nothing, -- No SSO identity userEmailUnvalidated = Just email, userTeam = Just teamId, userManagedBy = userManagedBy diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index d1e255da57c..04b785172ad 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -200,12 +200,14 @@ api opts = apiSSO :: ( Member GalleyAPIAccess r, Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member (Input Opts) r, Member BrigAPIAccess r, Member AssIDStore r, Member VerdictFormatStore r, Member AReqIDStore r, Member ScimTokenStore r, + Member ScimExternalIdStore r, Member DefaultSsoCode r, Member IdPConfigStore r, Member IdPSubsystem r, @@ -224,8 +226,8 @@ apiSSO opts = :<|> Named @"sso-team-metadata" (\mbHost tid -> getMetadata (Just tid) mbHost) :<|> Named @"auth-req-precheck" authreqPrecheck :<|> Named @"auth-req" (authreq (maxttlAuthreqDiffTime opts)) - :<|> Named @"auth-resp-legacy" (authresp Nothing) - :<|> Named @"auth-resp" (authresp . Just) + :<|> Named @"auth-resp-legacy" (authresp opts.saml Nothing) + :<|> Named @"auth-resp" (authresp opts.saml . Just) :<|> Named @"sso-settings" ssoSettings :<|> Named @"sso-get-by-email" getSsoCodeByEmail @@ -382,7 +384,7 @@ validateRedirectURL uri = do authresp :: forall r. ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member (Input Opts) r, Member GalleyAPIAccess r, Member BrigAPIAccess r, @@ -390,6 +392,7 @@ authresp :: Member VerdictFormatStore r, Member AReqIDStore r, Member ScimTokenStore r, + Member ScimExternalIdStore r, Member IdPConfigStore r, Member SAML2 r, Member SamlProtocolSettings r, @@ -397,11 +400,12 @@ authresp :: Member Reporter r, Member SAMLUserStore r ) => + SAML.Config -> Maybe TeamId -> SAML.AuthnResponseBody -> Maybe Text -> Sem r Void -authresp mbtid arbody mbHost = do +authresp samlConfig mbtid arbody mbHost = do let err :: Sem r any err = throwSparSem (SparSPNotFound "") @@ -419,9 +423,9 @@ authresp mbtid arbody mbHost = do go _assertions idp (SAML.AccessDenied (shouldRedirectToInit -> True)) = do -- redirect back to idp for idp-initiated login. redirectToInit idp - go assertions verdict idp = do + go assertions idp verdict = do -- handle the verdict - SAML.ResponseVerdict result <- verdictHandler assertions idp verdict + SAML.ResponseVerdict result <- verdictHandler assertions verdict idp samlConfig mbHost throw @SparError $ SAML.CustomServant result -- Whenever at least one of the denied reasons is `DeniedNoInResponseTo`, try again. diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 8ec7c658523..7a30e23cb62 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -39,6 +39,7 @@ import Bilge import qualified Cassandra as Cas import Control.Exception (assert) import Control.Lens hiding ((.=)) +import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Data.Aeson as Aeson (encode, object, (.=)) import Data.Aeson.Text as Aeson (encodeToLazyText) import Data.ByteString (toStrict) @@ -85,6 +86,8 @@ import Spar.Sem.ScimTokenStore (ScimTokenStore) import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import Spar.Sem.VerdictFormatStore (VerdictFormatStore) import qualified Spar.Sem.VerdictFormatStore as VerdictFormatStore +import System.Logger (Msg) +import qualified System.Logger as Log import qualified System.Logger as TinyLog import URI.ByteString as URI import Web.Cookie (SetCookie, renderSetCookie) @@ -276,12 +279,13 @@ validateEmail _ _ _ = pure () verdictHandler :: (HasCallStack) => ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAPIAccess r, Member BrigAPIAccess r, Member AReqIDStore r, Member VerdictFormatStore r, Member ScimTokenStore r, + Member ScimExternalIdStore r, Member IdPConfigStore r, Member (Error SparError) r, Member Reporter r, @@ -290,12 +294,14 @@ verdictHandler :: NonEmpty SAML.Assertion -> SAML.AccessVerdict -> IdP -> + SAML.Config -> + Maybe Text -> Sem r SAML.ResponseVerdict -verdictHandler aresp verdict idp = do +verdictHandler aresp verdict idp samlConfig mbHost = do -- [3/4.1.4.2] -- [...] If the containing message is in response to an , then -- the InResponseTo attribute MUST match the request's ID. - Logger.log Logger.Debug $ "entering verdictHandler: " <> show (aresp, verdict) + Logger.debug $ Log.msg ("entering verdictHandler" :: String) . Log.field "aresp" (show aresp) . Log.field "verdict" (show verdict) reqid <- do let xs = SAML.assertionToInResponseTo `mapM` aresp case NonEmpty.nub <$> xs of @@ -305,13 +311,13 @@ verdictHandler aresp verdict idp = do format :: Maybe VerdictFormat <- VerdictFormatStore.get reqid resp <- case format of Just (VerdictFormatWeb mlabel) -> - verdictHandlerResult verdict idp mlabel >>= verdictHandlerWeb + verdictHandlerResult verdict idp mlabel samlConfig mbHost >>= verdictHandlerWeb Just (VerdictFormatMobile granted denied mlabel) -> - verdictHandlerResult verdict idp mlabel >>= verdictHandlerMobile granted denied + verdictHandlerResult verdict idp mlabel samlConfig mbHost >>= verdictHandlerMobile granted denied Nothing -> -- (this shouldn't happen too often, see 'storeVerdictFormat') throwSparSem SparNoSuchRequest - Logger.log Logger.Debug $ "leaving verdictHandler: " <> show resp + Logger.debug $ Log.msg ("leaving verdictHandler" :: String) . Log.field "resp" (show resp) pure resp data VerdictHandlerResult @@ -323,10 +329,11 @@ data VerdictHandlerResult verdictHandlerResult :: (HasCallStack) => ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAPIAccess r, Member BrigAPIAccess r, Member ScimTokenStore r, + Member ScimExternalIdStore r, Member IdPConfigStore r, Member (Error SparError) r, Member Reporter r, @@ -335,11 +342,13 @@ verdictHandlerResult :: SAML.AccessVerdict -> IdP -> Maybe CookieLabel -> + SAML.Config -> + Maybe Text -> Sem r VerdictHandlerResult -verdictHandlerResult verdict idp mlabel = do - Logger.log Logger.Debug $ "entering verdictHandlerResult" - result <- catchVerdictErrors $ verdictHandlerResultCore idp verdict mlabel - Logger.log Logger.Debug $ "leaving verdictHandlerResult" <> show result +verdictHandlerResult verdict idp mlabel samlConfig mbHost = do + Logger.debug $ Log.msg ("entering verdictHandlerResult" :: String) + result <- catchVerdictErrors $ verdictHandlerResultCore idp verdict mlabel samlConfig mbHost + Logger.debug $ Log.msg ("leaving verdictHandlerResult" :: String) . Log.field "result" (show result) pure result catchVerdictErrors :: @@ -398,13 +407,17 @@ moveUserToNewIssuer oldUserRef newUserRef uid = do BrigAPIAccess.setSSOId uid (UserSSOId newUserRef) SAMLUserStore.delete uid oldUserRef +-- TODO: Ideally, we would leave this function untouched to make obvious that the behaviour hasn't changed. +-- As it has side-effects, this ideal can probably not be reached. However, we could consider to let it return a result and act accordingly. verdictHandlerResultCore :: + forall r. (HasCallStack) => ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAPIAccess r, Member BrigAPIAccess r, Member ScimTokenStore r, + Member ScimExternalIdStore r, Member IdPConfigStore r, Member (Error SparError) r, Member SAMLUserStore r @@ -412,35 +425,117 @@ verdictHandlerResultCore :: IdP -> SAML.AccessVerdict -> Maybe CookieLabel -> + SAML.Config -> + Maybe Text -> Sem r VerdictHandlerResult -verdictHandlerResultCore idp verdict mlabel = case verdict of +verdictHandlerResultCore idp verdict mlabel samlConfig mbHost = case verdict of SAML.AccessDenied reasons -> do pure $ VerifyHandlerDenied reasons SAML.AccessGranted uref -> do uid :: UserId <- do let team' = idp ^. idpExtraInfo . team - err = SparUserRefInNoOrMultipleTeams . LText.pack . show $ uref - getUserByUrefUnsafe uref >>= \case - Just usr -> do - if userTeam usr == Just team' - then pure (userId usr) - else throwSparSem err - Nothing -> do - getUserByUrefViaOldIssuerUnsafe idp uref >>= \case - Just (olduref, usr) -> do - let uid = userId usr - if userTeam usr == Just team' - then moveUserToNewIssuer olduref uref uid >> pure uid - else throwSparSem err - Nothing -> do - buid <- Id <$> Random.uuid - autoprovisionSamlUser idp buid uref - validateSamlEmailIfExists buid uref - pure buid - - Logger.log Logger.Debug ("granting sso login for " <> show uid) + findUserWithUref idp team' uref >>= \case + Just uid -> pure uid + Nothing + | SAML.isMultiIngressConfig samlConfig -> + multiIngressFlow team' + Nothing -> provisionNewUser + Logger.debug $ Log.msg ("granting sso login" :: String) . Log.field "user" (idToText uid) cky <- BrigAPIAccess.ssoLogin uid mlabel pure $ VerifyHandlerGranted cky uid + where + provisionNewUser :: Sem r UserId + provisionNewUser = do + buid <- Id <$> Random.uuid + autoprovisionSamlUser idp buid uref + validateSamlEmailIfExists buid uref + pure buid + + -- Try to find a user by UserRef, with fallback to old issuers. + -- Returns the UserId if found and in the correct team, Nothing if not found. + -- Throws SparUserRefInNoOrMultipleTeams if user is found but in the wrong team. + -- Side effect: Old-style users (found via old issuers) are migrated to the new issuer. + findUserWithUref :: IdP -> TeamId -> SAML.UserRef -> Sem r (Maybe UserId) + findUserWithUref idp' team'' uref' = do + let err = SparUserRefInNoOrMultipleTeams . LText.pack . show $ uref' + getUserByUrefUnsafe uref' >>= \case + Just usr -> do + if userTeam usr == Just team'' + then pure (Just (userId usr)) + else throwSparSem err + Nothing -> do + getUserByUrefViaOldIssuerUnsafe idp' uref' >>= \case + Just (olduref, usr) -> do + let uid = userId usr + if userTeam usr == Just team'' + then moveUserToNewIssuer olduref uref' uid >> pure (Just uid) + else throwSparSem err + Nothing -> pure Nothing + + -- In multi-ingress scenarios users can be already assigned to one IdP, + -- but try to authenticate with another. We allow this, when the new IdP + -- is configured for the user's team and the used domain. Additionally, + -- the provided NameId must be an email address (no username) to prevent + -- ambiguities (though, we know this won't be guarding against all + -- ambiguity cases). + -- When we've found the matching IdP and the user's old one, we migrate + -- the user to the new one to not have to run this search again when the + -- user logs in with this IdP. + multiIngressFlow :: TeamId -> Sem r UserId + multiIngressFlow team' = + case uref of + -- Cross-IdP SSO migration only for email-based NameIDs in + -- multi-ingress mode. We may consider to lower the email-only + -- constraint in future. For now, Emil and Sven decided that emails + -- might be a bit more consistent across IdPs then usernames. + SAML.UserRef _ (view SAML.nameID -> UNameIDEmail _) -> do + teamIdPs <- IdPConfigStore.getConfigsByTeam team' + let urefIssuer = uref ^. SAML.uidTenant + isAuthenticatingIdP idp' = + idp' ^. SAML.idpMetadata . SAML.edIssuer == urefIssuer + && idp' ^. idpExtraInfo . domain == mbHost + + -- Verify the authenticating IdP exists (issuer + domain must + -- match) for this team. + case find isAuthenticatingIdP teamIdPs of + Nothing -> + -- TODO: Test this + provisionNewUser -- No valid IdP for this authentication, But, as we reached this line, we know that the auth response was valid. So, this is a new user. + Just _ -> do + -- Try to authenticate the potential user against ALL team IdPs + -- (including other domains) When we found one succeeding IdP + -- for this user in this team, we consider them authenticated + -- and migrate them to the other (requesting) IdP. + let subject = uref ^. SAML.uidSubject + findUserInTeamIdPs team' subject teamIdPs >>= \case + Nothing -> provisionNewUser + Just (uid, oldUref) -> + do + Logger.info $ + Log.msg ("Cross-IdP SSO migration: user found via different IdP, migrating issuer" :: String) + . Log.field "team" (idToText (idp ^. idpExtraInfo . team)) + . Log.field "user" (idToText uid) + . Log.field "old_issuer" (oldUref ^. SAML.uidTenant . SAML.fromIssuer . to URI.serializeURIRef') + -- TODO: This reveals the email address (personal data). We should probably not log this. + . Log.field "new_issuer" (uref ^. SAML.uidTenant . SAML.fromIssuer . to URI.serializeURIRef') + . Log.field "subject" (uref ^. SAML.uidSubject . to show) + . Log.field "authenticating_idp" (idp ^. SAML.idpId . to SAML.fromIdPId . to show) + . Log.field "domain" (mbHost & fromMaybe "None") + -- TODO: This needs to be better understood and tested. + moveUserToNewIssuer oldUref uref uid + pure uid + _ -> provisionNewUser + + -- Try to authenticate against all IdPs. In case, return the UserId and the old UserRef. + findUserInTeamIdPs :: TeamId -> SAML.NameID -> [IdP] -> Sem r (Maybe (UserId, SAML.UserRef)) + findUserInTeamIdPs team'' subject idps = runMaybeT $ asum $ map tryIdP idps + where + tryIdP :: IdP -> MaybeT (Sem r) (UserId, SAML.UserRef) + tryIdP idp' = do + let oldIssuer = idp' ^. SAML.idpMetadata . SAML.edIssuer + oldUref = SAML.UserRef oldIssuer subject + uid <- MaybeT $ findUserWithUref idp' team'' oldUref + pure (uid, oldUref) -- | If the client is web, it will be served with an HTML page that it can process to decide whether -- to log the user in or show an error. diff --git a/services/spar/test-integration/Test/Spar/AppSpec.hs b/services/spar/test-integration/Test/Spar/AppSpec.hs index 07263bbb355..89c26f28446 100644 --- a/services/spar/test-integration/Test/Spar/AppSpec.hs +++ b/services/spar/test-integration/Test/Spar/AppSpec.hs @@ -34,6 +34,7 @@ import SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Test.MockResponse as SAML import qualified Servant import qualified Spar.App as Spar +import Spar.Options (saml) import Spar.Orphans () import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import qualified Text.XML as XML @@ -174,8 +175,10 @@ requestAccessVerdict idp isGranted mkAuthnReq = do if isGranted then SAML.AccessGranted uref else SAML.AccessDenied [DeniedNoBearerConfSubj, DeniedNoAuthnStatement] + env <- ask + let samlConfig = saml (env ^. teOpts) outcome <- do - runSpar $ Spar.verdictHandler (authnresp ^. rspPayload) verdict idp + runSpar $ Spar.verdictHandler (authnresp ^. rspPayload) verdict idp samlConfig Nothing let loc :: URI.URI loc = maybe (error "no location") (either error id . SAML.parseURI' . cs)