From e553ad4358a71fc96fa946533f0441d4af5202c9 Mon Sep 17 00:00:00 2001 From: Steffen Date: Fri, 7 Jun 2024 17:42:05 +0200 Subject: [PATCH] fix(avs): profile page correctly indicates automatic email and postal addresses --- messages/uniworx/misc/de-de-formal.msg | 5 ++- messages/uniworx/misc/en-eu.msg | 5 ++- src/Handler/Profile.hs | 7 +-- src/Handler/Utils.hs | 5 ++- src/Handler/Utils/Avs.hs | 30 ++++++++----- src/Handler/Utils/Users.hs | 43 +++++++++++++------ src/Utils/Icon.hs | 9 ++-- .../i18n/profile-remarks/de-de-formal.hamlet | 16 +++---- templates/i18n/profile-remarks/en-eu.hamlet | 16 +++---- templates/profileData.hamlet | 9 ++-- 10 files changed, 84 insertions(+), 61 deletions(-) diff --git a/messages/uniworx/misc/de-de-formal.msg b/messages/uniworx/misc/de-de-formal.msg index 3ed3bd645..36db7750e 100644 --- a/messages/uniworx/misc/de-de-formal.msg +++ b/messages/uniworx/misc/de-de-formal.msg @@ -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 diff --git a/messages/uniworx/misc/en-eu.msg b/messages/uniworx/misc/en-eu.msg index d652ed4ba..b968ce9c0 100644 --- a/messages/uniworx/misc/en-eu.msg +++ b/messages/uniworx/misc/en-eu.msg @@ -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 diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index ee965626e..0b16e8d5e 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -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") diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 8043737de..faf9df267 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -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] \ No newline at end of file + someMessages ["Problem: ", err] + +updateAutomatic :: Bool -> Widget +updateAutomatic = iconTooltip [whamlet|_{MsgNoAutomaticUpdateTip}|] (Just IconLocked) \ No newline at end of file diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 0d5efb874..af7610502 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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` diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 686dc8692..293dc4f7b 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -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 diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index db18d2772..d5d2fc413 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -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 diff --git a/templates/i18n/profile-remarks/de-de-formal.hamlet b/templates/i18n/profile-remarks/de-de-formal.hamlet index 362931765..f851d9b81 100644 --- a/templates/i18n/profile-remarks/de-de-formal.hamlet +++ b/templates/i18n/profile-remarks/de-de-formal.hamlet @@ -7,21 +7,17 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

Hinweise