diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 39730ffd5..3dde9b54d 100644 --- a/src/Handler/Profile.hs +++ b/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 diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index d13be8cee..2460eb65d 100644 --- a/src/Handler/Utils.hs +++ b/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.