fix(avs): profile page correctly indicates automatic email and postal addresses
This commit is contained in:
parent
5b9d757ca4
commit
e553ad4358
@ -4,8 +4,8 @@
|
||||
|
||||
#messages or constructors that are used all over the code
|
||||
|
||||
Logo !ident-ok: Uni2work
|
||||
EmailInvitationWarning: Diese Adresse konnte keinem Uni2work-Benutzer/keiner Uni2work-Benutzerin zugeordnet werden. Es wird eine Einladung per E-Mail versandt.
|
||||
Logo !ident-ok: FRADrive
|
||||
EmailInvitationWarning: Diese Adresse konnte keinem FRADrive-Benutzer/-Benutzerin zugeordnet werden. Es wird eine Einladung per E-Mail versandt.
|
||||
BoolIrrelevant !ident-ok: —
|
||||
FieldPrimary: Hauptfach
|
||||
FieldSecondary: Nebenfach
|
||||
@ -15,6 +15,7 @@ WeekDay: Wochentag
|
||||
LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
|
||||
Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}
|
||||
Days num@Int64: #{num} #{pluralDE num "Tag" "Tage"}
|
||||
NoAutomaticUpdateTip: Dieser Wert wurde manuell editiert und wird daher nicht mehr automatisch aktualisiert.
|
||||
|
||||
ClusterVolatileQuickActionsEnabled: Schnellzugriffsmenü aktiv
|
||||
|
||||
|
||||
@ -4,8 +4,8 @@
|
||||
|
||||
#messages or constructors that are used all over the Code
|
||||
|
||||
Logo: Uni2work
|
||||
EmailInvitationWarning: This address could not be matched to any Uni2work user. An invitation will be sent via email.
|
||||
Logo: FRADrive
|
||||
EmailInvitationWarning: This address could not be matched to any FRADrive user. An invitation will be sent via email.
|
||||
BoolIrrelevant: —
|
||||
FieldPrimary: Major
|
||||
FieldSecondary: Minor
|
||||
@ -15,6 +15,7 @@ WeekDay: Day of the week
|
||||
LdapIdentificationOrEmail: Fraport AG-Kennung / email address
|
||||
Months num: #{num} #{pluralEN num "Month" "Months"}
|
||||
Days num: #{num} #{pluralEN num "Day" "Days"}
|
||||
NoAutomaticUpdateTip: This value receives no automatic updates, since it has been edited manually.
|
||||
|
||||
ClusterVolatileQuickActionsEnabled: Quick actions enabled
|
||||
|
||||
|
||||
@ -587,9 +587,7 @@ makeProfileData :: Entity User -> DB Widget
|
||||
makeProfileData usrEnt@(Entity uid User{..}) = do
|
||||
now <- liftIO getCurrentTime
|
||||
avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid)
|
||||
(actualPrefersPostal, actualPostAddress, actualDisplayEmail) <- getPostalPreferenceAndAddress' usrEnt
|
||||
let postalAutomatic = isJust actualPostAddress && isNothing userPostAddress -- address is either from company or department
|
||||
emailAutomatic = isJust actualDisplayEmail && not (validEmail' userDisplayEmail)
|
||||
(actualPrefersPostal, (actualPostAddress, postalAutomatic), (actualDisplayEmail, emailAutomatic)) <- getPostalPreferenceAndAddress' usrEnt
|
||||
functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] []
|
||||
lecture_corrector <- E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
|
||||
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
||||
@ -642,8 +640,7 @@ makeProfileData usrEnt@(Entity uid User{..}) = do
|
||||
mCRoute <- getCurrentRoute
|
||||
showAdminInfo <- pure (mCRoute == Just (AdminUserR cID)) `or2M` hasReadAccessTo (AdminUserR cID)
|
||||
tooltipAvsPersNo <- messageI Info MsgAvsPersonNoNotId
|
||||
tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress
|
||||
|
||||
tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress
|
||||
let profileRemarks = $(i18nWidgetFile "profile-remarks")
|
||||
return $(widgetFile "profileData")
|
||||
|
||||
|
||||
@ -190,4 +190,7 @@ msgAdminProblem AdminProblemSupervisorLeftCompany{adminProblemCompany=comp, admi
|
||||
msgAdminProblem AdminProblemNewlyUnsupervised{adminProblemCompanyOld=comp, adminProblemCompanyNew=newComp} = return $
|
||||
SomeMessages [SomeMessage MsgAdminProblemNewlyUnsupervised, text2message ": ", maybe (text2message "???") company2msg comp, text2message " -> ", company2msg newComp]
|
||||
msgAdminProblem AdminProblemUnknown{adminProblemText=err} = return $
|
||||
someMessages ["Problem: ", err]
|
||||
someMessages ["Problem: ", err]
|
||||
|
||||
updateAutomatic :: Bool -> Widget
|
||||
updateAutomatic = iconTooltip [whamlet|_{MsgNoAutomaticUpdateTip}|] (Just IconLocked)
|
||||
@ -340,17 +340,25 @@ updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMa
|
||||
, CheckUpdate UserDisplayName _avsInfoDisplayName
|
||||
, CheckUpdate UserBirthday _avsInfoDateOfBirth
|
||||
, CheckUpdate UserMobile _avsInfoPersonMobilePhoneNo
|
||||
, CheckUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
|
||||
, CheckUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo
|
||||
]
|
||||
em_p_up = mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo $
|
||||
CheckUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI -- Maybe im AvsInfo, aber nicht im User
|
||||
em_f_up = mkUpdate' usr newAvsFirmInfo oldAvsFirmInfo $ -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
|
||||
CheckUpdate UserDisplayEmail $ _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
|
||||
eml_up = em_p_up <|> em_f_up -- ensure that only one email update is produced; there is no Eq instance for the Update type
|
||||
frm_up = mkUpdate' usr newAvsFirmInfo oldAvsFirmInfo $ -- Legacy, if company postal is stored in user; should no longer be true for new users,
|
||||
CheckUpdate UserPostAddress _avsFirmPostAddress -- since company address should now be referenced with UserCompany instead
|
||||
pin_up = mkUpdate' usr newAvsCardNo oldAvsCardNo $ -- Maybe update PDF pin to latest card
|
||||
, CheckUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
|
||||
, CheckUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo
|
||||
]
|
||||
apiEmail = _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI
|
||||
afiEmail = _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
|
||||
em_p_up = mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo $ CheckUpdate UserDisplayEmail apiEmail -- Maybe im AvsInfo, aber nicht im User
|
||||
em_f_up = mkUpdate' usr newAvsFirmInfo oldAvsFirmInfo $ CheckUpdate UserDisplayEmail afiEmail -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
|
||||
eml_up -- Ensure that only one email update is produced; there is no Eq instance for the Update type
|
||||
| isJust em_f_up, mempty == newAvsFirmInfo ^. afiEmail -- Was some FirmEmail, but this is no longer the case; update to PersonalEmail, if possible
|
||||
= mkUpdate' usr newAvsPersonInfo Nothing $ CheckUpdate UserDisplayEmail apiEmail
|
||||
| isJust em_f_up -- Update FirmEmail
|
||||
= em_f_up
|
||||
| isJust em_p_up, mempty == newAvsPersonInfo ^. apiEmail -- Was PersonalEmai, but this is no longer the case; update to FirmEmail, if possible
|
||||
= mkUpdate' usr newAvsFirmInfo Nothing $ CheckUpdate UserDisplayEmail afiEmail
|
||||
| otherwise -- Maybe update PersonalEmail
|
||||
= em_p_up
|
||||
frm_up = mkUpdate' usr newAvsFirmInfo oldAvsFirmInfo $ -- Legacy, if company postal is stored in user; should no longer be true for new users,
|
||||
CheckUpdate UserPostAddress _avsFirmPostAddress -- since company address should now be referenced with UserCompany instead
|
||||
pin_up = mkUpdate' usr newAvsCardNo oldAvsCardNo $ -- Maybe update PDF pin to latest card
|
||||
CheckUpdate UserPinPassword $ to $ fmap avsFullCardNo2pin -- _Just . to avsFullCardNo2pin . re _Just
|
||||
usr_up1 = eml_up `mcons` (frm_up `mcons` (pin_up `mcons` per_ups))
|
||||
avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
|
||||
|
||||
@ -18,6 +18,7 @@ module Handler.Utils.Users
|
||||
, getUserPrimaryCompany, getUserPrimaryCompanyAddress
|
||||
, getUserEmail
|
||||
, getEmailAddress, getJustEmailAddress
|
||||
, getUserEmailAutomatic
|
||||
, getEmailAddressFor, getJustEmailAddressFor
|
||||
, getPostalAddress, getPostalAddress'
|
||||
, getPostalPreferenceAndAddress, getPostalPreferenceAndAddress'
|
||||
@ -102,13 +103,13 @@ getPostalPreferenceAndAddress usr = do
|
||||
|
||||
-- | result (True, Nothing, Nothing) indicates that neither userEmail nor userPostAddress is known
|
||||
-- primed variant returns storedMarkup without prefixed userDisplayName
|
||||
getPostalPreferenceAndAddress' :: Entity User -> DB (Bool, Maybe StoredMarkup, Maybe UserEmail)
|
||||
getPostalPreferenceAndAddress' :: Entity User -> DB (Bool, (Maybe StoredMarkup, Bool), (Maybe UserEmail, Bool))
|
||||
getPostalPreferenceAndAddress' usr = do
|
||||
pa <- getPostalAddress' usr
|
||||
em <- getUserEmail usr
|
||||
pa <- getPostalAddress' usr
|
||||
em <- getUserEmailAutomatic usr
|
||||
let usrPrefPost = usr ^. _entityVal . _userPrefersPostal
|
||||
finalPref = (usrPrefPost && isJust pa) || isNothing em
|
||||
-- finalPref = isJust pa && (usrPrefPost || isNothing em)
|
||||
finalPref = (usrPrefPost && isJust (fst pa)) || isNothing (fst em)
|
||||
-- finalPref = isJust (fst pa) && (usrPrefPost || isNothing (fst em))
|
||||
return (finalPref, pa, em)
|
||||
|
||||
getEmailAddressFor :: UserId -> DB (Maybe Address)
|
||||
@ -133,6 +134,21 @@ getUserEmail Entity{entityKey=uid, entityVal=User{userDisplayEmail, userEmail}}
|
||||
compEmailMb <- getUserPrimaryCompanyAddress uid companyEmail
|
||||
return $ pickValidEmail' $ mcons compEmailMb [userEmail]
|
||||
|
||||
-- like `getUserEmail`, but also checks whether the Email will be update automatically
|
||||
getUserEmailAutomatic :: Entity User -> DB (Maybe UserEmail, Bool)
|
||||
getUserEmailAutomatic Entity{entityKey=uid, entityVal=User{userDisplayEmail, userEmail}}
|
||||
| validEmail' userDisplayEmail
|
||||
= do
|
||||
muavs <- getBy $ UniqueUserAvsUser uid
|
||||
let auto = userDisplayEmail == muavs ^. _Just . _userAvsLastFirmInfo . _Just . _avsFirmPrimaryEmail . _Just . from _CI -- Recall: _Just on Nothing yields mempty here
|
||||
|| userDisplayEmail == muavs ^. _Just . _userAvsLastPersonInfo . _Just . _avsInfoPersonEMail . _Just . from _CI
|
||||
return (Just userDisplayEmail, auto)
|
||||
| otherwise
|
||||
= getUserPrimaryCompanyAddress uid companyEmail >>= \case
|
||||
Just compEmail | validEmail' compEmail -> return (Just compEmail, True )
|
||||
Nothing | validEmail' userEmail -> return (Just userEmail, False)
|
||||
_ -> return (Nothing , False)
|
||||
|
||||
-- address is prefixed with userDisplayName
|
||||
getPostalAddress :: Entity User -> DB (Maybe [Text])
|
||||
getPostalAddress Entity{entityKey=uid, entityVal=User{..}}
|
||||
@ -151,22 +167,25 @@ getPostalAddress Entity{entityKey=uid, entityVal=User{..}}
|
||||
where
|
||||
prefixMarkupName = return . Just . (userDisplayName :) . html2textlines
|
||||
|
||||
-- primed variant returns storedMarkup without prefixed userDisplayName
|
||||
getPostalAddress' :: Entity User -> DB (Maybe StoredMarkup)
|
||||
-- primed variant returns storedMarkup without prefixed userDisplayName and whether updates are automatic
|
||||
getPostalAddress' :: Entity User -> DB (Maybe StoredMarkup, Bool)
|
||||
getPostalAddress' Entity{entityKey=uid, entityVal=User{..}}
|
||||
| res@(Just _) <- userPostAddress
|
||||
= return res
|
||||
| res@(Just upo) <- userPostAddress
|
||||
= do
|
||||
muavs <- getBy $ UniqueUserAvsUser uid
|
||||
let auto = upo == muavs ^. _Just . _userAvsLastFirmInfo . _Just . _avsFirmPostAddress . _Just -- Recall: _Just on Nothing yields mempty here
|
||||
return (res, auto)
|
||||
| otherwise
|
||||
= do
|
||||
getUserPrimaryCompanyAddress uid companyPostAddress >>= \case
|
||||
res@(Just _)
|
||||
-> return res
|
||||
-> return (res, True)
|
||||
Nothing
|
||||
| Just abt <- userCompanyDepartment
|
||||
-> return $ Just $ plaintextToStoredMarkup $ textUnlines $
|
||||
-> return $ (,True) $ Just $ plaintextToStoredMarkup $ textUnlines $
|
||||
if | "BVD" `isPrefixOf` abt -> [userDisplayName, abt, "Bodenverkehrsdienste"]
|
||||
| otherwise -> [userDisplayName, abt, "Hausbriefkasten" ]
|
||||
| otherwise -> return Nothing
|
||||
| otherwise -> return (Nothing, True)
|
||||
|
||||
-- | Consider using Handler.Utils.Avs.updateReceivers instead
|
||||
-- Return Entity User and all Supervisors with rerouteNotifications as well as
|
||||
|
||||
@ -298,10 +298,11 @@ isNew :: Bool -> Markup
|
||||
isNew True = icon IconNew
|
||||
isNew False = mempty
|
||||
|
||||
-- ^ Maybe display an icon that denotes that something™ is NOT automagically updated or derived, but had been edited
|
||||
isAutomatic :: Bool -> Markup
|
||||
isAutomatic True = mempty -- icon IconMagic
|
||||
isAutomatic False = icon IconLocked -- IconEdit
|
||||
-- DEPRECATED by Handler.Utils.updateAutomatic, which includes a helpful tooltip
|
||||
-- Maybe display an icon that denotes that something™ is NOT automagically updated or derived, but had been edited
|
||||
-- isAutomatic :: Bool -> Markup
|
||||
-- isAutomatic True = mempty -- icon IconMagic
|
||||
-- isAutomatic False = icon IconLocked -- IconEdit
|
||||
|
||||
boolSymbol :: Bool -> Markup
|
||||
boolSymbol True = icon IconOK
|
||||
|
||||
@ -7,21 +7,17 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<section>
|
||||
<h2>Hinweise
|
||||
<ul>
|
||||
<li>
|
||||
Sichern Sie bitte Ihre Daten! Die Uni2work Datenbank wird täglich gesichert;
|
||||
dennoch können wir Probleme noch nicht gänzlich ausschließen.
|
||||
<li>
|
||||
Nicht aufgeführt sind Zeitstempel mit Benutzerinformationen, z.B. bei der Editierung und Korrektur von Übungen, Kursleiterschaft, Raumbuchungen, etc.
|
||||
<li>
|
||||
<p>
|
||||
Sie können die
|
||||
<a href=@{HelpR}>
|
||||
Löschung Ihre Daten über eine Supportanfrage beantragen
|
||||
. Ihre Daten werden dann nach Ablauf einer Frist gelöscht.
|
||||
Daten, welche keiner gesetzlichen Aufbewahrungsfrist unterliegen
|
||||
(z.B. Klausurnoten) verbleiben im System bis zur Ablauf der Aufbewahrungsfrist.
|
||||
Löschung Ihrer Daten über eine Supportanfrage beantragen
|
||||
. Ihre Daten werden dann nach Ablauf einer Frist gelöscht.
|
||||
Daten, welche keiner gesetzlichen Aufbewahrungsfrist unterliegen
|
||||
verbleiben im System bis zur Ablauf der Aufbewahrungsfrist.
|
||||
<p>
|
||||
Benutzerdaten bleiben prinzipiell so lange gespeichert,
|
||||
bis ein Bereichsadministrator über die Exmatrikulation informiert wurde.
|
||||
Dann wird der Account mit einer angemessenen zeitverzögerung gelöscht.
|
||||
Benutzerdaten bleiben prinzipiell so lange gespeichert,
|
||||
bis der Account nach einer angemessenen Zeitverzögerung nach Ablauf aller Qualifikation automatisch gelöscht wurde.
|
||||
Anonymisierte Prüfungsnoten verbleiben aus statistischen Gründen dauerhaft im System.
|
||||
|
||||
@ -7,9 +7,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<section>
|
||||
<h2>Remarks
|
||||
<ul>
|
||||
<li>
|
||||
Back up your data! Uni2work's database is backed up daily but we can
|
||||
nontheless not guarantee that there will be no problems.
|
||||
<li>
|
||||
Timestamps with user information (e.g. editing of corrections, submission groups, rooms, ...) are not shown here.
|
||||
<li>
|
||||
@ -18,12 +15,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<a href=@{HelpR}>
|
||||
a support request
|
||||
.
|
||||
Your data will then be deleted after a suitable time period has passed.
|
||||
Data that falls under legal retention periods (e.g. exam results) remian
|
||||
Your data will then be deleted after a suitable time period has passed.
|
||||
Data that falls under legal retention periods remain
|
||||
in the system until their retention period has passed.
|
||||
<p>
|
||||
User data remains in the system (in principle) until a department
|
||||
administrator has been informed of exmatriculation.
|
||||
After a suitable time period has passed the account is deleted.
|
||||
Anonymised exam results remain in the system indefinitely for
|
||||
statistical purposes.
|
||||
User data remains in the system until
|
||||
a suitable time period has passed after the expiry all qualifications and the account is automatically deleted.
|
||||
Anonymised online exam results remain in the system indefinitely for
|
||||
statistical purposes.
|
||||
|
||||
@ -59,7 +59,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
_{MsgAdminUserPostAddress}
|
||||
<dd .deflist__dd>
|
||||
#{addr} #
|
||||
#{isAutomatic postalAutomatic}
|
||||
^{updateAutomatic postalAutomatic}
|
||||
$if (not postalAutomatic)
|
||||
$maybe postUpdate <- userPostLastUpdate
|
||||
<dt .deflist__dt>
|
||||
@ -68,10 +68,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
^{formatTimeW SelFormatDateTime postUpdate}
|
||||
<dt .deflist__dt>
|
||||
_{MsgUserDisplayEmail}
|
||||
<dd .deflist__dd .email>
|
||||
<dd .deflist__dd>
|
||||
$maybe primaryEmail <- actualDisplayEmail
|
||||
#{mailtoHtml primaryEmail} #
|
||||
#{isAutomatic emailAutomatic}
|
||||
<p .email>
|
||||
#{mailtoHtml primaryEmail} #
|
||||
^{updateAutomatic emailAutomatic}
|
||||
$nothing
|
||||
^{messageTooltip tooltipInvalidEmail} #
|
||||
#{mailtoHtml userDisplayEmail}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user