chore(users): allow profile edits with invalid display_email address, if unchanged
This commit is contained in:
parent
fa0541aa4e
commit
6e2d545772
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -15,7 +15,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<dd .deflist__dd>
|
||||
_{userAuthentication}
|
||||
$maybe avs <- avsId
|
||||
$with avsNoPers <- tshow (view _userAvsNoPerson avs)
|
||||
$with avsNoPers <- tshow (view _userAvsNoPerson avs)
|
||||
<dt .deflist__dt>
|
||||
_{MsgAvsPersonNo}
|
||||
^{messageTooltip tooltipAvsPersNo}
|
||||
@ -57,12 +57,12 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<dt .deflist__dt>
|
||||
_{MsgTableBirthday} ^{usrAutomatic CU_UA_UserBirthday}
|
||||
<dd .deflist__dd>
|
||||
^{formatTimeW SelFormatDate bday}
|
||||
^{formatTimeW SelFormatDate bday
|
||||
<dt .deflist__dt>
|
||||
_{MsgPrefersPostalExp}
|
||||
<dd .deflist__dd>
|
||||
$if userPrefersPostal /= actualPrefersPostal
|
||||
^{messageTooltip tooltipInvalidEmail} #
|
||||
^{messageTooltip tooltipInvalidEmail
|
||||
#{iconLetterOrEmail userPrefersPostal}
|
||||
$maybe addr <- actualPostAddress
|
||||
<dt .deflist__dt>
|
||||
@ -80,18 +80,21 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
_{MsgUserDisplayEmail} #
|
||||
^{updateAutomatic emailAutomatic}
|
||||
<dd .deflist__dd .email>
|
||||
$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
|
||||
<dt .deflist__dt>
|
||||
_{MsgUserSystemEmail}
|
||||
<dd .deflist__dd>
|
||||
<dd .deflist__dd>
|
||||
$if not (validEmail' userEmail)
|
||||
^{messageTooltip tooltipInvalidEmail} #
|
||||
#{userEmail}
|
||||
^{messageTooltip tooltipInvalidEmail}
|
||||
#{mailtoHtml userEmail}
|
||||
<dt .deflist__dt>
|
||||
_{MsgAdminUserPinPassword}
|
||||
^{usrAutomatic CU_UA_UserPinPassword}
|
||||
@ -146,7 +149,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
_{MsgNeverSet}
|
||||
$maybe pKey <- userLdapPrimaryKey
|
||||
<dt .deflist__dt>
|
||||
_{MsgProfileLdapPrimaryKey}
|
||||
_{MsgProfileLdapPrimaryKey}
|
||||
<dd .deflist__dd .ldap-primary-key>
|
||||
#{pKey}
|
||||
<dt .deflist__dt>
|
||||
|
||||
@ -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"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user