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

changelog.d/1-api-changes/brig-team-owner-can-set-user-email

@@ -0,0 +1 @@
+A new endpoint is added to Brig (`put /users/:uid/email`) that allows a team owner to change/set a user email. It can also be used to (re-) send the activation email.

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,16 @@ data Api routes = Api
         :> "self"
         :> ReqBody '[JSON] DeleteUser
         :> MultiVerb 'DELETE '[JSON] DeleteSelfResponses (Maybe Timeout),
+    updateUserEmail ::
+      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"
+        :> ReqBody '[JSON] EmailUpdate
+        :> Put '[JSON] (),
     getHandleInfoUnqualified ::
       routes
         :- Summary "(deprecated, use /search/contacts) Get information on a user handle"

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

@@ -905,6 +905,13 @@ instance FromJSON LocaleUpdate where
 newtype EmailUpdate = EmailUpdate {euEmail :: Email}
   deriving stock (Eq, Show, Generic)
   deriving newtype (Arbitrary)
+  deriving (S.ToSchema) via (Schema EmailUpdate)
+
+instance ToSchema EmailUpdate where
+  schema =
+    object "EmailUpdate" $
+      EmailUpdate
+        <$> euEmail .= field "email" schema
 
 modelEmailUpdate :: Doc.Model
 modelEmailUpdate = Doc.defineModel "EmailUpdate" $ do

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.updateUserEmail = updateUserEmail,
         BrigAPI.getHandleInfoUnqualified = getHandleInfoUnqualifiedH,
         BrigAPI.getUserByHandleQualified = Handle.getHandleInfo,
         BrigAPI.listUsersByUnqualifiedIdsOrHandles = listUsersByUnqualifiedIdsOrHandles,
@@ -1193,6 +1196,27 @@ verifyDeleteUserH (r ::: _) = do
   API.verifyDeleteUser body !>> deleteUserError
   return (setStatus status200 empty)
 
+updateUserEmail :: UserId -> UserId -> Public.EmailUpdate -> Handler ()
+updateUserEmail zuserId emailOwnerId (Public.EmailUpdate email) = do
+  maybeZuserTeamId <- lift $ Data.lookupUserTeam zuserId
+  whenM (not <$> assertHasPerm maybeZuserTeamId) $ throwStd insufficientTeamPermissions
+  maybeEmailOwnerTeamId <- lift $ Data.lookupUserTeam emailOwnerId
+  checkSameTeam maybeZuserTeamId maybeEmailOwnerTeamId
+  void $ API.changeSelfEmail emailOwnerId email API.AllowSCIMUpdates
+  where
+    checkSameTeam :: Maybe TeamId -> Maybe TeamId -> Handler ()
+    checkSameTeam (Just zuserTeamId) maybeEmailOwnerTeamId =
+      when (Just zuserTeamId /= maybeEmailOwnerTeamId) $ throwStd $ notFound "user not found"
+    checkSameTeam Nothing _ = throwStd insufficientTeamPermissions
+
+    assertHasPerm :: Maybe TeamId -> Handler Bool
+    assertHasPerm maybeTeamId = fromMaybe False <$> check
+      where
+        check = runMaybeT $ do
+          teamId <- hoistMaybe maybeTeamId
+          teamMember <- MaybeT $ lift $ Intra.getTeamMember zuserId teamId
+          pure $ teamMember `hasPermission` ChangeTeamMemberProfiles
+
 -- 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

@@ -404,7 +404,7 @@ lookupRichInfoMultiUsers users = do
 -- successful login.
 lookupUserTeam :: UserId -> AppIO (Maybe TeamId)
 lookupUserTeam u =
-  join . fmap runIdentity
+  (runIdentity =<<)
     <$> retry x1 (query1 teamSelect (params LocalQuorum (Identity u)))
 
 lookupAuth :: (MonadClient m) => UserId -> m (Maybe (Maybe Password, AccountStatus))
@@ -471,7 +471,7 @@ lookupFeatureConferenceCalling uid = do
   pure $ ApiFt.TeamFeatureStatusNoConfig <$> mStatusValue
   where
     select :: PrepQuery R (Identity UserId) (Identity (Maybe ApiFt.TeamFeatureStatusValue))
-    select = fromString $ "select feature_conference_calling from user where id = ?"
+    select = fromString "select feature_conference_calling from user where id = ?"
 
 -------------------------------------------------------------------------------
 -- Queries

services/brig/test/integration/API/Team/Util.hs

@@ -48,6 +48,7 @@ import Util
 import Web.Cookie (parseSetCookie, setCookieName)
 import Wire.API.Team.Feature (TeamFeatureStatusValue (..))
 import qualified Wire.API.Team.Feature as Public
+import qualified Wire.API.User as Public
 
 -- | FUTUREWORK: Remove 'createPopulatedBindingTeam', 'createPopulatedBindingTeamWithNames',
 -- and rename 'createPopulatedBindingTeamWithNamesAndHandles' to 'createPopulatedBindingTeam'.
@@ -476,3 +477,14 @@ setTeamSearchVisibility galley tid typ =
     )
     !!! do
       const 204 === statusCode
+
+setUserEmail :: Brig -> UserId -> UserId -> Email -> Http ResponseLBS
+setUserEmail brig from uid email = do
+  put
+    ( brig
+        . paths ["users", toByteString' uid, "email"]
+        . zUser from
+        . zConn "conn"
+        . contentJson
+        . body (RequestBodyLBS . encode $ Public.EmailUpdate email)
+    )

services/brig/test/integration/API/User/Account.hs

@@ -141,9 +141,57 @@ tests _ at opts p b c ch g aws =
       testGroup
         "temporary customer extensions"
         [ test' aws p "domains blocked for registration" $ testDomainsBlockedForRegistration opts b
+        ],
+      testGroup
+        "update user email by team owner"
+        [ test' aws p "put /users/:uid/email" $ testUpdateUserEmailByTeamOwner b
         ]
     ]
 
+testUpdateUserEmailByTeamOwner :: Brig -> Http ()
+testUpdateUserEmailByTeamOwner brig = do
+  (_, teamOwner, emailOwner : otherTeamMember : _) <- createPopulatedBindingTeamWithNamesAndHandles brig 2
+  (teamOwnerDifferentTeam, _) <- createUserWithTeam' brig
+  newEmail <- randomEmail
+  initiateEmailUpdateNoSend brig newEmail (userId emailOwner) !!! (const 202 === statusCode)
+  checkActivationCode newEmail True
+  checkLetActivationExpire newEmail
+  checkActivationCode newEmail False
+  checkSetUserEmail teamOwner emailOwner newEmail 200
+  checkActivationCode newEmail True
+  checkUnauthorizedRequests emailOwner otherTeamMember teamOwnerDifferentTeam newEmail
+  activateEmail brig newEmail
+  -- apparently activating the email does not invalidate the activation code
+  -- ideally we would let the activation code expire again (which is too expensive time-wise)
+  -- and then assert that if the email is verified there is no new activation code created
+  -- when the set email function is called again (idempotency)
+  checkSetUserEmail teamOwner emailOwner newEmail 200
+  checkUnauthorizedRequests emailOwner otherTeamMember teamOwnerDifferentTeam newEmail
+  where
+    checkLetActivationExpire :: Email -> Http ()
+    checkLetActivationExpire email = do
+      -- assumption: `optSettings.setActivationTimeout = 5` in `brig.yaml`
+      threadDelay (5100 * 1000)
+      checkActivationCode email False
+
+    checkActivationCode :: Email -> Bool -> Http ()
+    checkActivationCode email shouldExist = do
+      maybeActivationCode <- Util.getActivationCode brig (Left email)
+      void $
+        lift $
+          if shouldExist
+            then assertBool "activation code should exists" (isJust maybeActivationCode)
+            else assertBool "activation code should not exists" (isNothing maybeActivationCode)
+
+    checkSetUserEmail :: User -> User -> Email -> Int -> Http ()
+    checkSetUserEmail teamOwner emailOwner email expectedStatusCode =
+      setUserEmail brig (userId teamOwner) (userId emailOwner) email !!! (const expectedStatusCode === statusCode)
+
+    checkUnauthorizedRequests :: User -> User -> User -> Email -> Http ()
+    checkUnauthorizedRequests emailOwner otherTeamMember teamOwnerDifferentTeam email = do
+      setUserEmail brig (userId teamOwnerDifferentTeam) (userId emailOwner) email !!! (const 404 === statusCode)
+      setUserEmail brig (userId otherTeamMember) (userId emailOwner) email !!! (const 403 === statusCode)
+
 testCreateUserWithPreverified :: Opt.Opts -> Brig -> AWS.Env -> Http ()
 testCreateUserWithPreverified opts brig aws = do
   -- Register (pre verified) user with phone