diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index e17db47e46..f45a6f991e 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -24,6 +24,7 @@ import Control.Lens (makeLenses, (.~), (?~)) import Control.Monad.Except import Data.Aeson import Data.Aeson.TH +import Data.Aeson.Types (parseMaybe) import Data.Attoparsec.ByteString qualified as AP import Data.Binary.Builder qualified as BSB import Data.ByteString.Conversion qualified as BSC @@ -169,6 +170,12 @@ instance ToJSON IdPMetadataInfo where toJSON (IdPMetadataValue _ x) = object ["value" .= SAML.encode x] +idPMetadataToInfo :: SAML.IdPMetadata -> IdPMetadataInfo +idPMetadataToInfo = + -- 'undefined' is fine because `instance toJSON IdPMetadataValue` ignores it. 'fromJust' is + -- ok as long as 'parseJSON . toJSON' always yields a value and not 'Nothing'. + fromJust . parseMaybe parseJSON . toJSON . IdPMetadataValue undefined + -- Swagger instances -- Same as WireIdP, check there for why this has different handling diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 2da4aea9ea..8e10682c2a 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -81,10 +81,11 @@ import Text.XML.DSig (SignPrivCreds, mkSignCredsWithCert) import qualified URI.ByteString as URI import URI.ByteString.QQ (uri) import Util.Core -import Util.Scim (filterBy, listUsers, registerScimToken) +import Util.Scim (createUser, filterBy, listUsers, randomScimUser, randomScimUserWithEmail, registerScimToken) import qualified Util.Scim as ScimT import Util.Types import qualified Web.Cookie as Cky +import qualified Web.Scim.Class.User as Scim import qualified Web.Scim.Schema.User as Scim import Wire.API.Team.Member (newTeamMemberDeleteData) import Wire.API.Team.Permission hiding (self) @@ -1054,34 +1055,99 @@ specCRUDIdentityProvider = do idp `shouldBe` idp' let prefix = " IdP - erase = - (idpId .~ (idp1 ^. idpId)) - . (idpMetadata . edIssuer .~ (idp1 ^. idpMetadata . edIssuer)) - . (idpExtraInfo . oldIssuers .~ (idp1 ^. idpExtraInfo . oldIssuers)) - . (idpExtraInfo . replacedBy .~ (idp1 ^. idpExtraInfo . replacedBy)) - . (idpExtraInfo . handle .~ (idp1 ^. idpExtraInfo . handle)) - erase idp1 `shouldBe` erase idp2 + + describe "replaces an existing idp" + $ forM_ + [ (h, u, e) + | h <- [False, True], -- are users scim provisioned or via team management invitations? + u <- [False, True], -- do we use update-by-put or update-by-post? (see below) + (h, u) /= (True, False), -- scim doesn't not work with more than one idp (https://wearezeta.atlassian.net/browse/WPB-689) + e <- [False, True], -- is the externalId an email address? (if not, it's a uuidv4, and the email address is stored in `emails`) + (u, u, e) /= (True, True, False) -- TODO: this combination fails, see https://github.com/wireapp/wire-server/pull/3563) + ] + $ \(haveScim, updateNotReplace, externalIdIsEmail) -> do + it ("creates new idp, setting old_issuer; sets replaced_by in old idp; scim user search still works " <> show (haveScim, updateNotReplace, externalIdIsEmail)) $ do + env <- ask + (owner1, teamid, idp1, (IdPMetadataValue _ idpmeta1, _privCreds)) <- registerTestIdPWithMeta + let idp1id = idp1 ^. idpId + + mbScimStuff :: Maybe (ScimToken, Scim.StoredUser SparTag, Scim.User SparTag) <- + if haveScim + then do + tok <- registerScimToken teamid (Just idp1id) + user <- + if externalIdIsEmail + then fst <$> randomScimUserWithEmail + else randomScimUser + scimStoredUser <- createUser tok user + pure $ Just (tok, scimStoredUser, user) + else pure Nothing + + let checkScimSearch :: + HasCallStack => + (ScimToken, Scim.StoredUser SparTag, Scim.User SparTag) -> + ReaderT TestEnv IO () + checkScimSearch (tok, target, searchKeys) = do + let Just externalId = Scim.externalId searchKeys + handle' = Scim.userName searchKeys + respId <- listUsers tok (Just (filterBy "externalId" externalId)) + respHandle <- listUsers tok (Just (filterBy "userName" handle')) + liftIO $ do + respId `shouldBe` [target] + respHandle `shouldBe` [target] + + checkScimSearch `mapM_` mbScimStuff + + issuer2 <- makeIssuer + idp2 <- do + let idpmeta2 = idpmeta1 & edIssuer .~ issuer2 + in call $ + -- There are two mechanisms for re-aligning your team when your IdP metadata + -- has changed: POST (create a new one, and mark it as replacing the old one), + -- and PUT (updating the existing IdP's metadata). The reason for having two + -- ways to do this has been lost in history, but we're testing both here. + -- + -- FUTUREWORK: deprecate POST! + if updateNotReplace + then callIdpUpdate' (env ^. teSpar) (Just owner1) (idp1 ^. SAML.idpId) (idPMetadataToInfo idpmeta2) + else callIdpCreateReplace (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner1) idpmeta2 (idp1 ^. SAML.idpId) + + idp1' <- call $ callIdpGet (env ^. teSpar) (Just owner1) (idp1 ^. SAML.idpId) + idp2' <- call $ callIdpGet (env ^. teSpar) (Just owner1) (idp2 ^. SAML.idpId) + liftIO $ do + let updateIdp1 = updateCurrentIssuer . updateOldIssuers + where + updateCurrentIssuer = idpMetadata . edIssuer .~ (idp2' ^. idpMetadata . edIssuer) + updateOldIssuers = idpExtraInfo . oldIssuers .~ [idp1 ^. idpMetadata . edIssuer] + replaceIdp1 = + idpExtraInfo . replacedBy .~ idp1' ^. idpExtraInfo . replacedBy + in idp1' `shouldBe` (idp1 & if updateNotReplace then updateIdp1 else replaceIdp1) + + idp2' `shouldBe` idp2 + idp1 ^. idpMetadata . SAML.edIssuer `shouldBe` (idpmeta1 ^. SAML.edIssuer) + idp2 ^. idpMetadata . SAML.edIssuer `shouldBe` issuer2 + + if updateNotReplace + then idp2 ^. idpId `shouldBe` idp1 ^. idpId + else idp2 ^. idpId `shouldNotBe` idp1 ^. idpId + + idp2 ^. idpExtraInfo . oldIssuers `shouldBe` [idpmeta1 ^. edIssuer] + idp1' ^. idpExtraInfo . replacedBy `shouldBe` if updateNotReplace then Nothing else Just (idp2 ^. idpId) + + -- erase everything that is supposed to be different between idp1, idp2, and make + -- sure the result is equal. + let erase :: IdP -> IdP + erase = + (idpId .~ (idp1 ^. idpId)) + . (idpMetadata . edIssuer .~ (idp1 ^. idpMetadata . edIssuer)) + . (idpExtraInfo . oldIssuers .~ (idp1 ^. idpExtraInfo . oldIssuers)) + . (idpExtraInfo . replacedBy .~ (idp1 ^. idpExtraInfo . replacedBy)) + . (idpExtraInfo . handle .~ (idp1 ^. idpExtraInfo . handle)) + in erase idp1 `shouldBe` erase idp2 + + checkScimSearch `mapM_` mbScimStuff + + describe "replaces an existing idp (cont.)" $ do it "users can still login on old idp as before" $ do env <- ask (owner1, _, idp1, (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta @@ -1100,6 +1166,7 @@ specCRUDIdentityProvider = do olduid `shouldBe` newuid (olduref ^. SAML.uidTenant) `shouldBe` issuer1 (newuref ^. SAML.uidTenant) `shouldBe` issuer1 + it "migrates old users to new idp on their next login on new idp; after that, login on old won't work any more" $ do env <- ask (owner1, _, idp1, (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta @@ -1120,6 +1187,7 @@ specCRUDIdentityProvider = do (olduref ^. SAML.uidTenant) `shouldBe` issuer1 (newuref ^. SAML.uidTenant) `shouldBe` issuer2 tryLoginFail privkey1 idp1 userSubject "cannont-provision-on-replaced-idp" + it "creates non-existent users on new idp" $ do env <- ask (owner1, _, idp1, (IdPMetadataValue _ idpmeta1, privkey1)) <- registerTestIdPWithMeta diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 2a13b750ab..3298ca8047 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -111,6 +111,7 @@ module Util.Core callIdpCreateReplace, callIdpCreateReplace', callIdpCreateWithHandle, + callIdpUpdate', callIdpUpdate, callIdpUpdateWithHandle, callIdpDelete, @@ -1164,6 +1165,12 @@ callIdpCreateReplace' apiversion sparreq_ muid metadata idpid = do . body (RequestBodyLBS . cs $ SAML.encode metadata) . header "Content-Type" "application/xml" +callIdpUpdate' :: (Monad m, MonadIO m, MonadHttp m) => SparReq -> Maybe UserId -> IdPId -> IdPMetadataInfo -> m IdP +callIdpUpdate' sparreq_ muid idpid metainfo = do + resp <- callIdpUpdate (sparreq_ . expect2xx) muid idpid metainfo + either (liftIO . throwIO . ErrorCall . show) pure $ + responseJsonEither @IdP resp + callIdpUpdate :: MonadHttp m => SparReq -> Maybe UserId -> IdPId -> IdPMetadataInfo -> m ResponseLBS callIdpUpdate sparreq_ muid idpid (IdPMetadataValue metadata _) = do put $ diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index ef714ed42e..eeac183d19 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -153,6 +153,12 @@ randomScimUserWithSubjectAndRichInfo richInfo = do subj ) +-- | Use the email address as externalId. +-- +-- FUTUREWORK: since https://wearezeta.atlassian.net/browse/SQSERVICES-157 is done, we also +-- support externalIds that are not emails, and storing email addresses in `emails` in the +-- scim schema. `randomScimUserWithEmail` is from a time where non-idp-authenticated users +-- could only be provisioned with email as externalId. we should probably rework all that. randomScimUserWithEmail :: MonadRandom m => m (Scim.User.User SparTag, Email) randomScimUserWithEmail = do suffix <- cs <$> replicateM 7 (getRandomR ('0', '9'))