SQSERVICES 1099 Public API end-point for re-sending email validation

libs/galley-types/src/Galley/Types/Teams.hs

@@ -340,6 +340,7 @@ data HiddenPerm
     -- efficient this end-point is.  better not let all team members
     -- play with it unless we have to.
     DownloadTeamMembersCsv
+  | ChangeTeamMemberProfiles
   deriving (Eq, Ord, Show)
 
 -- | See Note [hidden team roles]
@@ -367,6 +368,7 @@ roleHiddenPermissions role = HiddenPermissions p p
             ChangeTeamFeature TeamFeatureFileSharing,
             ChangeTeamFeature TeamFeatureClassifiedDomains {- the features not listed here can only be changed in stern -},
             ChangeTeamFeature TeamFeatureSelfDeletingMessages,
+            ChangeTeamMemberProfiles,
             ReadIdp,
             CreateUpdateDeleteIdp,
             CreateReadDeleteScimToken,

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -135,6 +135,15 @@ data Api routes = Api
         :> "self"
         :> ReqBody '[JSON] DeleteUser
         :> MultiVerb 'DELETE '[JSON] DeleteSelfResponses (Maybe Timeout),
+    updateUserEmailValidation ::
+      routes
+        :- Summary "Resend email address validation email."
+        :> Description "If the user has a pending email validation, the validation email will be resent."
+        :> ZUser
+        :> "users"
+        :> CaptureUserId "uid"
+        :> "email"
+        :> Put '[JSON] (),
     getHandleInfoUnqualified ::
       routes
         :- Summary "(deprecated, use /search/contacts) Get information on a user handle"

services/brig/src/Brig/API/Error.hs

@@ -354,6 +354,9 @@ newPasswordMustDiffer = Wai.mkError status409 "password-must-differ" "For provid
 notFound :: LText -> Wai.Error
 notFound = Wai.mkError status404 "not-found"
 
+conflict :: LText -> Wai.Error
+conflict = Wai.mkError status409 "conflict"
+
 invalidAccountStatus :: Wai.Error
 invalidAccountStatus = Wai.mkError status400 "invalid-status" "The specified account status cannot be set."
 

services/brig/src/Brig/API/Public.hs

@@ -40,6 +40,7 @@ import Brig.App
 import qualified Brig.Calling.API as Calling
 import qualified Brig.Data.Connection as Data
 import qualified Brig.Data.User as Data
+import qualified Brig.IO.Intra as Intra
 import Brig.Options hiding (internalEvents, sesQueue)
 import qualified Brig.Provider.API as Provider
 import qualified Brig.Team.API as Team
@@ -80,6 +81,7 @@ import qualified Data.Text.Ascii as Ascii
 import Data.Text.Encoding (decodeLatin1)
 import Data.Text.Lazy (pack)
 import qualified Data.ZAuth.Token as ZAuth
+import Galley.Types.Teams (HiddenPerm (..), hasPermission)
 import Imports hiding (head)
 import Network.HTTP.Types.Status
 import Network.Wai (Response, lazyRequestBody)
@@ -251,6 +253,7 @@ servantSitemap =
         BrigAPI.getUserQualified = getUser,
         BrigAPI.getSelf = getSelf,
         BrigAPI.deleteSelf = deleteUser,
+        BrigAPI.updateUserEmailValidation = updateUserEmailValidation,
         BrigAPI.getHandleInfoUnqualified = getHandleInfoUnqualifiedH,
         BrigAPI.getUserByHandleQualified = Handle.getHandleInfo,
         BrigAPI.listUsersByUnqualifiedIdsOrHandles = listUsersByUnqualifiedIdsOrHandles,
@@ -1193,6 +1196,31 @@ verifyDeleteUserH (r ::: _) = do
   API.verifyDeleteUser body !>> deleteUserError
   return (setStatus status200 empty)
 
+updateUserEmailValidation :: UserId -> UserId -> Handler ()
+updateUserEmailValidation zuserId emailOwnerId = do
+  maybeZuserTeamId <- lift $ Data.lookupUserTeam zuserId
+  whenM (isNothing <$> runMaybeT (checkPerm maybeZuserTeamId)) $
+    throwStd insufficientTeamPermissions
+  maybeEmailOwnerTeamId <- lift $ Data.lookupUserTeam emailOwnerId
+  checkSameTeam maybeZuserTeamId maybeEmailOwnerTeamId
+  maybeEmail <- lift $ Data.lookupUserUnverifiedEmail emailOwnerId
+  case maybeEmail of
+    Just email -> void $ API.changeSelfEmail emailOwnerId email API.AllowSCIMUpdates
+    Nothing -> throwStd $ conflict "the user doesn't have a pending email validation"
+  where
+    checkSameTeam :: Maybe TeamId -> Maybe TeamId -> Handler ()
+    checkSameTeam (Just zuserTeamId) maybeEmailOwnerTeamId =
+      when (Just zuserTeamId /= maybeEmailOwnerTeamId) $ throwStd insufficientTeamPermissions
+    checkSameTeam Nothing _ = throwStd insufficientTeamPermissions
+
+    checkPerm :: Maybe TeamId -> MaybeT Handler ()
+    checkPerm maybeTeamId = do
+      teamId <- hoistMaybe maybeTeamId
+      teamMember <- MaybeT $ lift $ Intra.getTeamMember zuserId teamId
+      if teamMember `hasPermission` ChangeTeamMemberProfiles
+        then pure ()
+        else throwStd insufficientTeamPermissions
+
 -- activation
 
 data ActivationRespWithStatus

services/brig/src/Brig/API/User.hs

@@ -1232,9 +1232,8 @@ getEmailForProfile profileOwner EmailVisibleIfOnTeam' =
     then userEmail profileOwner
     else Nothing
 getEmailForProfile profileOwner (EmailVisibleIfOnSameTeam' (Just (viewerTeamId, viewerTeamMember))) =
-  if ( Just viewerTeamId == userTeam profileOwner
-         && Team.hasPermission viewerTeamMember Team.ViewSameTeamEmails
-     )
+  if Just viewerTeamId == userTeam profileOwner
+    && Team.hasPermission viewerTeamMember Team.ViewSameTeamEmails
     then userEmail profileOwner
     else Nothing
 getEmailForProfile _ (EmailVisibleIfOnSameTeam' Nothing) = Nothing

services/brig/src/Brig/Data/User.hs

@@ -47,6 +47,7 @@ module Brig.Data.User
     lookupServiceUsers,
     lookupServiceUsersForTeam,
     lookupFeatureConferenceCalling,
+    lookupUserUnverifiedEmail,
 
     -- * Updates
     updateUser,
@@ -89,6 +90,7 @@ import Data.Misc (PlainTextPassword (..))
 import Data.Qualified
 import Data.Range (fromRange)
 import Data.Time (addUTCTime)
+import Data.UUID (UUID)
 import Data.UUID.V4
 import Galley.Types.Bot
 import Imports
@@ -404,9 +406,18 @@ lookupRichInfoMultiUsers users = do
 -- successful login.
 lookupUserTeam :: UserId -> AppIO (Maybe TeamId)
 lookupUserTeam u =
-  join . fmap runIdentity
+  (runIdentity =<<)
     <$> retry x1 (query1 teamSelect (params LocalQuorum (Identity u)))
 
+lookupUserUnverifiedEmail :: MonadClient m => UserId -> m (Maybe Email)
+lookupUserUnverifiedEmail userId =
+  (runIdentity =<<) <$> retry x1 (query1 cql (params LocalQuorum (Identity $ toUUID userId)))
+  where
+    cql :: PrepQuery R (Identity UUID) (Identity (Maybe Email))
+    cql =
+      "SELECT email \
+      \FROM vcodes WHERE account = ?"
+
 lookupAuth :: (MonadClient m) => UserId -> m (Maybe (Maybe Password, AccountStatus))
 lookupAuth u = fmap f <$> retry x1 (query1 authSelect (params LocalQuorum (Identity u)))
   where