From 6e2d54577206126a4b7b9a9059931b5dc1daba61 Mon Sep 17 00:00:00 2001 From: Steffen Date: Wed, 10 Jul 2024 12:23:37 +0200 Subject: [PATCH] chore(users): allow profile edits with invalid display_email address, if unchanged --- messages/uniworx/utils/utils/de-de-formal.msg | 1 + messages/uniworx/utils/utils/en-eu.msg | 1 + src/Handler/Profile.hs | 20 +++++++++------ src/Handler/Users.hs | 23 +++++++++-------- templates/profileData.hamlet | 25 +++++++++++-------- test/Database/Fill.hs | 4 +-- 6 files changed, 42 insertions(+), 32 deletions(-) diff --git a/messages/uniworx/utils/utils/de-de-formal.msg b/messages/uniworx/utils/utils/de-de-formal.msg index 5ff122fb1..69ef443a5 100644 --- a/messages/uniworx/utils/utils/de-de-formal.msg +++ b/messages/uniworx/utils/utils/de-de-formal.msg @@ -96,6 +96,7 @@ RoomReferenceLinkLink !ident-ok: Link RoomReferenceLinkLinkPlaceholder !ident-ok: URL RoomReferenceLinkInstructions: Anweisungen RoomReferenceLinkInstructionsPlaceholder: Anweisungen +UtilNoneSet: Keine angegeben UtilEmptyChoice: Auswahl war leer UtilEmptyNoChangeTip: Eine leere Eingabe belässt den vorherigen Wert unverändert. MultiNoSelection: Keine Auswahl diff --git a/messages/uniworx/utils/utils/en-eu.msg b/messages/uniworx/utils/utils/en-eu.msg index f65004cd1..48b4a5e25 100644 --- a/messages/uniworx/utils/utils/en-eu.msg +++ b/messages/uniworx/utils/utils/en-eu.msg @@ -96,6 +96,7 @@ RoomReferenceLinkLink: Link RoomReferenceLinkLinkPlaceholder: URL RoomReferenceLinkInstructions: Instructions RoomReferenceLinkInstructionsPlaceholder: Instructions +UtilNoneSet: None set UtilEmptyChoice: Empty selection UtilEmptyNoChangeTip: Existing values remain unchanged if this field is left empty. MultiNoSelection: No selection diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 76c9346e9..39a5b603a 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -113,10 +113,11 @@ instance RenderMessage UniWorX NotificationTriggerKind where makeSettingForm :: Maybe SettingsForm -> Form SettingsForm makeSettingForm template html = do MsgRenderer mr <- getMsgRenderer + -- isAdmin <- checkAdmin (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm <$ aformSection MsgFormPersonalAppearance - <*> areq (textField & cfStrip) (fslI MsgUserDisplayName & setTooltip MsgUserDisplayNameRulesBelow) (stgDisplayName <$> template) - <*> areq (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail & setTooltip MsgUserDisplayEmailTip) (stgDisplayEmail <$> template) + <*> areq (textField & cfStrip) (fslI MsgUserDisplayName & setTooltip MsgUserDisplayNameRulesBelow) (stgDisplayName <$> template) + <*> areq (textField & cfStrip & cfCI) (fslI MsgUserDisplayEmail & setTooltip MsgUserDisplayEmailTip) (stgDisplayEmail <$> template) <* aformSection MsgFormCosmetics <*> areq (natFieldI MsgFavouritesNotNatural) (fslpI MsgFavourites (mr MsgFavouritesPlaceholder) & setTooltip MsgFavouritesTip) (stgMaxFavourites <$> template) @@ -370,7 +371,9 @@ validateSettings User{..} = do userDisplayEmail' <- use _stgDisplayEmail guardValidation (MsgInvalidEmailAddressWith $ CI.original userDisplayEmail') $ - validEmail' userDisplayEmail' + validEmail' userDisplayEmail' || -- valid + userDisplayEmail' == userDisplayEmail || -- unchanged + userDisplayEmail' == userEmail -- euqal to default, which is then ignored userPostAddress' <- use _stgPostAddress let postalNotSet = isNothing userPostAddress' -- TODO $ canonical userPostAddress' @@ -435,7 +438,7 @@ serveProfileR (uid, user@User{..}) = do return (userSchools, userExamOfficeLabels) let settingsTemplate = Just SettingsForm { stgDisplayName = userDisplayName - , stgDisplayEmail = userDisplayEmail + , stgDisplayEmail = if userDisplayEmail == "" then userEmail else userDisplayEmail , stgMaxFavourites = userMaxFavourites , stgMaxFavouriteTerms = userMaxFavouriteTerms , stgTheme = userTheme @@ -464,11 +467,12 @@ serveProfileR (uid, user@User{..}) = do now <- liftIO getCurrentTime isAdmin <- checkAdmin thisUser <- fromMaybe uid <$> maybeAuthId - let changeEmailByUser = userDisplayEmail /= stgDisplayEmail && (not isAdmin || thisUser == uid) + let changeEmailByUser = (not isAdmin || thisUser == uid) + changeEmailProper = userDisplayEmail /= stgDisplayEmail && userEmail /= stgDisplayEmail runDBJobs $ do update uid $ - [ UserDisplayEmail =. stgDisplayEmail | not changeEmailByUser ] ++ -- DisplayEmail changes by Users must be confirmed, see 480 below - [ UserPostLastUpdate =. Just now | userPostAddress /= stgPostAddress ] ++ + [ UserDisplayEmail =. stgDisplayEmail | not changeEmailByUser, changeEmailProper ] ++ -- DisplayEmail changes by Users must be confirmed, see 480 below + [ UserPostLastUpdate =. Just now | userPostAddress /= stgPostAddress ] ++ [ UserDisplayName =. stgDisplayName , UserMaxFavourites =. stgMaxFavourites , UserMaxFavouriteTerms =. stgMaxFavouriteTerms @@ -489,7 +493,7 @@ serveProfileR (uid, user@User{..}) = do , UserExamOfficeGetLabels =. (stgExamOfficeSettings & eosettingsGetLabels) ] updateFavourites Nothing - when changeEmailByUser $ do + when (changeEmailByUser && changeEmailProper) $ do queueDBJob $ JobChangeUserDisplayEmail uid stgDisplayEmail addMessageI Info $ MsgUserDisplayEmailChangeSent stgDisplayEmail let diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 4b68bc972..156a9a6f2 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -56,11 +56,10 @@ hijackUserForm = \csrf -> do (btnResult, btnView) <- mopt (buttonField BtnHijack) "" Nothing return (btnResult >>= guard . is _Just, mconcat [toWidget csrf, fvWidget btnView]) --- In case of refactoring, use this: --- instance HasEntity (DBRow (Entity User)) User where --- hasEntity = _dbrOutput --- instance HasUser (DBRow (Entity USer)) where --- hasUser = _entityVal +instance HasEntity (DBRow (Entity User)) User where + hasEntity = _dbrOutput +instance HasUser (DBRow (Entity User)) where + hasUser = _dbrOutput . _entityVal data UserAction = UserAvsSync | UserLdapSync | UserAddSupervisor | UserSetSupervisor | UserRemoveSupervisor | UserRemoveSubordinates deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) @@ -112,9 +111,9 @@ postUsersR = do , sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \DBRow{ dbrOutput = entUsr } -> cellHasMatrikelnummerLinkedAdmin entUsr , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ liftHandler $ runDB $ -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX" maybeMonoid <$> wgtCompanies uid - , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM - (AdminUserR <$> encrypt uid) - (toWgt userCompanyPersonalNumber) + -- , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM -- redundant + -- (AdminUserR <$> encrypt uid) + -- (toWgt userCompanyPersonalNumber) , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity _uid User{..} } -> cellMaybe textCell userCompanyPersonalNumber , sortable (Just "company-department") (i18nCell MsgCompanyDepartment) $ \DBRow{ dbrOutput = Entity _uid User{..} } -> cellMaybe textCell userCompanyDepartment -- , sortable (Just "last-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM @@ -132,6 +131,7 @@ postUsersR = do pure $ mconcat supervisors , sortable (Just "last-login") (i18nCell MsgLastLogin) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastAuthentication , sortable (Just "auth-ldap") (i18nCell MsgAuthMode) $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication + , colUserEmail , sortable (Just "ldap-sync") (i18nCell MsgLdapSynced) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastLdapSynchronisation , flip foldMap universeF $ \function -> sortable (Just $ SortingKey $ CI.mk $ toPathPiece function) (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do @@ -215,11 +215,12 @@ postUsersR = do return (uf E.^. UserFunctionSchool) ) | function <- universeF ] ++ - [ ( "name" - , SortColumn $ \user -> user E.^. UserSurname + [ sortUserEmail id + , ( "name" + , SortColumn (E.^. UserSurname) ) , ( "display-name" - , SortColumn $ \user -> user E.^. UserDisplayName + , SortColumn (E.^. UserDisplayName) ) , ( "matriculation" , SortColumn $ \user -> user E.^. UserMatrikelnummer diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index bbd5f6202..2c08e5a2f 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -15,7 +15,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{userAuthentication} $maybe avs <- avsId - $with avsNoPers <- tshow (view _userAvsNoPerson avs) + $with avsNoPers <- tshow (view _userAvsNoPerson avs)
_{MsgAvsPersonNo} ^{messageTooltip tooltipAvsPersNo} @@ -57,12 +57,12 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{MsgTableBirthday} ^{usrAutomatic CU_UA_UserBirthday}
- ^{formatTimeW SelFormatDate bday} + ^{formatTimeW SelFormatDate bday
_{MsgPrefersPostalExp}
$if userPrefersPostal /= actualPrefersPostal - ^{messageTooltip tooltipInvalidEmail} # + ^{messageTooltip tooltipInvalidEmail #{iconLetterOrEmail userPrefersPostal} $maybe addr <- actualPostAddress
@@ -80,18 +80,21 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later _{MsgUserDisplayEmail} # ^{updateAutomatic emailAutomatic}
- $maybe primaryEmail <- actualDisplayEmail - #{mailtoHtml primaryEmail} + $maybe primaryEmail <- actualDisplayEmail + #{mailtoHtml primaryEmail} $nothing - ^{messageTooltip tooltipInvalidEmail} # - #{mailtoHtml userDisplayEmail} + ^{messageTooltip tooltipInvalidEmail} + $if userDisplayEmail == "" + _{MsgUtilNoneSet} + $else + #{mailtoHtml userDisplayEmail} $if Just userEmail /= actualDisplayEmail
_{MsgUserSystemEmail} -
+
$if not (validEmail' userEmail) - ^{messageTooltip tooltipInvalidEmail} # - #{userEmail} + ^{messageTooltip tooltipInvalidEmail} + #{mailtoHtml userEmail}
_{MsgAdminUserPinPassword} ^{usrAutomatic CU_UA_UserPinPassword} @@ -146,7 +149,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later _{MsgNeverSet} $maybe pKey <- userLdapPrimaryKey
- _{MsgProfileLdapPrimaryKey} + _{MsgProfileLdapPrimaryKey}
#{pKey}
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index b10e5373c..2b38b164c 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -126,8 +126,8 @@ fillDb = do , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing - , userEmail = "noEmailKnown" - , userDisplayEmail = "felix.hamann@campus.lmu.de" + , userEmail = "AVSNO:123456" + , userDisplayEmail = "" , userDisplayName = "Felix Hamann" , userSurname = "Hamann" , userFirstName = "Felix"