chore(users): allow admins to change foreign emails without confirmation

src/Handler/Profile.hs

@@ -102,7 +102,6 @@ instance RenderMessage UniWorX NotificationTriggerKind where
     where
       mr = renderMessage f ls
 
-
 makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
 makeSettingForm template html = do
     MsgRenderer mr <- getMsgRenderer
@@ -169,7 +168,7 @@ schoolsForm template = formToAForm $ schoolsFormView =<< renderWForm FormStandar
 notificationForm :: Maybe NotificationSettings -> AForm Handler NotificationSettings
 notificationForm template = wFormToAForm $ do
   mbUid <- liftHandler maybeAuthId
-  isAdmin <- lift . lift $ hasReadAccessTo AdminR
+  isAdmin <- checkAdmin
 
   let
     sectionIsHidden :: NotificationTriggerKind -> DB Bool
@@ -376,7 +375,7 @@ validateSettings User{..} = do
   let pinBad     = validCmdArgument =<< userPinPassword'
       pinMinChar = 5
       pinLength  = maybe 0 length userPinPassword'
-  pinOk <- if userPrefersPostal' || pinMinChar <= pinLength then pure True else liftHandler $ hasReadAccessTo AdminR -- admins are allowed to ignore pin requirements
+  pinOk <- if userPrefersPostal' || pinMinChar <= pinLength then pure True else checkAdmin -- admins are allowed to ignore pin requirements
   whenIsJust pinBad (tellValidationError . MsgPDFPasswordInvalid) -- used as CMD argument for pdftk
   guardValidation (MsgPDFPasswordTooShort pinMinChar) pinOk
 
@@ -450,9 +449,12 @@ serveProfileR (uid, user@User{..}) = do
 
   formResult res $ \SettingsForm{..} -> do
     now <- liftIO getCurrentTime
+    isAdmin <- checkAdmin
+    thisUser <- fromMaybe uid <$> maybeAuthId
+    let changeEmailByUser = userDisplayEmail /= stgDisplayEmail && (not isAdmin || thisUser == uid)
     runDBJobs $ do
       update uid $
-        [ UserDisplayEmail         =. stgDisplayEmail   | userDisplayEmail  == stgDisplayEmail  ] ++ -- Note that DisplayEmail changes must be confirmed, see 472
+        [ UserDisplayEmail         =. stgDisplayEmail   | not changeEmailByUser                 ] ++ -- DisplayEmail changes by Users must be confirmed, see 480 below
         [ UserPostLastUpdate       =. Just now          | userPostAddress   /= stgPostAddress   ] ++
         [ UserDisplayName          =. stgDisplayName
         , UserMaxFavourites        =. stgMaxFavourites
@@ -472,7 +474,7 @@ serveProfileR (uid, user@User{..}) = do
         , UserExamOfficeGetLabels  =. (stgExamOfficeSettings & eosettingsGetLabels)
         ]
       updateFavourites Nothing
-      when (stgDisplayEmail /= userDisplayEmail) $ do
+      when changeEmailByUser $ do
         queueDBJob $ JobChangeUserDisplayEmail uid stgDisplayEmail
         addMessageI Info $ MsgUserDisplayEmailChangeSent stgDisplayEmail
       let

src/Handler/Utils.hs

@@ -38,6 +38,10 @@ import Handler.Utils.Term as Handler.Utils
 import Control.Monad.Logger
 
 
+-- | default check if the user an active admin
+checkAdmin :: (MonadHandler m, MonadAP (HandlerFor (HandlerSite m) )) => m Bool
+checkAdmin = liftHandler $ hasReadAccessTo AdminR
+
 
 -- | Prefix a message with a short course id,
 --   eg. for window title bars, etc.