fix(avs): profile page correctly indicates automatic email and postal addresses

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
+Logo !ident-ok: FRADrive
-EmailInvitationWarning: Diese Adresse konnte keinem Uni2work-Benutzer/keiner Uni2work-Benutzerin zugeordnet werden. Es wird eine Einladung per E-Mail versandt.
+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
 

messages/uniworx/misc/en-eu.msg

@@ -4,8 +4,8 @@
 
 #messages or constructors that are used all over the Code
 
-Logo: Uni2work
+Logo: FRADrive
-EmailInvitationWarning: This address could not be matched to any Uni2work user. An invitation will be sent via email.
+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
 

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
+  (actualPrefersPostal, (actualPostAddress, postalAutomatic), (actualDisplayEmail, emailAutomatic)) <- getPostalPreferenceAndAddress' usrEnt
-  let postalAutomatic = isJust actualPostAddress  && isNothing userPostAddress          -- address is either from company or department                    
-      emailAutomatic  = isJust actualDisplayEmail && not (validEmail' userDisplayEmail)
   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
@@ -643,7 +641,6 @@ makeProfileData usrEnt@(Entity uid User{..}) = do
   showAdminInfo <- pure (mCRoute == Just (AdminUserR cID)) `or2M` hasReadAccessTo (AdminUserR cID)  
   tooltipAvsPersNo <- messageI Info MsgAvsPersonNoNotId
   tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress  
-
   let profileRemarks = $(i18nWidgetFile "profile-remarks")
   return $(widgetFile "profileData")
 

src/Handler/Utils.hs

@@ -191,3 +191,6 @@ msgAdminProblem AdminProblemNewlyUnsupervised{adminProblemCompanyOld=comp, admin
   SomeMessages [SomeMessage MsgAdminProblemNewlyUnsupervised, text2message ": ", maybe (text2message "???") company2msg comp, text2message " -> ", company2msg newComp]
 msgAdminProblem AdminProblemUnknown{adminProblemText=err} = return $
   someMessages ["Problem: ", err]  
+
+updateAutomatic :: Bool -> Widget
+updateAutomatic = iconTooltip [whamlet|_{MsgNoAutomaticUpdateTip}|] (Just IconLocked)

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 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
+                      , CheckUpdate UserCompanyPersonalNumber  $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just   -- Maybe im User und im AvsInfo
                       ]
-            em_p_up = mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo  $
+            apiEmail = _avsInfoPersonEMail  . to (fromMaybe mempty) . from _CI
-                        CheckUpdate UserDisplayEmail           $ _avsInfoPersonEMail  . to (fromMaybe mempty) . from _CI                 -- Maybe im AvsInfo, aber nicht im User
+            afiEmail = _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
-            em_f_up = mkUpdate' usr newAvsFirmInfo   oldAvsFirmInfo    $                                                                    -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
+            em_p_up = mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo  $ CheckUpdate UserDisplayEmail apiEmail                            -- Maybe im AvsInfo, aber nicht im User
-                        CheckUpdate UserDisplayEmail           $ _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
+            em_f_up = mkUpdate' usr newAvsFirmInfo   oldAvsFirmInfo    $ CheckUpdate UserDisplayEmail afiEmail                            -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.          
-            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
+            eml_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,
+              | isJust em_f_up, mempty == newAvsFirmInfo   ^. afiEmail                                                                    -- Was some FirmEmail, but this is no longer the case; update to PersonalEmail, if possible
-                        CheckUpdate UserPostAddress _avsFirmPostAddress                                                                     -- since company address should now be referenced with UserCompany instead
+                = mkUpdate' usr newAvsPersonInfo Nothing $ CheckUpdate UserDisplayEmail apiEmail
-            pin_up  = mkUpdate' usr newAvsCardNo     oldAvsCardNo      $                                                                    -- Maybe update PDF pin to latest card
+              | 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`

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
+  pa <- getPostalAddress'     usr
-  em <- getUserEmail   usr
+  em <- getUserEmailAutomatic usr
   let usrPrefPost = usr ^. _entityVal . _userPrefersPostal
-      finalPref   = (usrPrefPost && isJust pa) || isNothing em
+      finalPref   = (usrPrefPost && isJust (fst pa)) || isNothing (fst em)
-      -- finalPref   = isJust pa && (usrPrefPost || isNothing 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
+--  primed variant returns storedMarkup without prefixed userDisplayName and whether updates are automatic
-getPostalAddress' :: Entity User -> DB (Maybe StoredMarkup)
+getPostalAddress' :: Entity User -> DB (Maybe StoredMarkup, Bool)
 getPostalAddress' Entity{entityKey=uid, entityVal=User{..}}
-  | res@(Just _) <- userPostAddress
+  | res@(Just upo) <- userPostAddress
-    = return res
+    = 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

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
+-- DEPRECATED by Handler.Utils.updateAutomatic, which includes a helpful tooltip
-isAutomatic :: Bool -> Markup
+-- Maybe display an icon that denotes that something™ is NOT automagically updated or derived, but had been edited
-isAutomatic True  = mempty          -- icon IconMagic
+-- isAutomatic :: Bool -> Markup
-isAutomatic False = icon IconLocked -- IconEdit
+-- isAutomatic True  = mempty          -- icon IconMagic
+-- isAutomatic False = icon IconLocked -- IconEdit
 
 boolSymbol :: Bool -> Markup
 boolSymbol True  = icon IconOK

templates/i18n/profile-remarks/de-de-formal.hamlet

@@ -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
+          Löschung Ihrer 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.
+        verbleiben im System bis zur Ablauf der Aufbewahrungsfrist. 
       <p>
         Benutzerdaten bleiben prinzipiell so lange gespeichert, 
-        bis ein Bereichsadministrator über die Exmatrikulation informiert wurde.
+        bis der Account nach einer angemessenen Zeitverzögerung nach Ablauf aller Qualifikation automatisch gelöscht wurde. 
-        Dann wird der Account mit einer angemessenen zeitverzögerung gelöscht.
         Anonymisierte Prüfungsnoten verbleiben aus statistischen Gründen dauerhaft im System.

templates/i18n/profile-remarks/en-eu.hamlet

@@ -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>
@@ -19,11 +16,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
           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
+        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
+        User data remains in the system until 
-        administrator has been informed of exmatriculation.
+        a suitable time period has passed after the expiry all qualifications and the account is automatically deleted. 
-        After a suitable time period has passed the account is deleted.
+        Anonymised online exam results remain in the system indefinitely for 
-        Anonymised exam results remain in the system indefinitely for
         statistical purposes. 

templates/profileData.hamlet

@@ -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} #
+          <p .email>
-          #{isAutomatic emailAutomatic}
+            #{mailtoHtml primaryEmail} #
+          ^{updateAutomatic emailAutomatic}
         $nothing
           ^{messageTooltip tooltipInvalidEmail} #
           #{mailtoHtml userDisplayEmail}