From 138d33d480ebec1f129a26d7993caeff68d97161 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 11 Aug 2023 17:08:22 +0200 Subject: [PATCH 1/6] Code layout. --- services/spar/test-integration/Test/Spar/APISpec.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 2da4aea9ea..a264747b68 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -727,7 +727,7 @@ specCRUDIdentityProvider = do callIdpUpdateWithHandle (env ^. teSpar) (Just owner) (idp ^. idpId) (IdPMetadataValue (cs $ SAML.encode metadata) undefined) expected `shouldRespondWith` ((== 200) . statusCode) callIdpGet (env ^. teSpar) (Just owner) (idp ^. idpId) - `shouldRespondWith` ((== expected) . (\idp' -> idp' ^. (SAML.idpExtraInfo . handle))) + `shouldRespondWith` ((== expected) . (\idp' -> idp' ^. (SAML.idpExtraInfo . handle))) -- wiHandle? it "updates IdP metadata and creates a new IdP with the first metadata" $ do env <- ask (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley) @@ -1054,6 +1054,7 @@ specCRUDIdentityProvider = do idp `shouldBe` idp' let prefix = " Date: Tue, 15 Aug 2023 09:17:31 +0200 Subject: [PATCH 2/6] Test case. --- .../src/Wire/API/User/IdentityProvider.hs | 5 + .../test-integration/Test/Spar/APISpec.hs | 130 ++++++++++++++---- services/spar/test-integration/Util/Core.hs | 7 + services/spar/test-integration/Util/Scim.hs | 6 + 4 files changed, 118 insertions(+), 30 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index e17db47e46..aa6effecc3 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,10 @@ instance ToJSON IdPMetadataInfo where toJSON (IdPMetadataValue _ x) = object ["value" .= SAML.encode x] +-- | (Returning 'Nothing' would be an internal error.) +idPMetadataToInfo :: SAML.IdPMetadata -> Maybe IdPMetadataInfo +idPMetadataToInfo = 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 a264747b68..d529e8fc01 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) @@ -727,7 +728,7 @@ specCRUDIdentityProvider = do callIdpUpdateWithHandle (env ^. teSpar) (Just owner) (idp ^. idpId) (IdPMetadataValue (cs $ SAML.encode metadata) undefined) expected `shouldRespondWith` ((== 200) . statusCode) callIdpGet (env ^. teSpar) (Just owner) (idp ^. idpId) - `shouldRespondWith` ((== expected) . (\idp' -> idp' ^. (SAML.idpExtraInfo . handle))) -- wiHandle? + `shouldRespondWith` ((== expected) . (\idp' -> idp' ^. (SAML.idpExtraInfo . handle))) it "updates IdP metadata and creates a new IdP with the first metadata" $ do env <- ask (owner, _) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley) @@ -1055,34 +1056,103 @@ specCRUDIdentityProvider = do 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) + e <- [False, True], -- is the externalId an email address? (if not, it's a uuidv4, and the email address is stored in `emails`) + (h, u) /= (True, False), -- scim doesn't not work with more than one idp (https://wearezeta.atlassian.net/browse/WPB-689) + (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) (fromJust $ 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 + idp1' + `shouldBe` ( idp1 + & if updateNotReplace + then + (idpMetadata . edIssuer .~ (idp2' ^. idpMetadata . edIssuer)) + . (idpExtraInfo . oldIssuers .~ [idp1 ^. idpMetadata . edIssuer]) + else idpExtraInfo . replacedBy .~ idp1' ^. idpExtraInfo . replacedBy + ) + idp2' + `shouldBe` ( idp2 + & if updateNotReplace + then id + else id + ) + 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)) + 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 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')) From a8b08cd27164e717161a0fe6aac20c3526c951c5 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 6 Sep 2023 10:35:16 +0200 Subject: [PATCH 3/6] hlint --- services/spar/test-integration/Test/Spar/APISpec.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index d529e8fc01..d3352a6dde 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -1061,8 +1061,8 @@ specCRUDIdentityProvider = do [ (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) - e <- [False, True], -- is the externalId an email address? (if not, it's a uuidv4, and the email address is stored in `emails`) (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 @@ -1123,12 +1123,7 @@ specCRUDIdentityProvider = do . (idpExtraInfo . oldIssuers .~ [idp1 ^. idpMetadata . edIssuer]) else idpExtraInfo . replacedBy .~ idp1' ^. idpExtraInfo . replacedBy ) - idp2' - `shouldBe` ( idp2 - & if updateNotReplace - then id - else id - ) + idp2' `shouldBe` idp2 idp1 ^. idpMetadata . SAML.edIssuer `shouldBe` (idpmeta1 ^. SAML.edIssuer) idp2 ^. idpMetadata . SAML.edIssuer `shouldBe` issuer2 if updateNotReplace From c22b9602421ffe7f266982faabb60419f06ca90b Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 6 Sep 2023 12:25:53 +0200 Subject: [PATCH 4/6] Code review. --- libs/wire-api/src/Wire/API/User/IdentityProvider.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index aa6effecc3..f45a6f991e 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -170,9 +170,11 @@ instance ToJSON IdPMetadataInfo where toJSON (IdPMetadataValue _ x) = object ["value" .= SAML.encode x] --- | (Returning 'Nothing' would be an internal error.) -idPMetadataToInfo :: SAML.IdPMetadata -> Maybe IdPMetadataInfo -idPMetadataToInfo = parseMaybe parseJSON . toJSON . IdPMetadataValue undefined +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 From d2abbaae4c2a829285bdb2fcbe533cd0712d4d4a Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 6 Sep 2023 12:34:12 +0200 Subject: [PATCH 5/6] Code review. --- .../test-integration/Test/Spar/APISpec.hs | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index d3352a6dde..4747de9795 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -1107,7 +1107,7 @@ specCRUDIdentityProvider = do -- 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? + -- FUTUREWORK: deprecate POST! if updateNotReplace then callIdpUpdate' (env ^. teSpar) (Just owner1) (idp1 ^. SAML.idpId) (fromJust $ idPMetadataToInfo idpmeta2) else callIdpCreateReplace (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner1) idpmeta2 (idp1 ^. SAML.idpId) @@ -1115,25 +1115,25 @@ specCRUDIdentityProvider = do idp1' <- call $ callIdpGet (env ^. teSpar) (Just owner1) (idp1 ^. SAML.idpId) idp2' <- call $ callIdpGet (env ^. teSpar) (Just owner1) (idp2 ^. SAML.idpId) liftIO $ do - idp1' - `shouldBe` ( idp1 - & if updateNotReplace - then - (idpMetadata . edIssuer .~ (idp2' ^. idpMetadata . edIssuer)) - . (idpExtraInfo . oldIssuers .~ [idp1 ^. idpMetadata . edIssuer]) - else idpExtraInfo . replacedBy .~ idp1' ^. idpExtraInfo . replacedBy - ) + 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) + 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 @@ -1143,7 +1143,7 @@ specCRUDIdentityProvider = do . (idpExtraInfo . oldIssuers .~ (idp1 ^. idpExtraInfo . oldIssuers)) . (idpExtraInfo . replacedBy .~ (idp1 ^. idpExtraInfo . replacedBy)) . (idpExtraInfo . handle .~ (idp1 ^. idpExtraInfo . handle)) - erase idp1 `shouldBe` erase idp2 + in erase idp1 `shouldBe` erase idp2 checkScimSearch `mapM_` mbScimStuff From 1fe82aa70af96b41ae5a0764ec386128d234abe5 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 6 Sep 2023 12:36:54 +0200 Subject: [PATCH 6/6] Fixup --- services/spar/test-integration/Test/Spar/APISpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 4747de9795..8e10682c2a 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -1109,7 +1109,7 @@ specCRUDIdentityProvider = do -- -- FUTUREWORK: deprecate POST! if updateNotReplace - then callIdpUpdate' (env ^. teSpar) (Just owner1) (idp1 ^. SAML.idpId) (fromJust $ idPMetadataToInfo idpmeta2) + 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)