fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into fradrive/tutorial-overhaul

Browse Source
This commit is contained in:
Steffen Jost 2023-02-14 13:23:00 +01:00
commit 8c7158eac9
46 changed files with 139 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
messages/uniworx/categories/jobs_handler/de-de-formal.msg
View File

@ -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
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!
MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte 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 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 verwenden
CommCourseSubject: Kursmitteilung
InvitationAcceptDecline: Einladung annehmen/ablehnen
InvitationFromTip displayName@Text: Sie erhalten diese Einladung, weil #{displayName} ihren Versand in FRADrive ausgelöst hat.

6
messages/uniworx/categories/jobs_handler/en-eu.msg
View File

@ -12,9 +12,9 @@ CommUndisclosedRecipients: Undisclosed recipients
CommAllRecipients: all-recipients
CommAllRecipientsSheet: Recipients
ResetPassword: Reselt FRADrive password
MailSubjectChangeUserDisplayEmail: Publishing this 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!
MailTitleChangeUserDisplayEmail displayName: #{displayName} wants to publish this email address as their own in FRADrive
MailSubjectChangeUserDisplayEmail: Set email address in FRADrive
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 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.

9
messages/uniworx/categories/settings/de-de-formal.msg
View File

@ -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
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.
UserDisplayEmailChangeSent displayEmail@UserEmail: Anweisungen zum Ändern der angezeigten E-Mail-Adresse wurden an „#{displayEmail}” versandt
UserSystemEmail: System E-Mail Adresse
UserDisplayEmail: E-Mail-Adresse
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

7
messages/uniworx/categories/settings/en-eu.msg
View File

@ -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
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".
UserSystemEmail: System Email address
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

4
messages/uniworx/categories/user/de-de-formal.msg
View File

@ -6,8 +6,8 @@ AdminUserTitle: Titel
AdminUserFirstName: Vorname
AdminUserSurname: Nachname
AdminUserDisplayName: Anzeige-Name
AdminUserEmail: E-Mail-Adresse
AdminUserDisplayEmail: Anzeige-E-Mail
AdminUserEmail: System 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.

4
messages/uniworx/categories/user/en-eu.msg
View File

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

2
messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg
View File

@ -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

2
messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg
View File

@ -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

1
models/avs.model
View File

@ -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

4
models/users.model
View File

@ -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?
supervisorReroute Bool default=true -- if supervisor is true, should this supervisor receive email for _new_ company users?
supervisor Bool default=false -- should this user be made supervisor for all _new_ users associated with this company?
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

2
src/Foundation/Instances.hs
View File

@ -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

2
src/Handler/Course/Edit.hs
View File

@ -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

2
src/Handler/Course/Show.hs
View File

@ -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>

23
src/Handler/Course/User.hs
View File

@ -11,27 +11,24 @@ import Import
import Utils.Form
import Handler.Utils
import Handler.Utils.SheetType
import Database.Esqueleto.Utils.TH
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import Database.Persist.Sql (deleteWhereCount)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Handler.Utils.Profile (pickValidEmail)
import Handler.Utils.StudyFeatures
import Handler.Submission.List
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)

2
src/Handler/Exam/Form.hs
View File

@ -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) ()

2
src/Handler/ExamOffice/Users.hs
View File

@ -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

2
src/Handler/ExternalExam/Form.hs
View File

@ -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 :#:)

2
src/Handler/LMS.hs
View File

@ -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)

2
src/Handler/PrintCenter.hs
View File

@ -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

2
src/Handler/Qualification.hs
View File

@ -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)

4
src/Handler/Sheet/Form.hs
View File

@ -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
return $ nameEmailWidget userEmail userDisplayName userSurname
usr <- liftHandler . runDB $ getJust uid
return $ userEmailWidget usr
invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
return (res, $(widgetFile "sheetCorrectors/cell"))

6
src/Handler/Submission/Assign.hs
View File

@ -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
= (nameEmailWidget userEmail userDisplayName userSurname, loadMap, userDisplayName)
-- | Just (User{..} ) <- Map.lookup uid lecturerNames
-- = (nameEmailWidget userEmail userDisplayName userSurname, mempty) -- lecturers may also correct in rare cases
| Just (usr,loadMap) <- Map.lookup uid correctorMap
= (userEmailWidget usr, loadMap, usr ^. _userDisplayName)
getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty, mempty)
-- avoid nestes hamlet $maybe with duplicated $nothing
getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo

2
src/Handler/Submission/Helper.hs
View File

@ -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

2
src/Handler/Tutorial/Form.hs
View File

@ -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) ()

6
src/Handler/Users.hs
View File

@ -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

58
src/Handler/Utils/Avs.hs
View File

@ -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
mbCompany = firmAddress ^? _Just . _1 . _Just
userFirmAddr= plaintextToStoredMarkup . mergeCompanyAddress <$> firmAddress
let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards
userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr
pinCard = Set.lookupMax avsPersonPersonCards
userPin = personCard2pin <$> pinCard
fakeIdent = CI.mk $ "AVSID:" <> tshow api
fakeNo = CI.mk $ "AVSNO:" <> tshow avsPersonPersonNo
newUsr = AddUserData
{ audTitle = Nothing
, audFirstName = avsFirstName
, audSurname = avsSurname
, audDisplayName = avsFirstName <> Text.cons ' ' avsSurname
, audDisplayEmail = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
, audMatriculation = Nothing
, audSex = Nothing
, audBirthday = Nothing
, audMobile = Nothing
, audTelephone = Nothing
, audFPersonalNumber = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
, audFDepartment = Nothing
, audPostAddress = userFirmAddr
, audPrefersPostal = True
, audPinPassword = userPin
{ audTitle = Nothing
, audFirstName = avsFirstName
, audSurname = avsSurname
, audDisplayName = avsFirstName <> Text.cons ' ' avsSurname
, audDisplayEmail = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
, audMatriculation = Nothing
, audSex = Nothing
, audBirthday = Nothing
, audMobile = Nothing
, audTelephone = Nothing
, audFPersonalNumber = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
, audFDepartment = Nothing
, audPostAddress = userFirmAddr
, audPrefersPostal = True
, 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
mbCompany = firmAddress ^? _Just . _1 . _Just
mbCoFirmAddr= mergeCompanyAddress <$> firmAddress
let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards
userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr
pinCard = Set.lookupMax avsPersonPersonCards
userPin = personCard2pin <$> pinCard
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] = userSupervisorSupervisor . entityVal <$> superVs
receiverIDs :: [UserId] = E.unValue <$> 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

17
src/Handler/Utils/Company.hs
View File

@ -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 uid (Just cName) | notNull cName = do
cid <- upsertCompany cName
upsertUserCompany :: UserId -> Maybe Text -> Maybe StoredMarkup -> DB ()
upsertUserCompany uid (Just cName) cAddr | notNull cName = do
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?
upsertCompany :: Text -> DB CompanyId
upsertCompany cName =
-- | Does not update company address for now
-- TODO: update company address, maybe?!
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

13
src/Handler/Utils/Mail.hs
View File

@ -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
let addr = Address (Just userDisplayName) $ CI.original userEmail
addRecipient (Entity _ User{userEmail, userDisplayEmail, userDisplayName}) = do
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`
userAddress User{userEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userEmail
-- Like userAddressFrom and no longer uses `userEmail`, since unlike Uni2work, userEmail from LDAP is untrustworthy.
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>

10
src/Handler/Utils/Profile.hs
View File

@ -9,7 +9,7 @@ module Handler.Utils.Profile
, validDisplayName
, fixDisplayName
, validPostAddress
, validEmail, validEmail'
, validEmail, validEmail', pickValidEmail
) where
import Import.NoFoundation
@ -83,4 +83,10 @@ validEmail :: Email -> Bool -- Email = Text
validEmail = Email.isValid . encodeUtf8
validEmail' :: UserEmail -> Bool -- UserEmail = CI Text
validEmail' = Email.isValid . encodeUtf8 . CI.original
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

2
src/Handler/Utils/Table/Cells.hs
View File

@ -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

6
src/Handler/Utils/Table/Columns.hs
View File

@ -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 =

3
src/Handler/Utils/Widgets.hs
View File

@ -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

19
src/Utils/Avs.hs
View File

@ -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)
| otherwise = Nothing
= (avsDataFirm, Just $ Text.unlines $ mcons avsDataFirm [street, Text.unwords [pcode, city]], Just card)
| 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
-- | 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
| otherwise = (Nothing, Nothing, Nothing)
hasAddress :: AvsDataPersonCard -> Bool
hasAddress AvsDataPersonCard{..} = isJust avsDataStreet && isJust avsDataCity && isJust avsDataPostalCode

4
templates/correction-user.hamlet
View File

@ -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}

2
templates/course/lecturerMassInput/cellKnown.hamlet
View File

@ -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}

2
templates/course/user/profile.hamlet
View File

@ -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}

4
templates/external-exam-show.hamlet
View File

@ -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}

2
templates/external-exam/staffMassInput/cellKnown.hamlet
View File

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

2
templates/i18n/data-delete/de-de-formal.hamlet
View File

@ -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

2
templates/i18n/data-delete/en-eu.hamlet
View File

@ -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

12
templates/profileData.hamlet
View File

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

4
templates/tutorial-participants.hamlet
View File

@ -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}

2
templates/tutorial/tutorMassInput/cellKnown.hamlet
View File

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

2
templates/widgets/massinput/examCorrectors/cellKnown.hamlet
View File

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

2
templates/widgets/massinput/examOfficeUsers/cellKnown.hamlet
View File

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

4
templates/widgets/massinput/submissionUsers/cellKnown.hamlet
View File

@ -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}