Merge branch 'master' into fradrive/tutorial-overhaul

messages/uniworx/categories/jobs_handler/de-de-formal.msg

@@ -12,9 +12,9 @@ CommUndisclosedRecipients: Verborgene Empfänger:innen
 CommAllRecipients: alle-empfaenger
 CommAllRecipientsSheet: Empfänger:innen
 ResetPassword: FRADrive-Passwort ändern bzw. setzen
-MailSubjectChangeUserDisplayEmail: Diese E-Mail-Adresse in FRADrive veröffentlichen
+MailSubjectChangeUserDisplayEmail: E-Mail-Adresse in FRADrive verwenden
-MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer/Die oben genannte Benutzerin möchte „#{displayEmail}“ als öffentliche Adresse, assoziiert mit sich selbst, angeben. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte!
+MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer/Die oben genannte Benutzerin möchte „#{displayEmail}“ als E-Mail-Adresse in FRADrive verwenden. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte!
-MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail-Adresse in FRADrive veröffentlichen
+MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail-Adresse in FRADrive verwenden
 CommCourseSubject: Kursmitteilung
 InvitationAcceptDecline: Einladung annehmen/ablehnen
 InvitationFromTip displayName@Text: Sie erhalten diese Einladung, weil #{displayName} ihren Versand in FRADrive ausgelöst hat.

messages/uniworx/categories/jobs_handler/en-eu.msg

@@ -12,9 +12,9 @@ CommUndisclosedRecipients: Undisclosed recipients
 CommAllRecipients: all-recipients
 CommAllRecipientsSheet: Recipients
 ResetPassword: Reselt FRADrive password
-MailSubjectChangeUserDisplayEmail: Publishing this email address in FRADrive
+MailSubjectChangeUserDisplayEmail: Set email address in FRADrive
-MailIntroChangeUserDisplayEmail displayEmail: The user mentioned above wants to publish “#{displayEmail}” as their own email address. If you have not caused this email to be sent, please ignore it!
+MailIntroChangeUserDisplayEmail displayEmail: The user mentioned above wants to set “#{displayEmail}” as their own email address. If you have not caused this email to be sent, please ignore it!
-MailTitleChangeUserDisplayEmail displayName: #{displayName} wants to publish this email address as their own in FRADrive
+MailTitleChangeUserDisplayEmail displayName: #{displayName} wants to set this email address as their own in FRADrive
 CommCourseSubject: Course message
 InvitationAcceptDecline: Accept/Decline invitation
 InvitationFromTip displayName: You are receiving this invitation because #{displayName} has caused it to be sent from within FRADrive.

messages/uniworx/categories/settings/de-de-formal.msg

@@ -8,9 +8,11 @@ FormPersonalAppearance: Öffentliche Daten
 UserDisplayName: Angezeigter Name
 UserDisplayNameInvalid: Angezeigter Name erfüllt nicht die Vorgaben
 UserDisplayNameRulesBelow: Vorgaben für den angezeigten Namen finden sich weiter unten auf der Seite
-UserDisplayEmail: Angezeigte E-Mail-Adresse
+UserSystemEmail: System E-Mail Adresse
-UserDisplayEmailTip: Diese Adresse wird in öffentlich zugänglichen Teilen des Systems im Zusammenhang mit Ihrem Namen angezeigt. Benachrichtigungen und andere Kommunikation von Uni2work und Nutzer:innen mit erweiterten Rechten erhalten sie stets, unabhängig von dieser Einstellung, an die in Ihren Persönlichen Daten hinterlegte primäre Adresse.
+UserDisplayEmail: E-Mail-Adresse
-UserDisplayEmailChangeSent displayEmail@UserEmail: Anweisungen zum Ändern der angezeigten E-Mail-Adresse wurden an „#{displayEmail}” versandt
+UserDisplayEmailTip: Diese Adresse wird in öffentlich zugänglichen Teilen des Systems im Zusammenhang mit Ihrem Namen angezeigt. Falls diese ungültig ist gehen Benachrichtigungen an ihre System E-Mail-Adresse.
+UserDisplayEmailChangeSent displayEmail@UserEmail: Anweisungen zum Ändern der E-Mail-Adresse wurden an „#{displayEmail}” versandt
+UserDisplayEmailChanged: Öffentliche E-Mail-Adresse erfolgreich gesetzt
 
 FormCosmetics: Oberfläche
 
@@ -94,7 +96,6 @@ ProfileLdapPrimaryKey: LDAP-Primärschlüssel
 
 NotificationSettingsUpdate: Benachrichtigungs-Einstellungen erfolgreich gespeichert
 NotificationSettingsHeading displayName@Text: Benachrichtigungs-Einstellungen für #{displayName}
-UserDisplayEmailChanged: Öffentliche E-Mail-Adresse erfolgreich gesetzt
 FavouriteVisited: Kürzlich besucht
 FavouriteParticipant: Ihre Kurse
 FavouriteManual: Favoriten

messages/uniworx/categories/settings/en-eu.msg

@@ -8,9 +8,11 @@ FormPersonalAppearance: Public data
 UserDisplayName: Display name
 UserDisplayNameInvalid: Display name does not comply with specification
 UserDisplayNameRulesBelow: Specifications of what can be a display name can be found below
-UserDisplayEmail: Display email
+UserSystemEmail: System Email address
-UserDisplayEmailTip: This email address may be displayed publicly alongside your display name. Notifications and other communication from Uni2work or users with elevated permissions are always sent to your primary email address as specified under "personal information".
+UserDisplayEmail: Email
+UserDisplayEmailTip: This email address may be displayed publicly alongside your display name. If invalid, notifications will be sent to your system email address instead.
 UserDisplayEmailChangeSent displayEmail: Instructions to change your display email have been sent to “#{displayEmail}”.
+UserDisplayEmailChanged: Successfully set display email
 
 FormCosmetics: Interface
 
@@ -94,7 +96,6 @@ ProfileLdapPrimaryKey: LDAP primary key
 
 NotificationSettingsUpdate: Successfully updated notification settings
 NotificationSettingsHeading displayName: Notification settings for #{displayName}
-UserDisplayEmailChanged: Successfully set display email
 FavouriteVisited: Visited
 FavouriteParticipant: Your courses
 FavouriteManual: Favourites

messages/uniworx/categories/user/de-de-formal.msg

@@ -6,8 +6,8 @@ AdminUserTitle: Titel
 AdminUserFirstName: Vorname
 AdminUserSurname: Nachname
 AdminUserDisplayName: Anzeige-Name
-AdminUserEmail: E-Mail-Adresse
+AdminUserEmail: System E-Mail
-AdminUserDisplayEmail: Anzeige-E-Mail
+AdminUserDisplayEmail: E-Mail-Adresse
 AdminUserIdent: Identifikation
 AdminUserAuth: Authentifizierung
 AdminUserAuthTooltip: Abhängig von der Auswahl werden neue Benutzer über ihr neues FRADrive Konto benachrichtigt.

messages/uniworx/categories/user/en-eu.msg

@@ -6,8 +6,8 @@ AdminUserTitle: Title
 AdminUserFirstName: Given name
 AdminUserSurname: Surname
 AdminUserDisplayName: Display name
-AdminUserEmail: Email address
+AdminUserEmail: System Email address
-AdminUserDisplayEmail: Display email
+AdminUserDisplayEmail: Email address
 AdminUserIdent: Identification
 AdminUserAuth: Authentication
 AdminUserAuthTooltip: New users may be notified about their FRADrive account depending on this choice.

messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg

@@ -88,7 +88,7 @@ BreadcrumbVersion: Versionsgeschichte
 BreadcrumbHelp: Hilfe
 BreadcrumbHealth: Instanz-Zustand
 BreadcrumbInstance: Instanz-Identifikation
-BreadcrumbUserDisplayEmail: Angezeigte E-Mail-Adresse
+BreadcrumbUserDisplayEmail: E-Mail-Adresse
 BreadcrumbProfileData: Persönliche Daten
 BreadcrumbAuthPreds: Authorisierungseinstellungen
 BreadcrumbTermShow: Semester

messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg

@@ -88,7 +88,7 @@ BreadcrumbVersion: Version history
 BreadcrumbHelp: Support
 BreadcrumbHealth: Instance health
 BreadcrumbInstance: Instance identification
-BreadcrumbUserDisplayEmail: Display email
+BreadcrumbUserDisplayEmail: Email address
 BreadcrumbProfileData: Personal information
 BreadcrumbAuthPreds: Authorisation settings
 BreadcrumbTermShow: Semesters

models/avs.model

@@ -23,6 +23,7 @@ UserAvs
 
 -- Multiple UserAvsCards per UserAvs is possible and not too uncommon.
 -- Purpose of saving cards is to detect external changes in qualifications and postal addresses
+-- TODO: This table will be deleted if AVS CR3 SCF-165 is implemented
 UserAvsCard 
   personId        AvsPersonId    
   cardNo          AvsFullCardNo  

models/users.model

@@ -88,8 +88,8 @@ UserGroupMember
 UserCompany 
     user                  UserId  
     company               CompanyId  OnDeleteCascade OnUpdateCascade
-    supervisor            Bool       -- should this user be made supervisor for all _new_ users associated with this company?        
+    supervisor            Bool       default=false -- should this user be made supervisor for all _new_ users associated with this company?        
-    supervisorReroute     Bool       default=true -- if supervisor is true, should this supervisor receive email for _new_ company users?
+    supervisorReroute     Bool       default=false -- if supervisor is true, should this supervisor receive email for _new_ company users?
     UniqueUserCompany user company   -- a user may belong to multiple companies, but to each one only once
     deriving Generic
 UserSupervisor

src/Foundation/Instances.hs

@@ -259,8 +259,8 @@ instance YesodMail UniWorX where
               return user
             let recipUserCompare = mconcat
                   [ comparing $ Down . (== recipAddr) . userIdent . entityVal
-                  , comparing $ Down . (== recipAddr) . userEmail . entityVal
                   , comparing $ Down . (== recipAddr) . userDisplayEmail . entityVal
+                  , comparing $ Down . (== recipAddr) . userEmail . entityVal
                   ]
             return $ if
               | ( bU : us ) <- sortBy recipUserCompare recipUsers

src/Handler/Course/Edit.hs

@@ -117,7 +117,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
         miCell :: ListPosition -> Either UserEmail UserId -> Maybe (Maybe LecturerType) -> (Text -> Text) -> Form (Maybe LecturerType)
         miCell _ (Right lid) defType nudge = \csrf -> do
           (lrwRes,lrwView) <- mreq (selectField optionsFinite) (fslI MsgCourseLecturerType & addName (nudge "lecturer-type")) (join defType)
-          User{userEmail, userDisplayName, userSurname} <- liftHandler . runDB $ get404 lid
+          usr <- liftHandler . runDB $ get404 lid
           let lrwView' = $(widgetFile "course/lecturerMassInput/cellKnown")
           return (Just <$> lrwRes,lrwView')
         miCell _ (Left lEmail) defType nudge = \csrf -> do

src/Handler/Course/Show.hs

@@ -168,7 +168,7 @@ getCShowR tid ssh csh = do
               tutTutors <- fmap (map $(unValueN 3)) . E.select . E.from $ \(tutor `E.InnerJoin` user) -> do
                 E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
                 E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
-                return (user E.^. UserEmail, user E.^. UserDisplayName, user E.^. UserSurname)
+                return (user E.^. UserDisplayEmail, user E.^. UserDisplayName, user E.^. UserSurname)
               return [whamlet|
                        $newline never
                        <ul .list--iconless .list--inline .list--comma-separated>

src/Handler/Course/User.hs

@@ -11,27 +11,24 @@ import Import
 import Utils.Form
 import Handler.Utils
 import Handler.Utils.SheetType
-import Database.Esqueleto.Utils.TH
+import Handler.Utils.Profile (pickValidEmail)
-
+import Handler.Utils.StudyFeatures
-import qualified Database.Esqueleto.Legacy as E
+import Handler.Submission.List
-import qualified Database.Esqueleto.Utils as E
-
-import Database.Persist.Sql (deleteWhereCount)
-
-import Text.Blaze.Html.Renderer.Text (renderHtml)
 
 import Handler.Course.Register
 
 import Jobs.Queue
 
-import Handler.Submission.List
+import Database.Persist.Sql (deleteWhereCount)
+import Database.Esqueleto.Utils.TH
+import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Utils as E
 
-import Handler.Utils.StudyFeatures
+import Text.Blaze.Html.Renderer.Text (renderHtml)
 
 import qualified Data.Map as Map
 import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI
-
 import qualified Data.Text.Lazy as LT
 
 
@@ -444,9 +441,9 @@ courseUserTutorialsSection (Entity cid Course{..}) (Entity uid _) = do
               [whamlet|
                 $newline never
                 <ul .list--iconless .list--inline .list--comma-separated>
-                  $forall (Entity _ User{userEmail, userDisplayName, userSurname}) <- tutors
+                  $forall (Entity _ usr) <- tutors
                     <li>
-                      ^{nameEmailWidget userEmail userDisplayName userSurname}
+                      ^{userEmailWidget usr}
               |]
           , sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell . view (_dbrOutput . _1 . _entityVal . _tutorialRoom)
           , sortable Nothing (i18nCell MsgTableTutorialTime) $ occurrencesCell . view (_dbrOutput . _1 . _entityVal . _tutorialTime)

src/Handler/Exam/Form.hs

@@ -240,7 +240,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do
       invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
       $(widgetFile "widgets/massinput/examCorrectors/cellInvitation")
     miCell' (Right userId) = do
-      User{..} <- liftHandler . runDB $ get404 userId
+      usr <- liftHandler . runDB $ get404 userId
       $(widgetFile "widgets/massinput/examCorrectors/cellKnown")
 
     miLayout' :: MassInputLayout ListLength (Either UserEmail UserId) ()

src/Handler/ExamOffice/Users.hs

@@ -112,7 +112,7 @@ makeExamOfficeUsersForm template = renderWForm FormStandard $ do
       invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
       $(widgetFile "widgets/massinput/examOfficeUsers/cellInvitation")
     miCell' (Right uid) = do
-      User{..} <- liftHandler . runDB $ getJust uid
+      usr <- liftHandler . runDB $ getJust uid
       $(widgetFile "widgets/massinput/examOfficeUsers/cellKnown")
     miButtonAction' :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
     miButtonAction' frag = Just . SomeRoute $ cRoute :#: frag

src/Handler/ExternalExam/Form.hs

@@ -100,7 +100,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
           invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
           $(widgetFile "external-exam/staffMassInput/cellInvitation")
         miCell (Right userId) = do
-          User{..} <- liftHandler . runDB $ getJust userId
+          usr <- liftHandler . runDB $ getJust userId
           $(widgetFile "external-exam/staffMassInput/cellKnown")
         miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
         miButtonAction = Just . SomeRoute . (cRoute :#:)

src/Handler/LMS.hs

@@ -452,7 +452,7 @@ mkLmsTable nlimit noffset isAdmin (Entity qid quali) acts cols psValidator = do
         doEncode' :: LmsTableData -> LmsTableCsv
         doEncode' = LmsTableCsv
           <$>  view    (resultUser     . _entityVal . _userDisplayName)
-          <*>  view    (resultUser     . _entityVal . _userEmail)
+          <*>  view    (resultUser     . _entityVal . _userDisplayEmail)
           <*>  view    (resultQualUser . _entityVal . _qualificationUserValidUntil)
           <*>  view    (resultQualUser . _entityVal . _qualificationUserLastRefresh)
           <*>  view    (resultQualUser . _entityVal . _qualificationUserFirstHeld)

src/Handler/PrintCenter.hs

@@ -280,7 +280,7 @@ mkPJTable = do
         let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
         return (act, jobSet)
     psValidator = def & defaultSorting [SortAscBy "created"]
-                      & defaultFilter (singletonMap "acknowledged" [toPathPiece False])
+                      -- & defaultFilter (singletonMap "acknowledged" [toPathPiece False]) -- TODO: interferes with sorting!
   over _1 postprocess <$> dbTable psValidator DBTable{..}
 
 getPrintCenterR,  postPrintCenterR :: Handler Html

src/Handler/Qualification.hs

@@ -330,7 +330,7 @@ mkQualificationTable (Entity qid quali) acts cols psValidator = do
         doEncode' :: QualificationTableData -> QualificationTableCsv
         doEncode' = QualificationTableCsv
           <$>  view    (resultUser     . _entityVal . _userDisplayName)
-          <*>  view    (resultUser     . _entityVal . _userEmail)
+          <*>  view    (resultUser     . _entityVal . _userDisplayEmail)
           <*>  view    (resultQualUser . _entityVal . _qualificationUserValidUntil)
           <*>  view    (resultQualUser . _entityVal . _qualificationUserLastRefresh)                  
           <*>  preview (resultQualUser . _entityVal . _qualificationUserBlockedDue . _Just . _qualificationBlockedDay)          

src/Handler/Sheet/Form.hs

@@ -307,8 +307,8 @@ correctorForm loads' = wFormToAForm $ do
       identWidget <- case userIdent of
         Left email -> return . toWidget $ mailtoHtml email
         Right uid -> do
-          User{userEmail, userDisplayName, userSurname} <- liftHandler . runDB $ getJust uid
+          usr <- liftHandler . runDB $ getJust uid
-          return $ nameEmailWidget userEmail userDisplayName userSurname
+          return $ userEmailWidget usr
       invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
       return (res, $(widgetFile "sheetCorrectors/cell"))
 

src/Handler/Submission/Assign.hs

@@ -231,10 +231,8 @@ assignHandler tid ssh csh cid assignSids = do
       -- avoid nestes hamlet $maybe with duplicated $nothing
       getCorrector :: Maybe UserId -> (Widget,Map SheetName SheetCorrector, Text)
       getCorrector (Just uid)
-        | Just (User{..},loadMap) <- Map.lookup uid correctorMap
+        | Just (usr,loadMap) <- Map.lookup uid correctorMap
-        = (nameEmailWidget userEmail userDisplayName userSurname, loadMap, userDisplayName)
+        = (userEmailWidget usr, loadMap, usr ^. _userDisplayName)
-        --  | Just (User{..} ) <- Map.lookup uid lecturerNames
-        --  = (nameEmailWidget userEmail userDisplayName userSurname, mempty)  -- lecturers may also correct in rare cases
       getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty, mempty)
       -- avoid nestes hamlet $maybe with duplicated $nothing
       getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo

src/Handler/Submission/Helper.hs

@@ -79,7 +79,7 @@ makeSubmissionForm cid shid mASDefinition msmid uploadMode grouping mPrev isLect
         | otherwise  -> MsgEmailInvitationWarningPrevCoSubmittors
       $(widgetFile "widgets/massinput/submissionUsers/cellInvitation")
     miCell' csrf (Right uid) = do
-      (User{..}, hasSubmitted) <- liftHandler . runDB $ do
+      (usr, hasSubmitted) <- liftHandler . runDB $ do
         user <- getJust uid
         hasSubmitted <- E.selectExists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
           E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId

src/Handler/Tutorial/Form.hs

@@ -63,7 +63,7 @@ tutorialForm cid template html = do
           invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
           $(widgetFile "tutorial/tutorMassInput/cellInvitation")
         miCell' (Right userId) = do
-          User{..} <- liftHandler . runDB $ get404 userId
+          usr <- liftHandler . runDB $ get404 userId
           $(widgetFile "tutorial/tutorMassInput/cellKnown")
 
         miLayout' :: MassInputLayout ListLength (Either UserEmail UserId) ()

src/Handler/Users.hs

@@ -589,7 +589,7 @@ postAdminUserR uuid = do
     formResult systemFunctionsResult userSystemFunctionsAction
     formResult assimilateFormResult assimilateAction
     let heading =
-          [whamlet|_{MsgAdminUserHeadingFor} ^{nameEmailWidget userEmail userDisplayName userSurname}|]
+          [whamlet|_{MsgAdminUserHeadingFor} ^{userEmailWidget user}|]
     -- Delete Button needed in data-delete
     (deleteWgt, deleteEnctype) <- generateFormPost (identifyForm FIDUserDelete buttonForm :: Form ButtonDelete)
     let deleteForm = wrapForm deleteWgt def
@@ -666,7 +666,7 @@ getUserPasswordR, postUserPasswordR :: CryptoUUIDUser -> Handler Html
 getUserPasswordR = postUserPasswordR
 postUserPasswordR cID = do
   tUid <- decrypt cID
-  User{..} <- runDB $ get404 tUid
+  usr@User{..} <- runDB $ get404 tUid
   PWHashConf{..} <- getsYesod $ view _appAuthPWHash
   isModal <- hasCustomHeader HeaderIsModal
 
@@ -704,7 +704,7 @@ postUserPasswordR cID = do
     liftHandler . runDB $ update tUid [ UserAuthentication =. AuthPWHash newHash ]
     tell . pure =<< messageI Success MsgPasswordChangedSuccess
 
-  siteLayout [whamlet|_{MsgUserPasswordHeadingFor} ^{nameEmailWidget userEmail userDisplayName userSurname}|] $
+  siteLayout [whamlet|_{MsgUserPasswordHeadingFor} ^{userEmailWidget usr}|] $
     wrapForm passFormWidget def
       { formAction = Just . SomeRoute $ UserPasswordR cID
       , formEncoding = passEnctype

src/Handler/Utils/Avs.hs

@@ -393,29 +393,28 @@ upsertAvsUserById api = do
   case (mbuid, mbapd) of
     ( _     , Nothing               ) -> throwM $ AvsUserUnknownByAvs api -- User not found in AVS at all, i.e. no valid card exists yet
     (Nothing, Just AvsDataPerson{avsPersonFirstName= Text.strip -> avsFirstName, avsPersonLastName= Text.strip -> avsSurname, ..}) -> do                               -- No LDAP User, but found in AVS; create new user
-      let firmAddress = guessLicenceAddress avsPersonPersonCards
+      let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards
-          mbCompany   = firmAddress ^? _Just . _1 . _Just
+          userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr
-          userFirmAddr= plaintextToStoredMarkup . mergeCompanyAddress <$> firmAddress
           pinCard     = Set.lookupMax avsPersonPersonCards
           userPin     = personCard2pin <$> pinCard
           fakeIdent   = CI.mk $ "AVSID:" <> tshow api
           fakeNo      = CI.mk $ "AVSNO:" <> tshow avsPersonPersonNo          
           newUsr = AddUserData
-            { audTitle          = Nothing
+            { audTitle            = Nothing
-            , audFirstName      = avsFirstName
+            , audFirstName        = avsFirstName
-            , audSurname        = avsSurname
+            , audSurname          = avsSurname
-            , audDisplayName    = avsFirstName <> Text.cons ' ' avsSurname
+            , audDisplayName      = avsFirstName <> Text.cons ' ' avsSurname
-            , audDisplayEmail   = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
+            , audDisplayEmail     = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
-            , audMatriculation  = Nothing
+            , audMatriculation    = Nothing
-            , audSex            = Nothing
+            , audSex              = Nothing
-            , audBirthday       = Nothing
+            , audBirthday         = Nothing
-            , audMobile         = Nothing
+            , audMobile           = Nothing
-            , audTelephone      = Nothing
+            , audTelephone        = Nothing
-            , audFPersonalNumber = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
+            , audFPersonalNumber  = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
-            , audFDepartment    = Nothing
+            , audFDepartment      = Nothing
-            , audPostAddress    = userFirmAddr
+            , audPostAddress      = userFirmAddr
-            , audPrefersPostal  = True
+            , audPrefersPostal    = True
-            , audPinPassword    = userPin
+            , audPinPassword      = userPin
             , audEmail = fakeNo    -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
             , audIdent = fakeIdent -- use AvsPersonId instead
             , audAuth  = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personnel number is known
@@ -424,24 +423,22 @@ upsertAvsUserById api = do
       whenIsJust mbUid $ \uid -> runDB $ do
         now <- liftIO getCurrentTime
         insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo
-        forM_ avsPersonPersonCards $ -- save all cards for later
+        forM_ avsPersonPersonCards $ -- save all cards for later comparisons whether an update occurred
         -- let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard]
         -- forM_ cs $  -- only save used cards for the postal address update detection
             \avsCard -> insert_ $ UserAvsCard avsPersonPersonID (getFullCardNo avsCard) avsCard now
-        upsertUserCompany uid mbCompany
+        upsertUserCompany uid mbCompany userFirmAddr
       return mbUid
 
     (Just (Entity _ UserAvs{userAvsUser=uid}), Just AvsDataPerson{avsPersonPersonCards}) -> do -- known user, update address and pinPassword
-      let firmAddress = guessLicenceAddress avsPersonPersonCards
+      let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards          
-          mbCompany   = firmAddress ^? _Just . _1 . _Just
-          mbCoFirmAddr= mergeCompanyAddress <$> firmAddress
           userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr
           pinCard     = Set.lookupMax avsPersonPersonCards
           userPin     = personCard2pin <$> pinCard          
       runDB $ do
         now <- liftIO getCurrentTime
         oldCards <- selectList [UserAvsCardPersonId ==. api] []
-        let oldAddrs = Set.fromList $ mapMaybe (maybeCompanyAddress . userAvsCardCard . entityVal) oldCards
+        let oldAddrs = Set.fromList $ mapMaybe (snd3 . getCompanyAddress . userAvsCardCard . entityVal) oldCards
         unless (maybe True (`Set.member` oldAddrs) mbCoFirmAddr) $ do  -- update postal address, unless the exact address had been seen before
           encRecipient :: CryptoUUIDUser <- encrypt uid
           $logInfoS "AVS" $ "Postal address updated for" <> tshow encRecipient
@@ -452,7 +449,7 @@ upsertAvsUserById api = do
             updateWhere [UserId ==. uid, UserPinPassword !=. userPin, UserPinPassword <-. Nothing:oldPins]
                         [UserPinPassword =. userPin]
             insert_ $ UserAvsCard api (getFullCardNo pCard) pCard now
-        upsertUserCompany uid mbCompany
+        upsertUserCompany uid mbCompany userFirmAddr
         forM_ avsPersonPersonCards $ \aCard -> void $ upsert UserAvsCard
             { userAvsCardPersonId  = api
             , userAvsCardCardNo    = getFullCardNo aCard
@@ -491,7 +488,7 @@ lookupAvsUsers apis = do
 -- | Like `Handler.Utils.getReceivers`, but calls upsertAvsUserById on each user to ensure that postal address is up-to-date
 updateReceivers :: UserId -> Handler  (Entity User, [Entity User], Bool)
 updateReceivers uid = do
-  (underling :: Entity User, avsUnderling :: Maybe (Entity UserAvs), avsSupers :: [(Entity UserSupervisor, Maybe (Entity UserAvs))]) <- runDB $ (,,)
+  (underling :: Entity User, avsUnderling :: Maybe (Entity UserAvs), avsSupers :: [(E.Value UserId, E.Value (Maybe AvsPersonId))]) <- runDB $ (,,)
     <$> getJustEntity uid
     <*> getBy (UniqueUserAvsUser uid)
     <*> (E.select $ do
@@ -501,11 +498,12 @@ updateReceivers uid = do
             `E.on` (\(usrSuper :& userAvs) -> usrSuper E.^. UserSupervisorSupervisor E.=?. userAvs E.?. UserAvsUser)
           E.where_ $ (usrSuper E.^. UserSupervisorUser E.==. E.val uid)
               E.&&.  (usrSuper E.^. UserSupervisorRerouteNotifications)
-          pure (usrSuper, usrAvs)
+          pure (usrSuper E.^. UserSupervisorSupervisor, usrAvs E.?. UserAvsPersonId)
         )
   let (superVs, avsIds) = unzip avsSupers
-      toUpdate = Set.fromList . fmap (userAvsPersonId . entityVal) $ catMaybes (avsUnderling : avsIds)
+      receiverIDs :: [UserId] = E.unValue <$> superVs
-      receiverIDs :: [UserId] = userSupervisorSupervisor . entityVal <$> superVs
+      underlingAvsId = userAvsPersonId . entityVal <$> avsUnderling
+      toUpdate = Set.fromList $ catMaybes (underlingAvsId : (E.unValue <$> avsIds))      
       directResult = return (underling, pure underling, True)
   forM_ toUpdate (void . maybeCatchAll . upsertAvsUserById)       -- attempt to update postaddress from AVS  
   if null receiverIDs 

src/Handler/Utils/Company.hs

@@ -15,9 +15,9 @@ import qualified Data.Text as Text
 import Database.Persist.Postgresql
 
 -- | Ensure that the given user is linked to the given company
-upsertUserCompany :: UserId -> Maybe Text -> DB ()
+upsertUserCompany :: UserId -> Maybe Text -> Maybe StoredMarkup -> DB ()
-upsertUserCompany uid (Just cName) | notNull cName = do 
+upsertUserCompany uid (Just cName) cAddr | notNull cName = do 
-  cid <- upsertCompany cName
+  cid <- upsertCompany cName cAddr
   void $ upsertBy (UniqueUserCompany uid cid) 
                   (UserCompany uid cid False False) 
                   []
@@ -25,12 +25,13 @@ upsertUserCompany uid (Just cName) | notNull cName = do
   upsertManyWhere [ UserSupervisor super uid reroute 
                   | Entity{entityVal=UserCompany{userCompanyUser=super, userCompanySupervisorReroute=reroute, userCompanySupervisor=True}} <- superVs
                   ] [] [] []
-upsertUserCompany uid _ = 
+upsertUserCompany uid _ _ = 
   deleteWhere [ UserCompanyUser ==. uid ]     -- maybe also delete company supervisors?
 
-
+-- | Does not update company address for now
-upsertCompany :: Text -> DB CompanyId
+-- TODO: update company address, maybe?!
-upsertCompany cName = 
+upsertCompany :: Text -> Maybe StoredMarkup -> DB CompanyId
+upsertCompany cName cAddr = 
   let cName' = CI.mk cName in
   getBy (UniqueCompanyName cName') >>= \case 
     Just ent -> return $ entityKey ent
@@ -39,7 +40,7 @@ upsertCompany cName =
       Nothing  -> do
         let cShort  = companyShorthandFromName cName            
         cShort' <- findShort cName' $ CI.mk cShort
-        let compy  = Company cName' cShort' 0 False Nothing -- TODO
+        let compy  = Company cName' cShort' 0 False cAddr -- TODO: Fix this once AVS CR3 SCF-165 is implemented
         either entityKey id <$> insertBy compy
   where 
     findShort :: CompanyName -> CompanyShorthand -> DB CompanyShorthand    

src/Handler/Utils/Mail.hs

@@ -16,6 +16,7 @@ import Handler.Utils.Pandoc
 import Handler.Utils.Files
 import Handler.Utils.Widgets (nameHtml') -- TODO: how to use name widget here?
 import Handler.Utils.Users (getReceivers)
+import Handler.Utils.Profile (pickValidEmail)
 
 import qualified Data.CaseInsensitive as CI
 
@@ -34,8 +35,8 @@ addRecipientsDB :: ( MonadMail m
 -- ^ @setRecipientId uid@ throws an exception if @uid@ does not refer to an existing user
 addRecipientsDB uFilter = runConduit $ transPipe (liftHandler . runDB) (selectSource uFilter [Asc UserDisplayName]) .| C.mapM_ addRecipient
   where
-    addRecipient (Entity _ User{userEmail, userDisplayName}) = do
+    addRecipient (Entity _ User{userEmail, userDisplayEmail, userDisplayName}) = do
-      let addr = Address (Just userDisplayName) $ CI.original userEmail
+      let addr = Address (Just userDisplayName) $ CI.original $ pickValidEmail userDisplayEmail userEmail
       _mailTo %= flip snoc addr
 
 userAddressFrom :: User -> Address
@@ -47,9 +48,9 @@ userAddressFrom User{userDisplayEmail, userDisplayName} = Address (Just userDisp
 userAddress :: User -> Address
 -- ^ Format an e-mail address suitable for usage as a recipient
 --
--- Uses `userEmail`
+-- Like userAddressFrom and no longer uses `userEmail`, since unlike Uni2work, userEmail from LDAP is untrustworthy.
-userAddress User{userEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userEmail
+userAddress User{userEmail, userDisplayEmail, userDisplayName}
-
+  = Address (Just userDisplayName) $ CI.original $ pickValidEmail userDisplayEmail userEmail
 
 -- | Send an email to the given UserId or to all registered Supervisor with rerouteNotifications == True
 userMailT :: ( MonadHandler m
@@ -60,7 +61,7 @@ userMailT :: ( MonadHandler m
 userMailT uid mAct = do
   (underling, receivers, undercopy) <- liftHandler . runDB $ getReceivers uid
   let undername = underling ^. _userDisplayName -- nameHtml' underling
-      undermail = CI.original $ underling ^. _userEmail
+      undermail = CI.original $ pickValidEmail (underling ^. _userDisplayEmail) (underling ^. _userEmail)
       infoSupervised :: Hamlet.HtmlUrlI18n UniWorXSendMessage (Route UniWorX) = [ihamlet|            
             <h2>_{MsgMailSupervisedNote}
             <p>

src/Handler/Utils/Profile.hs

@@ -9,7 +9,7 @@ module Handler.Utils.Profile
   , validDisplayName
   , fixDisplayName
   , validPostAddress  
-  , validEmail, validEmail'
+  , validEmail, validEmail', pickValidEmail
   ) where
 
 import Import.NoFoundation
@@ -84,3 +84,9 @@ validEmail = Email.isValid . encodeUtf8
 
 validEmail' :: UserEmail -> Bool -- UserEmail = CI Text
 validEmail' = Email.isValid . encodeUtf8 . CI.original
+
+-- | returns first argument, if it is a valid email address; returns second argument untested otherwise; convenience function
+pickValidEmail :: UserEmail -> UserEmail -> UserEmail
+pickValidEmail x y 
+  | validEmail' x = x 
+  | otherwise     = y

src/Handler/Utils/Table/Cells.hs

@@ -207,7 +207,7 @@ cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a
 cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
 
 cellHasEMail :: (IsDBTable m a, HasUser u) => u -> DBCell m a
-cellHasEMail = emailCell . view _userEmail
+cellHasEMail = emailCell . view _userDisplayEmail
 
 
 cellHasSemester :: (IsDBTable m c, HasStudyFeatures a) => a -> DBCell m c

src/Handler/Utils/Table/Columns.hs

@@ -398,7 +398,7 @@ fltrUserNameEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool
 fltrUserNameEmail queryUser = ( "user-name-email", FilterColumn $ anyFilter
     [ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName)
     , mkContainsFilter $ queryUser >>> (E.^. UserSurname)
-    , mkContainsFilterWith CI.mk $ queryUser >>> (E.^. UserEmail)
+    , mkContainsFilterWith CI.mk $ queryUser >>> (E.^. UserDisplayEmail)
     ]
   )
 
@@ -463,14 +463,14 @@ colUserEmail ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
 colUserEmail = sortable (Just "user-email") (i18nCell MsgTableEmail) cellHasEMail
 
 sortUserEmail :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t r')
-sortUserEmail queryUser = ( "user-email", SortColumn $ queryUser >>> (E.^. UserEmail))
+sortUserEmail queryUser = ( "user-email", SortColumn $ queryUser >>> (E.^. UserDisplayEmail))
 
 fltrUserEmail :: ( IsFilterColumn t (a -> Set (CI Text) -> E.SqlExpr (E.Value Bool))
                  , IsString d
                  )
               => (a -> E.SqlExpr (Entity User))
               -> (d, FilterColumn t fs)
-fltrUserEmail queryUser = ("user-email", FilterColumn . mkContainsFilter $ queryUser >>> (E.^. UserEmail))
+fltrUserEmail queryUser = ("user-email", FilterColumn . mkContainsFilter $ queryUser >>> (E.^. UserDisplayEmail))
 
 fltrUserEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
 fltrUserEmailUI mPrev =

src/Handler/Utils/Widgets.hs

@@ -64,6 +64,9 @@ linkUserWidget lnk (Entity uid usr) = do
   uuid <- encrypt uid
   simpleLink (userWidget usr) (lnk uuid)
 
+userEmailWidget :: HasUser c => c -> Widget
+userEmailWidget x = nameEmailWidget (x ^. _userDisplayEmail) (x ^. _userDisplayName) (x ^. _userSurname)
+
 -- | toWidget-Version of @nameEmailHtml@, for convenience
 nameEmailWidget :: UserEmail -- ^ userEmail
                 -> Text    -- ^ userDisplayName

src/Utils/Avs.hs

@@ -101,30 +101,23 @@ getValidLicence cutoff licence' cards = Set.lookupMax validLicenceCards
       avsDataValid && (avsDataValidTo >= cutoff) && (licence `Set.member` avsDataCardAreas)
 
 
-getCompanyAddress :: AvsDataPersonCard -> Maybe (Maybe Text, Text, AvsDataPersonCard)
+getCompanyAddress :: AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard)
 getCompanyAddress card@AvsDataPersonCard{..} 
   | Just street <- avsDataStreet
   , Just pcode  <- avsDataPostalCode
   , Just city   <- avsDataCity
-    = Just (avsDataFirm, Text.unlines [street, Text.unwords [pcode, city]], card)
+    = (avsDataFirm, Just $ Text.unlines $ mcons avsDataFirm [street, Text.unwords [pcode, city]], Just card)
-  | otherwise = Nothing
+  | isJust avsDataFirm = (avsDataFirm, Nothing, Just card)
+  | otherwise = (Nothing, Nothing, Nothing)
 
 -- | From a set of card, choose the one with the most complete postal address.
 --   Returns company, postal address and the associated card where the address was taken from
-guessLicenceAddress :: Set AvsDataPersonCard -> Maybe (Maybe Text, Text, AvsDataPersonCard)
+guessLicenceAddress :: Set AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard)
 guessLicenceAddress cards
   | Just c <- Set.lookupMax cards
   , card <- Set.foldr pickLicenceAddress c cards
     = getCompanyAddress card
-  | otherwise = Nothing
+  | otherwise = (Nothing, Nothing, Nothing)
-
--- | Helper for guessLicenceAddress or getCompanyAddress
-mergeCompanyAddress :: (Maybe Text, Text, a) -> Text
-mergeCompanyAddress (Nothing  , addr, _) = addr
-mergeCompanyAddress (Just firm, addr, _) = firm <> Text.cons '\n' addr
-
-maybeCompanyAddress :: AvsDataPersonCard -> Maybe Text
-maybeCompanyAddress = fmap mergeCompanyAddress . getCompanyAddress
 
 hasAddress :: AvsDataPersonCard -> Bool
 hasAddress AvsDataPersonCard{..} = isJust avsDataStreet && isJust avsDataCity && isJust avsDataPostalCode

templates/correction-user.hamlet

@@ -9,10 +9,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
     <tr .table__row>
       <th .table__th>_{MsgTableSubmission}
       <td .table__td>#{cid}
-    $maybe Entity _ User{userDisplayName, userSurname, userEmail} <- corrector
+    $maybe Entity _ usr <- corrector
       <tr .table__row>
         <th .table__th>_{MsgRatingBy}
-        <td .table__td>^{nameEmailWidget userEmail userDisplayName userSurname}
+        <td .table__td>^{userEmailWidget usr}
     $maybe time <- submissionRatingTime
       <tr .table__row>
         <th .table__th>_{MsgTableRatingTime}

templates/course/lecturerMassInput/cellKnown.hamlet

@@ -6,6 +6,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 <td colspan=2>
   #{csrf}
-  ^{nameEmailWidget userEmail userDisplayName userSurname} #
+  ^{userEmailWidget usr} #
 <td>
   ^{fvWidget lrwView}

templates/course/user/profile.hamlet

@@ -24,7 +24,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
         <dt .deflist__dt>_{MsgTableSex}
         <dd .deflist__dd>_{sex}
       <dt .deflist__dt>_{MsgTableEmail}
-      <dd .deflist__dd>#{mailtoHtml userEmail}
+      <dd .deflist__dd>#{mailtoHtml (pickValidEmail userDisplayEmail userEmail)}
       $maybe date <- mRegAt
         <dt .deflist__dt>_{MsgRegisteredSince}
         <dd .deflist__dd>#{date}

templates/external-exam-show.hamlet

@@ -52,9 +52,9 @@ $maybe ExternalExamResult{externalExamResultResult} <- mResult
         <ul>
           $forall s <- staff
             $case s
-              $of Right (Entity _ User{userDisplayName, userDisplayEmail, userSurname})
+              $of Right (Entity _ usr)
                 <li>
-                  ^{nameEmailWidget userDisplayEmail userDisplayName userSurname}
+                  ^{userEmailWidget usr}
               $of Left email
                 <li .email>
                   #{email}

templates/external-exam/staffMassInput/cellKnown.hamlet

@@ -5,4 +5,4 @@ $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 <td colspan=2>
-  ^{nameEmailWidget userEmail userDisplayName userSurname}
+  ^{userEmailWidget usr}

templates/i18n/data-delete/de-de-formal.hamlet

@@ -6,7 +6,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 <h2>
   Sind Sie sich absolut sicher
-  Benutzer:in ^{nameEmailWidget userEmail userDisplayName userSurname} zu löschen?
+  Benutzer:in ^{userEmailWidget user} zu löschen?
 <p>
     Während der Testphase von Uni2work
     werden Benutzer:innen hiermit vollständig aus der Live-Datenbank mit

templates/i18n/data-delete/en-eu.hamlet

@@ -5,7 +5,7 @@ $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 <h2>
-  Are you sure that you want to permanently delete ^{nameEmailWidget userEmail userDisplayName userSurname}?
+  Are you sure that you want to permanently delete ^{userEmailWidget user}?
 <p>
   During the testing phase users are deleted wholly from the live database via
   <code>DELETE CASCADE uid

templates/profileData.hamlet

@@ -54,14 +54,14 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
           <dd .deflist__dd>
             ^{formatTimeW SelFormatDateTime postUpdate}      
       <dt .deflist__dt>
-        _{MsgTableEmail}
+        _{MsgUserDisplayEmail}
-      <dd .deflist__dd>
+      <dd .deflist__dd .email>
-        #{mailtoHtml userEmail}
+        #{userDisplayEmail}
       $if userEmail /= userDisplayEmail
         <dt .deflist__dt>
-          _{MsgUserDisplayEmail}
+          _{MsgUserSystemEmail}
-        <dd .deflist__dd .email>
+        <dd .deflist__dd>
-          #{userDisplayEmail}
+          #{mailtoHtml userEmail}
       <dt .deflist__dt>
         _{MsgAdminUserPinPassword}
       <dd .deflist__dd>

templates/tutorial-participants.hamlet

@@ -12,7 +12,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
     <dt .deflist__dt>_{MsgTableTutorialTutors}
     <dd .deflist__dd>
       <ul>
-        $forall (Entity _ User{userDisplayName, userDisplayEmail, userSurname}) <- tutors
+        $forall (Entity _ usr) <- tutors
           <li>
-            ^{nameEmailWidget userDisplayEmail userDisplayName userSurname}
+            ^{userEmailWidget usr}
 ^{participantTable}

templates/tutorial/tutorMassInput/cellKnown.hamlet

@@ -5,4 +5,4 @@ $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 <td colspan=2>
-  ^{nameEmailWidget userEmail userDisplayName userSurname}
+  ^{userEmailWidget usr}

templates/widgets/massinput/examCorrectors/cellKnown.hamlet

@@ -5,4 +5,4 @@ $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 <td colspan=2>
-  ^{nameEmailWidget userEmail userDisplayName userSurname}
+  ^{userEmailWidget usr}

templates/widgets/massinput/examOfficeUsers/cellKnown.hamlet

@@ -5,4 +5,4 @@ $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 <td colspan=2>
-  ^{nameEmailWidget userEmail userDisplayName userSurname}
+  ^{userEmailWidget usr}

templates/widgets/massinput/submissionUsers/cellKnown.hamlet

@@ -7,10 +7,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 $maybe wrn <- knownWarning
  <td>
    #{csrf}
-   ^{nameEmailWidget userEmail userDisplayName userSurname}
+   ^{userEmailWidget usr}
  <td .table__td--tooltip>
    ^{messageTooltip wrn}
 $nothing
   <td colspan=2>
     #{csrf}
-    ^{nameEmailWidget userEmail userDisplayName userSurname}
+    ^{userEmailWidget usr}