SQSERVICES-377 fix email verification when external id is updated via…

… SCIM (#2374)

changelog.d/3-bug-fixes/pr-2374

@@ -0,0 +1 @@
+Verification email is sent when external id is updated via SCIM

libs/wire-api/src/Wire/API/User/Scim.hs

@@ -329,6 +329,8 @@ data ValidScimUser = ValidScimUser
   }
   deriving (Eq, Show)
 
+-- | Note that a 'SAML.UserRef' may contain an email. Even though it is possible to construct a 'ValidExternalId' from such a 'UserRef' with 'UrefOnly',
+-- this does not represent a valid 'ValidExternalId'. So in case of a 'UrefOnly', we can assume that the 'UserRef' does not contain an email.
 data ValidExternalId
   = EmailAndUref Email SAML.UserRef
   | UrefOnly SAML.UserRef

services/spar/src/Spar/App.hs

@@ -28,6 +28,7 @@ module Spar.App
     getUserIdByScimExternalId,
     insertUser,
     validateEmailIfExists,
+    validateEmail,
     errorPage,
     getIdPIdByIssuer,
     getIdPConfigByIssuer,
@@ -72,7 +73,6 @@ import SAML2.WebSSO
     uidTenant,
   )
 import qualified SAML2.WebSSO as SAML
-import qualified SAML2.WebSSO.Types.Email as SAMLEmail
 import Servant
 import qualified Servant.Multipart as Multipart
 import Spar.Error hiding (sparToServerErrorWithLogging)
@@ -301,16 +301,16 @@ autoprovisionSamlUserWithId mbteam buid suid = do
 -- make brig initiate the email validate procedure.
 validateEmailIfExists :: forall r. Members '[GalleyAccess, BrigAccess] r => UserId -> SAML.UserRef -> Sem r ()
 validateEmailIfExists uid = \case
-  (SAML.UserRef _ (view SAML.nameID -> UNameIDEmail email)) -> doValidate (CI.original email)
+  (SAML.UserRef _ (view SAML.nameID -> UNameIDEmail email)) -> do
+    mbTid <- Intra.getBrigUserTeam Intra.NoPendingInvitations uid
+    validateEmail mbTid uid . Intra.emailFromSAML . CI.original $ email
   _ -> pure ()
-  where
-    doValidate :: SAMLEmail.Email -> Sem r ()
-    doValidate email = do
-      enabled <- do
-        tid <- Intra.getBrigUserTeam Intra.NoPendingInvitations uid
-        maybe (pure False) (GalleyAccess.isEmailValidationEnabledTeam) tid
-      when enabled $ do
-        BrigAccess.updateEmail uid (Intra.emailFromSAML email)
+
+validateEmail :: forall r. Members '[GalleyAccess, BrigAccess] r => Maybe TeamId -> UserId -> Email -> Sem r ()
+validateEmail mbTid uid email = do
+  enabled <- maybe (pure False) GalleyAccess.isEmailValidationEnabledTeam mbTid
+  when enabled $ do
+    BrigAccess.updateEmail uid email
 
 -- | Check if 'UserId' is in the team that hosts the idp that owns the 'UserRef'.  If so,
 -- register a the user under its SAML credentials and write the 'UserRef' into the

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

@@ -66,7 +66,7 @@ import Network.URI (URI, parseURI)
 import Polysemy
 import Polysemy.Input
 import qualified SAML2.WebSSO as SAML
-import Spar.App (GetUserResult (..), getUserIdByScimExternalId, getUserIdByUref, validateEmailIfExists)
+import Spar.App (GetUserResult (..), getUserIdByScimExternalId, getUserIdByUref, validateEmail, validateEmailIfExists)
 import qualified Spar.Intra.BrigApp as Brig
 import Spar.Scim.Auth ()
 import Spar.Scim.Types (normalizeLikeStored)
@@ -612,9 +612,8 @@ updateVsuUref ::
   ST.ValidExternalId ->
   Sem r ()
 updateVsuUref team uid old new = do
-  let geturef = ST.runValidExternalIdEither Just (const Nothing)
-  case (geturef old, geturef new) of
-    (mo, mn@(Just newuref)) | mo /= mn -> validateEmailIfExists uid newuref
+  case (veidEmail old, veidEmail new) of
+    (mo, mn@(Just email)) | mo /= mn -> validateEmail (Just team) uid email
     _ -> pure ()
 
   old & ST.runValidExternalIdBoth (>>) (SAMLUserStore.delete uid) (ScimExternalIdStore.delete team)

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

@@ -38,7 +38,6 @@ import Control.Monad.Except (MonadError (throwError))
 import Control.Monad.Random (randomRIO)
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
-import Control.Retry (exponentialBackoff, limitRetries, recovering)
 import qualified Data.Aeson as Aeson
 import Data.Aeson.Lens (key, _String)
 import Data.Aeson.QQ (aesonQQ)
@@ -70,7 +69,7 @@ import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore
 import qualified Spar.Sem.ScimUserTimesStore as ScimUserTimesStore
 import qualified Text.XML.DSig as SAML
 import Util
-import Util.Invitation (getInvitation, getInvitationCode, headInvitation404, registerInvitation)
+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
@@ -1548,6 +1547,7 @@ testUpdateSameHandle = do
 testUpdateExternalId :: Bool -> TestSpar ()
 testUpdateExternalId withidp = do
   env <- ask
+  brig <- view teBrig
   (tok, midp, tid) <-
     if withidp
       then do
@@ -1564,11 +1564,14 @@ testUpdateExternalId withidp = do
         user <- randomScimUser <&> \u -> u {Scim.User.externalId = Just $ fromEmail email}
         storedUser <- createUser tok user
         let userid = scimUserId storedUser
+        if withidp
+          then call $ activateEmail brig email
+          else registerUser email
         veid :: ValidExternalId <-
           either (error . show) pure $ mkValidExternalId midp (Scim.User.externalId user)
         -- Overwrite the user with another randomly-generated user (only controlling externalId)
+        otherEmail <- randomEmail
         user' <- do
-          otherEmail <- randomEmail
           let upd u =
                 u
                   { Scim.User.externalId =
@@ -1581,6 +1584,7 @@ testUpdateExternalId withidp = do
 
         _ <- updateUser tok userid user'
 
+        when hasChanged (call $ activateEmail brig otherEmail)
         muserid <- lookupByValidExternalId veid
         muserid' <- lookupByValidExternalId veid'
         liftIO $ do
@@ -1591,6 +1595,7 @@ testUpdateExternalId withidp = do
             else do
               (hasChanged, veid') `shouldBe` (hasChanged, veid)
               (hasChanged, muserid') `shouldBe` (hasChanged, Just userid)
+        eventually $ checkEmail userid (Just $ if hasChanged then otherEmail else email)
 
       lookupByValidExternalId :: ValidExternalId -> TestSpar (Maybe UserId)
       lookupByValidExternalId =
@@ -1604,6 +1609,15 @@ testUpdateExternalId withidp = do
                 Left err -> error $ show err
           )
 
+      registerUser :: Email -> TestSpar ()
+      registerUser email = do
+        let r = call $ get (brig . path "/i/teams/invitations/by-email" . queryItem "email" (toByteString' email))
+        inv <- responseJsonError =<< r <!! statusCode === const 200
+        Just inviteeCode <- call $ getInvitationCode brig tid (inInvitation inv)
+        call $
+          post (brig . path "/register" . contentJson . json (acceptWithName (Name "Alice") email inviteeCode))
+            !!! const 201 === statusCode
+
   checkUpdate True
   checkUpdate False
 
@@ -1959,10 +1973,7 @@ specAzureQuirks = do
 specEmailValidation :: SpecWith TestEnv
 specEmailValidation = do
   describe "email validation" $ do
-    let eventually :: HasCallStack => TestSpar a -> TestSpar a
-        eventually = recovering (limitRetries 3 <> exponentialBackoff 100000) [] . const
-
-        setup :: HasCallStack => Bool -> TestSpar (UserId, Email)
+    let setup :: HasCallStack => Bool -> TestSpar (UserId, Email)
         setup enabled = do
           (tok, (_ownerid, teamid, idp)) <- registerIdPAndScimToken
           if enabled

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

@@ -130,6 +130,7 @@ module Util.Core
     checkErrHspec,
     updateTeamMemberRole,
     checkChangeRoleOfTeamMember,
+    eventually,
   )
 where
 
@@ -1329,3 +1330,6 @@ checkChangeRoleOfTeamMember tid adminId targetId = forM_ [minBound ..] $ \role -
   updateTeamMemberRole tid adminId targetId role
   [member'] <- filter ((== targetId) . (^. Member.userId)) <$> getTeamMembers adminId tid
   liftIO $ (member' ^. Member.permissions . to Teams.permissionsRole) `shouldBe` Just role
+
+eventually :: HasCallStack => TestSpar a -> TestSpar a
+eventually = recovering (limitRetries 3 <> exponentialBackoff 100000) [] . const

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

@@ -20,6 +20,7 @@ module Util.Invitation
     getInvitation,
     getInvitationCode,
     registerInvitation,
+    acceptWithName,
   )
 where