diff --git a/changelog.d/5-internal/fisx-spar-refactorings-2023-11-27-1 b/changelog.d/5-internal/fisx-spar-refactorings-2023-11-27-1 new file mode 100644 index 0000000000..244cc8480a --- /dev/null +++ b/changelog.d/5-internal/fisx-spar-refactorings-2023-11-27-1 @@ -0,0 +1 @@ +Improve integration test coverage diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 4107e44910..2060030f9e 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -526,7 +526,7 @@ assertNoScimOrNoIdP teamid = do "Teams with SCIM tokens can only have at most one IdP" -- | Check that issuer is not used anywhere in the system ('WireIdPAPIV1', here it is a --- database keys for finding IdPs), or anywhere in this team ('WireIdPAPIV2'), that request +-- database key for finding IdPs), or anywhere in this team ('WireIdPAPIV2'), that request -- URI is https, that the replacement IdPId, if present, points to our team, and possibly -- other things (see source code for the definitive answer). -- diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index ae6d8bda2b..46bb2fcce4 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -1104,6 +1104,8 @@ scimFindUserByEmail mIdpConfig stiTeam email = do -- a UUID, or any other text that is valid according to SCIM. veid <- MaybeT . lift $ either (const Nothing) Just <$> runError @Scim.ScimError (mkValidExternalId mIdpConfig (pure email)) uid <- MaybeT . lift $ ST.runValidExternalIdEither withUref withEmailOnly veid + -- since gc on `spar.users{,_v2}` is unreliable, we need to double-check with brig if the + -- user we found actually exists. brigUser <- MaybeT . lift . BrigAccess.getAccount Brig.WithPendingInvitations $ uid getUserById mIdpConfig stiTeam . userId . accountUser $ brigUser where diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 674730134d..1e2ea1ab5d 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -32,6 +32,7 @@ import Control.Monad.Random.Class (getRandomR) import Data.Aeson as Aeson import Data.Aeson.Lens import Data.ByteString.Conversion +import Data.Handle (fromHandle) import Data.Id import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Misc @@ -81,11 +82,13 @@ import Text.XML.DSig (SignPrivCreds, mkSignCredsWithCert) import qualified URI.ByteString as URI import URI.ByteString.QQ (uri) import Util.Core -import Util.Scim (createUser, filterBy, listUsers, randomScimUser, randomScimUserWithEmail, registerScimToken) +import Util.Scim (createUser, filterBy, listUsers, randomScimUserWithEmail, randomScimUserWithNick, 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.Common as Scim +import qualified Web.Scim.Schema.Meta as Scim import qualified Web.Scim.Schema.User as Scim import Wire.API.Team.Member (newTeamMemberDeleteData) import Wire.API.Team.Permission hiding (self) @@ -1058,35 +1061,80 @@ specCRUDIdentityProvider = do 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) + [ (u, e) + | u <- [False, True], -- do we use update-by-put or update-by-post? (see below) e <- [False, True] -- is the externalId an email address? (if not, it's a uuidv4, and the email address is stored in `emails`) ] - $ \(haveScim, updateNotReplace, externalIdIsEmail) -> do - it ("creates new idp, setting old_issuer; sets replaced_by in old idp; scim user search still works: haveScim=" <> show haveScim <> ", updateNotReplace=" <> show updateNotReplace <> ", externalIdIsEmail=" <> show externalIdIsEmail) $ do - env <- ask - (owner1, teamid, idp1, (IdPMetadataValue _ idpmeta1, _privCreds)) <- registerTestIdPWithMeta + $ \(updateNotReplace, externalIdIsEmail) -> do + let updateOrReplaceIdps :: (UserId, IdP, SAML.IdPMetadata) -> TestSpar () + updateOrReplaceIdps (owner1, idp1, idpmeta1) = do + env <- ask + 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 + + -- scim doesn't work with more than one idp, so we can't test the post variant + -- that creates a second idp (https://wearezeta.atlassian.net/browse/WPB-689) + when updateNotReplace . it ("creates new idp, setting old_issuer; sets replaced_by in old idp; scim user search still works: provisionViaScim=True, updateNotReplace=" <> show updateNotReplace <> ", externalIdIsEmail=" <> show externalIdIsEmail) $ do + (owner1, teamid, idp1, (IdPMetadataValue _ idpmeta1, _)) <- 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 + tok <- registerScimToken teamid (Just idp1id) + scimUser <- + if externalIdIsEmail + then fst <$> randomScimUserWithEmail + else fst <$> randomScimUserWithNick + scimStoredUser <- createUser tok scimUser let checkScimSearch :: HasCallStack => - (ScimToken, Scim.StoredUser SparTag, Scim.User SparTag) -> + Scim.StoredUser SparTag -> + Scim.User SparTag -> ReaderT TestEnv IO () - checkScimSearch (tok, target, searchKeys) = do + checkScimSearch target searchKeys = do let Just externalId = Scim.externalId searchKeys handle' = Scim.userName searchKeys respId <- listUsers tok (Just (filterBy "externalId" externalId)) @@ -1095,56 +1143,40 @@ specCRUDIdentityProvider = 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 + checkScimSearch scimStoredUser scimUser + updateOrReplaceIdps (owner1, idp1, idpmeta1) + checkScimSearch scimStoredUser scimUser + + it ("creates new idp, setting old_issuer; sets replaced_by in old idp; scim user search still works: provisionViaScim=False, updateNotReplace=" <> show updateNotReplace <> ", externalIdIsEmail=" <> show externalIdIsEmail) $ do + (owner1, teamid, idp1, (IdPMetadataValue _ idpmeta1, privcreds)) <- registerTestIdPWithMeta + let idp1id = idp1 ^. idpId + + (uid, mbEmail, hdl) :: (UserId, Maybe Text, Text) <- do + spmeta <- getTestSPMetadata teamid + authnreq <- negotiateAuthnRequest idp1 + authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp1 spmeta authnreq True + sparresp <- submitAuthnResponse teamid authnresp + liftIO $ statusCode sparresp `shouldBe` 200 + ssoid <- getSsoidViaAuthResp authnresp + Just uid <- ssoToUidSpar teamid ssoid + setRandomHandleBrig uid + Just usr <- getUserBrig uid + let eml = fromEmail <$> (emailIdentity =<< userIdentity usr) + Just hdl = fromHandle <$> userHandle usr + pure (uid, eml, hdl) + + -- if user is created via saml, don't call checkScimSearch here until we have + -- updated the idp; otherwise, the interesting second call would only find a + -- scim-imported user and this test would be redundant.. + updateOrReplaceIdps (owner1, idp1, idpmeta1) + + -- checkScimSearch + tok <- registerScimToken teamid (Just idp1id) + respHandle <- listUsers tok (Just (filterBy "userName" hdl)) + liftIO $ ((Scim.id . Scim.thing) <$> respHandle) `shouldBe` [uid] + (`mapM_` mbEmail) $ \eml -> do + respId <- listUsers tok (Just (filterBy "externalId" eml)) + liftIO $ ((Scim.id . Scim.thing) <$> respId) `shouldBe` [uid] describe "replaces an existing idp (cont.)" $ do it "users can still login on old idp as before" $ do diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 3298ca8047..c8c2d042db 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -56,6 +56,7 @@ module Util.Core defPassword, getUserBrig, changeHandleBrig, + setRandomHandleBrig, updateProfileBrig, createUserWithTeam, createUserWithTeamDisableSSO, @@ -1315,6 +1316,16 @@ stdInvitationRequest' :: Maybe User.Locale -> Maybe Role -> User.Email -> TeamIn stdInvitationRequest' loc role email = TeamInvitation.InvitationRequest loc role Nothing email Nothing +setRandomHandleBrig :: HasCallStack => UserId -> TestSpar () +setRandomHandleBrig uid = do + env <- ask + call (changeHandleBrig (env ^. teBrig) uid =<< liftIO randomHandle) + !!! (const 200 === statusCode) + where + randomHandle = liftIO $ do + nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z + pure (cs (chr <$> nrs)) + changeHandleBrig :: (MonadHttp m, HasCallStack) => BrigReq -> diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index d728932a14..ad79ef9d74 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -174,6 +174,19 @@ randomScimUserWithEmail = do email ) +randomScimUserWithNick :: MonadRandom m => m (Scim.User.User SparTag, Text) +randomScimUserWithNick = do + suffix <- cs <$> replicateM 7 (getRandomR ('0', '9')) + let nick = "nick" <> suffix + externalId = nick + pure + ( (Scim.User.empty userSchemas ("scimuser_" <> suffix) (ScimUserExtra mempty)) + { Scim.User.displayName = Just ("ScimUser" <> suffix), + Scim.User.externalId = Just externalId + }, + nick + ) + randomScimEmail :: MonadRandom m => m Email.Email randomScimEmail = do let typ :: Maybe Text = Nothing