fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

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

Browse Source
This commit is contained in:
Steffen Jost 2023-10-24 12:47:35 +00:00
parent 29bffb6a47
commit 315eedd1bc
2 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/Handler/Profile.hs
View File

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

4
src/Handler/Utils.hs
View File

@ -38,6 +38,10 @@ import Handler.Utils.Term as Handler.Utils
import Control.Monad.Logger 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, -- | Prefix a message with a short course id,
-- eg. for window title bars, etc. -- eg. for window title bars, etc.