Spar: Ensure mkValidExternalId returns a valid URef

changelog.d/3-bug-fixes/spar-scim-old-issuer

@@ -0,0 +1 @@
+Ensure that SCIM can find users even after the team admin has changed the SAML issuer for the user.

services/spar/src/Spar/App.hs

@@ -26,6 +26,7 @@ module Spar.App
     throwSparSem,
     verdictHandler,
     getUserByUrefUnsafe,
+    getUserByUrefViaOldIssuerUnsafe,
     getUserIdByScimExternalId,
     validateEmail,
     errorPage,
@@ -347,9 +348,7 @@ catchVerdictErrors = (`catch` hndlr)
 getUserByUrefViaOldIssuerUnsafe ::
   forall r.
   ( Member BrigAccess r,
-    Member IdPConfigStore r,
-    Member SAMLUserStore r,
-    Member (Error SparError) r
+    Member SAMLUserStore r
   ) =>
   IdP ->
   SAML.UserRef ->

services/spar/src/Spar/Scim/User.hs

@@ -45,7 +45,7 @@ where
 import qualified Control.Applicative as Applicative (empty)
 import Control.Lens hiding (op)
 import Control.Monad.Error.Class (MonadError)
-import Control.Monad.Except (runExceptT, throwError)
+import Control.Monad.Except (throwError)
 import Control.Monad.Trans.Except (mapExceptT)
 import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
 import Crypto.Hash (Digest, SHA256, hashlazy)
@@ -61,9 +61,10 @@ import qualified Galley.Types.Teams as Galley
 import Imports
 import Network.URI (URI, parseURI)
 import Polysemy
+import Polysemy.Error (Error, runError, throw)
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
-import Spar.App (getUserByUrefUnsafe, getUserIdByScimExternalId)
+import Spar.App (getUserByUrefUnsafe, getUserByUrefViaOldIssuerUnsafe, getUserIdByScimExternalId)
 import qualified Spar.App
 import qualified Spar.Intra.BrigApp as Brig
 import Spar.Options
@@ -193,31 +194,35 @@ instance
 -- | Validate a raw SCIM user record and extract data that we care about. See also:
 -- 'ValidScimUser''.
 validateScimUser ::
-  forall m r.
-  (m ~ Scim.ScimHandler (Sem r)) =>
-  ( Member (Input Opts) r,
+  forall r.
+  ( Member SAMLUserStore r,
+    Member BrigAccess r,
+    Member (Input Opts) r,
     Member IdPConfigStore r
   ) =>
   Text ->
   -- | Used to decide what IdP to assign the user to
   ScimTokenInfo ->
   Scim.User ST.SparTag ->
-  m ST.ValidScimUser
+  Scim.ScimHandler (Sem r) ST.ValidScimUser
 validateScimUser errloc tokinfo user = do
   mIdpConfig <- tokenInfoToIdP tokinfo
   richInfoLimit <- lift $ inputs richInfoLimit
-  validateScimUser' errloc mIdpConfig richInfoLimit user
+  eitherUser <- lift $ runError $ validateScimUser' errloc mIdpConfig richInfoLimit user
+  case eitherUser of
+    Left err -> throwError err
+    Right validatedUser -> pure validatedUser
 
 tokenInfoToIdP :: Member IdPConfigStore r => ScimTokenInfo -> Scim.ScimHandler (Sem r) (Maybe IdP)
 tokenInfoToIdP ScimTokenInfo {stiIdP} =
   mapM (lift . IdPConfigStore.getConfig) stiIdP
 
 -- | Validate a handle (@userName@).
-validateHandle :: MonadError Scim.ScimError m => Text -> m Handle
+validateHandle :: Member (Error Scim.ScimError) r => Text -> Sem r Handle
 validateHandle txt = case parseHandle txt of
   Just h -> pure h
   Nothing ->
-    throwError $
+    throw $
       Scim.badRequest
         Scim.InvalidValue
         (Just (txt <> "is not a valid Wire handle"))
@@ -247,28 +252,31 @@ validateHandle txt = case parseHandle txt of
 -- that we haven't made yet. We store them in our SCIM blobs, but don't syncronize them with
 -- Brig. See <https://github.com/wireapp/wire-server/pull/559#discussion_r247466760>.
 validateScimUser' ::
-  forall m.
-  (MonadError Scim.ScimError m) =>
+  forall r.
+  ( Member (Error Scim.ScimError) r,
+    Member BrigAccess r,
+    Member SAMLUserStore r
+  ) =>
   -- | Error location (call site, for debugging)
   Text ->
   -- | IdP that the resulting user will be assigned to
   Maybe IdP ->
   -- | Rich info limit
   Int ->
   Scim.User ST.SparTag ->
-  m ST.ValidScimUser
+  Sem r ST.ValidScimUser
 validateScimUser' errloc midp richInfoLimit user = do
-  unless (isNothing $ Scim.password user) $ throwError $ badRequest "Setting user passwords is not supported for security reasons."
+  unless (isNothing $ Scim.password user) $ throw $ badRequest "Setting user passwords is not supported for security reasons."
   veid <- mkValidExternalId midp (Scim.externalId user)
   handl <- validateHandle . Text.toLower . Scim.userName $ user
   -- FUTUREWORK: 'Scim.userName' should be case insensitive; then the toLower here would
   -- be a little less brittle.
   uname <- do
-    let err msg = throwError . Scim.badRequest Scim.InvalidValue . Just $ cs msg <> " (" <> errloc <> ")"
+    let err msg = throw . Scim.badRequest Scim.InvalidValue . Just $ cs msg <> " (" <> errloc <> ")"
     either err pure $ Brig.mkUserName (Scim.displayName user) veid
   richInfo <- validateRichInfo (Scim.extra user ^. ST.sueRichInfo)
   let active = Scim.active user
-  lang <- maybe (throwError $ badRequest "Could not parse language. Expected format is ISO 639-1.") pure $ mapM parseLanguage $ Scim.preferredLanguage user
+  lang <- maybe (throw $ badRequest "Could not parse language. Expected format is ISO 639-1.") pure $ mapM parseLanguage $ Scim.preferredLanguage user
   mRole <- validateRole user
   pure $ ST.ValidScimUser veid handl uname richInfo (maybe True Scim.unScimBool active) (flip Locale Nothing <$> lang) mRole
   where
@@ -280,10 +288,10 @@ validateScimUser' errloc midp richInfoLimit user = do
         [] -> pure Nothing
         [roleName] ->
           maybe
-            (throwError $ badRequest $ "The role '" <> roleName <> "' is not valid. Valid roles are " <> validRoleNames <> ".")
+            (throw $ badRequest $ "The role '" <> roleName <> "' is not valid. Valid roles are " <> validRoleNames <> ".")
             (pure . Just)
             (fromByteString $ cs roleName)
-        (_ : _ : _) -> throwError $ badRequest "A user cannot have more than one role."
+        (_ : _ : _) -> throw $ badRequest "A user cannot have more than one role."
 
     badRequest :: Text -> Scim.ScimError
     badRequest msg =
@@ -292,11 +300,11 @@ validateScimUser' errloc midp richInfoLimit user = do
         (Just $ msg <> " (" <> errloc <> ")")
 
     -- Validate rich info (@richInfo@). It must not exceed the rich info limit.
-    validateRichInfo :: RI.RichInfo -> m RI.RichInfo
+    validateRichInfo :: RI.RichInfo -> Sem r RI.RichInfo
     validateRichInfo richInfo = do
       let sze = RI.richInfoSize richInfo
       when (sze > richInfoLimit) $
-        throwError $
+        throw $
           ( Scim.badRequest
               Scim.InvalidValue
               ( Just . cs $
@@ -319,13 +327,16 @@ validateScimUser' errloc midp richInfoLimit user = do
 -- This is needed primarily in 'validateScimUser', but also in 'updateValidScimUser' to
 -- recover the 'SAML.UserRef' of the scim user before the update from the database.
 mkValidExternalId ::
-  forall m.
-  (MonadError Scim.ScimError m) =>
+  forall r.
+  ( Member BrigAccess r,
+    Member SAMLUserStore r,
+    Member (Error Scim.ScimError) r
+  ) =>
   Maybe IdP ->
   Maybe Text ->
-  m ST.ValidExternalId
+  Sem r ST.ValidExternalId
 mkValidExternalId _ Nothing =
-  throwError $
+  throw $
     Scim.badRequest
       Scim.InvalidValue
       (Just "externalId is required")
@@ -334,17 +345,30 @@ mkValidExternalId Nothing (Just extid) = do
         Scim.badRequest
           Scim.InvalidValue
           (Just "externalId must be a valid email address or (if there is a SAML IdP) a valid SAML NameID")
-  maybe (throwError err) (pure . ST.EmailOnly) $ parseEmail extid
+  maybe (throw err) (pure . ST.EmailOnly) $ parseEmail extid
 mkValidExternalId (Just idp) (Just extid) = do
   let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer
   subject <- validateSubject extid
   let uref = SAML.UserRef issuer subject
+  -- The index for URef -> user id depends on name of the issuer, which can be
+  -- updated by the team admin. This update is not applied immediately to all
+  -- users. So, we have to find which URef is actaully pointing to the user.
+  indexedUref <-
+    getUserByUrefUnsafe uref >>= \case
+      Just _ -> pure uref
+      Nothing ->
+        getUserByUrefViaOldIssuerUnsafe idp uref >>= \case
+          Just (olduref, _) -> pure olduref
+          Nothing ->
+            -- The entry in spar.user_v2 does not exist yet during user
+            -- creation. So we just assume that it will exist momentarily.
+            pure uref
   pure $ case parseEmail extid of
-    Just email -> ST.EmailAndUref email uref
-    Nothing -> ST.UrefOnly uref
+    Just email -> ST.EmailAndUref email indexedUref
+    Nothing -> ST.UrefOnly indexedUref
   where
     -- Validate a subject ID (@externalId@).
-    validateSubject :: Text -> m SAML.NameID
+    validateSubject :: Text -> Sem r SAML.NameID
     validateSubject txt = do
       unameId :: SAML.UnqualifiedNameID <- do
         let eEmail = SAML.mkUNameIDEmail txt
@@ -353,7 +377,7 @@ mkValidExternalId (Just idp) (Just extid) = do
       case SAML.mkNameID unameId Nothing Nothing Nothing of
         Right nameId -> pure nameId
         Left err ->
-          throwError $
+          throw $
             Scim.badRequest
               Scim.InvalidValue
               (Just $ "Can't construct a subject ID from externalId: " <> Text.pack err)
@@ -1078,7 +1102,7 @@ scimFindUserByEmail mIdpConfig stiTeam email = do
   -- https://wearezeta.atlassian.net/browse/SQSERVICES-157; once it is fixed, we should go back to
   -- throwing errors returned by 'mkValidExternalId' here, but *not* throw an error if the externalId is
   -- a UUID, or any other text that is valid according to SCIM.
-  veid <- MaybeT (either (const Nothing) Just <$> runExceptT (mkValidExternalId mIdpConfig (pure email)))
+  veid <- MaybeT . lift $ either (const Nothing) Just <$> runError @Scim.ScimError (mkValidExternalId mIdpConfig (pure email))
   uid <- MaybeT . lift $ ST.runValidExternalIdEither withUref withEmailOnly veid
   brigUser <- MaybeT . lift . BrigAccess.getAccount Brig.WithPendingInvitations $ uid
   getUserById mIdpConfig stiTeam . userId . accountUser $ brigUser

services/spar/test-integration/Test/Spar/APISpec.hs

@@ -1062,11 +1062,10 @@ specCRUDIdentityProvider = do
           | 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)
+            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 " <> show (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
           let idp1id = idp1 ^. idpId

services/spar/test-integration/Test/Spar/Scim/UserSpec.hs

@@ -55,6 +55,8 @@ import qualified Data.Vector as V
 import qualified Data.ZAuth.Token as ZAuth
 import Imports
 import qualified Network.Wai.Utilities.Error as Wai
+import Polysemy
+import Polysemy.Error
 import qualified SAML2.WebSSO as SAML
 import qualified SAML2.WebSSO.Test.MockResponse as SAML
 import SAML2.WebSSO.Test.Util.TestSP (makeSampleIdPMetadata)
@@ -75,6 +77,7 @@ import Util.Invitation
 import qualified Web.Scim.Class.User as Scim.UserC
 import qualified Web.Scim.Filter as Filter
 import qualified Web.Scim.Schema.Common as Scim
+import qualified Web.Scim.Schema.Error as Scim
 import qualified Web.Scim.Schema.ListResponse as Scim
 import qualified Web.Scim.Schema.Meta as Scim
 import Web.Scim.Schema.PatchOp (Operation)
@@ -1581,8 +1584,9 @@ testScimSideIsUpdated = do
   -- Check that the updated user also matches the data that we sent with
   -- 'updateUser'
   richInfoLimit <- view (teOpts . to richInfoLimit)
+  expectedUser <- setDefaultRoleIfEmpty <$$> whatSparReturnsFor idp richInfoLimit (setPreferredLanguage defLang user')
   liftIO $ do
-    Right (Scim.value (Scim.thing storedUser')) `shouldBe` (whatSparReturnsFor idp richInfoLimit (setPreferredLanguage defLang user') <&> setDefaultRoleIfEmpty)
+    Right (Scim.value (Scim.thing storedUser')) `shouldBe` expectedUser
     Scim.id (Scim.thing storedUser') `shouldBe` Scim.id (Scim.thing storedUser)
     let meta = Scim.meta storedUser
         meta' = Scim.meta storedUser'
@@ -1637,8 +1641,9 @@ testUpdateSameHandle = do
   liftIO $ updatedUser `shouldBe` storedUser'
   -- Check that the updated user also matches the data that we sent with 'updateUser'
   richInfoLimit <- view (teOpts . to richInfoLimit)
+  expectedUser <- setDefaultRoleIfEmpty <$$> whatSparReturnsFor idp richInfoLimit (setPreferredLanguage defLang user')
   liftIO $ do
-    Right (Scim.value (Scim.thing storedUser')) `shouldBe` (whatSparReturnsFor idp richInfoLimit (setPreferredLanguage defLang user') <&> setDefaultRoleIfEmpty)
+    Right (Scim.value (Scim.thing storedUser')) `shouldBe` expectedUser
     Scim.id (Scim.thing storedUser') `shouldBe` Scim.id (Scim.thing storedUser)
     let meta = Scim.meta storedUser
         meta' = Scim.meta storedUser'
@@ -1647,6 +1652,9 @@ testUpdateSameHandle = do
     Scim.created meta `shouldBe` Scim.created meta'
     Scim.location meta `shouldBe` Scim.location meta'
 
+runScimErrorUnsafe :: Sem (Error Scim.ScimError ': r) a -> Sem r a
+runScimErrorUnsafe action = either (error . show) pure =<< runError action
+
 -- | Test that when a user's external id is updated, the relevant indices are also updated in
 -- brig and spar, and spar can find the user by that external id.
 testUpdateExternalId :: Bool -> TestSpar ()
@@ -1673,7 +1681,8 @@ testUpdateExternalId withidp = do
           then call $ activateEmail brig email
           else registerUser brig tid email
         veid :: ValidExternalId <-
-          either (error . show) pure $ mkValidExternalId midp (Scim.User.externalId user)
+          runSpar . runScimErrorUnsafe $
+            mkValidExternalId midp (Scim.User.externalId user)
         -- Overwrite the user with another randomly-generated user (only controlling externalId)
         otherEmail <- randomEmail
         user' <- do
@@ -1685,7 +1694,9 @@ testUpdateExternalId withidp = do
                         else Scim.User.externalId user
                   }
           randomScimUser <&> upd
-        let veid' = either (error . show) id $ mkValidExternalId midp (Scim.User.externalId user')
+        veid' <-
+          runSpar . runScimErrorUnsafe $
+            mkValidExternalId midp (Scim.User.externalId user')
 
         _ <- updateUser tok userid user'
 
@@ -1717,14 +1728,17 @@ testUpdateExternalIdOfUnregisteredAccount = do
   storedUser <- createUser tok user
   let userid = scimUserId storedUser
   veid :: ValidExternalId <-
-    either (error . show) pure $ mkValidExternalId Nothing (Scim.User.externalId user)
+    runSpar . runScimErrorUnsafe $
+      mkValidExternalId Nothing (Scim.User.externalId user)
   -- Overwrite the user with another randomly-generated user (only controlling externalId)
   -- And update the user before they have registered their account
   otherEmail <- randomEmail
   user' <- do
     let upd u = u {Scim.User.externalId = Just $ fromEmail otherEmail}
     randomScimUser <&> upd
-  let veid' = either (error . show) id $ mkValidExternalId Nothing (Scim.User.externalId user')
+  veid' <-
+    runSpar . runScimErrorUnsafe $
+      mkValidExternalId Nothing (Scim.User.externalId user')
   _ <- updateUser tok userid user'
   -- Now the user registers their account (via old email)
   registerUser brig tid email
@@ -1767,7 +1781,9 @@ testBrigSideIsUpdated = do
   user' <- randomScimUser
   let userid = scimUserId storedUser
   _ <- updateUser tok userid user'
-  validScimUser <- either (error . show) pure $ validateScimUser' "testBrigSideIsUpdated" (Just idp) 999999 user'
+  validScimUser <-
+    runSpar . runScimErrorUnsafe $
+      validateScimUser' "testBrigSideIsUpdated" (Just idp) 999999 user'
   brigUser <- maybe (error "no brig user") pure =<< runSpar (Intra.getBrigUser Intra.WithPendingInvitations userid)
   let scimUserWithDefLocale = validScimUser {Spar.Types._vsuLocale = Spar.Types._vsuLocale validScimUser <|> Just (Locale (Language EN) Nothing)}
   brigUser `userShouldMatch` scimUserWithDefLocale
@@ -2227,11 +2243,11 @@ specEmailValidation = do
             else setSamlEmailValidation teamid Feature.FeatureStatusDisabled
           (user, email) <- randomScimUserWithEmail
           scimStoredUser <- createUser tok user
-          uref :: SAML.UserRef <-
-            either (error . show) (pure . (^?! veidUref)) $
+          veid <-
+            runSpar . runScimErrorUnsafe $
               mkValidExternalId (Just idp) (Scim.User.externalId . Scim.value . Scim.thing $ scimStoredUser)
           uid :: UserId <-
-            getUserIdViaRef uref
+            getUserIdViaRef (veid ^?! veidUref)
           brig <- view teBrig
           -- we intentionally activate the email even if it's not set up to work, to make sure
           -- it doesn't if the feature is disabled.

services/spar/test-integration/Util/Scim.hs

@@ -37,6 +37,7 @@ import Data.UUID.V4 as UUID
 import qualified Galley.Types.Teams as Teams
 import Imports
 import qualified Network.Wai.Utilities as Error
+import Polysemy.Error (runError)
 import qualified SAML2.WebSSO as SAML
 import SAML2.WebSSO.Types (IdPId, idpId)
 import qualified Spar.Intra.BrigApp as Intra
@@ -52,6 +53,7 @@ import qualified Web.Scim.Class.User as Scim
 import qualified Web.Scim.Filter as Filter
 import qualified Web.Scim.Filter as Scim
 import qualified Web.Scim.Schema.Common as Scim
+import qualified Web.Scim.Schema.Error as Scim
 import qualified Web.Scim.Schema.ListResponse as Scim
 import qualified Web.Scim.Schema.Meta as Scim
 import qualified Web.Scim.Schema.PatchOp as Scim.PatchOp
@@ -691,10 +693,12 @@ userShouldMatch u1 u2 = liftIO $ do
 -- floor.  This function calls the spar functions that do that.  This allows us to express
 -- what we expect a user that comes back from spar to look like in terms of what it looked
 -- like when we sent it there.
-whatSparReturnsFor :: HasCallStack => IdP -> Int -> Scim.User.User SparTag -> Either String (Scim.User.User SparTag)
-whatSparReturnsFor idp richInfoSizeLimit =
-  either (Left . show) (Right . synthesizeScimUser)
-    . validateScimUser' "whatSparReturnsFor" (Just idp) richInfoSizeLimit
+whatSparReturnsFor :: HasCallStack => IdP -> Int -> Scim.User.User SparTag -> TestSpar (Either String (Scim.User.User SparTag))
+whatSparReturnsFor idp richInfoSizeLimit user = do
+  eitherValidatedScimUser <- runSpar $ runError @Scim.ScimError $ validateScimUser' "whatSparReturnsFor" (Just idp) richInfoSizeLimit user
+  pure $ case eitherValidatedScimUser of
+    Left err -> Left (show err)
+    Right validatedScimUser -> Right $ synthesizeScimUser validatedScimUser
 
 setPreferredLanguage :: Language -> Scim.User.User SparTag -> Scim.User.User SparTag
 setPreferredLanguage lang u =