diff --git a/CHANGELOG.md b/CHANGELOG.md index 0aa7f5698..32a41f43b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [27.0.19](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.0.18...v27.0.19) (2023-01-27) + ## [27.0.18](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.0.17...v27.0.18) (2023-01-25) ## [27.0.17](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.0.16...v27.0.17) (2023-01-22) diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg index e1c14dd4f..7a63ec25d 100644 --- a/messages/uniworx/categories/avs/de-de-formal.msg +++ b/messages/uniworx/categories/avs/de-de-formal.msg @@ -28,4 +28,4 @@ RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler. LicenceTableChangeAvs: Im AVS ändern LicenceTableGrantFDrive: In FRADrive erteilen -LicenceTableRevokeFDrive: In FRADrive entziehen \ No newline at end of file +LicenceTableRevokeFDrive: In FRADrive zum Vortag entziehen \ No newline at end of file diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg index 7499244f6..91efb95f9 100644 --- a/messages/uniworx/categories/avs/en-eu.msg +++ b/messages/uniworx/categories/avs/en-eu.msg @@ -28,4 +28,4 @@ RevokeUnknownLicencesFail: Not all AVS driving licences of unknown drivers could AvsCommunicationError: AVS interface returned an unexpected error. LicenceTableChangeAvs: Change in AVS LicenceTableGrantFDrive: Grant in FRADrive -LicenceTableRevokeFDrive: Revoke in FRADrive +LicenceTableRevokeFDrive: Revoke yesterday in FRADrive diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index d18a54779..6d349743c 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -83,7 +83,7 @@ CourseParticipantsRegisterHeading: Kursteilnehmer:innen hinzufügen CourseParticipantsRegisterActionAddParticipants: Personen zum Kurs anmelden CourseParticipantsRegisterActionAddTutorialMembers: Personen zu Kurs und Übungsgruppe anmelden CourseParticipantsRegisterUsersField: Zum Kurs anzumeldende Personen -CourseParticipantsRegisterUsersFieldTip: Bitte Ausweiskartennummer inklusive Punkt, Fraport Personalnummer oder Email angeben. Mehrere Personen bitte mit Komma getrennt angeben. +CourseParticipantsRegisterUsersFieldTip: Bitte Ausweiskartennummer inklusive Punkt, Fraport Personalnummer oder Email angeben. Mehrere Personen bitte mit Komma oder Leerzeichen trennen. CourseParticipantsRegisterTutorialOption: Kursteilnehmer:innen zu Übungsgruppe anmelden? CourseParticipantsRegisterTutorialField: Übungsgruppe CourseParticipantsRegisterTutorialFieldTip: Ist aktuell keine Übungsgruppe mit diesem Namen vorhanden, wird eine neue erstellt. Ist bereits eine Übungsgruppe mit diesem Namen vorhanden, werden die Kursteilnehmenden dieser hinzugefügt. diff --git a/messages/uniworx/categories/courses/courses/en-eu.msg b/messages/uniworx/categories/courses/courses/en-eu.msg index 2bde12186..b2d0a823d 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/en-eu.msg @@ -83,7 +83,7 @@ CourseParticipantsRegisterHeading: Add course participants CourseParticipantsRegisterActionAddParticipants: Add course participants CourseParticipantsRegisterActionAddTutorialMembers: Add course and tutorial participants CourseParticipantsRegisterUsersField: Persons to register for course -CourseParticipantsRegisterUsersFieldTip: Please enter id card no (including dot), Fraport personnel number or email. Please separate multiple entries with commas. +CourseParticipantsRegisterUsersFieldTip: Please enter id card no (including dot), Fraport personnel number or email. Please separate multiple entries with comma or space. CourseParticipantsRegisterTutorialOption: Register course participants for tutorial? CourseParticipantsRegisterTutorialField: Tutorial CourseParticipantsRegisterTutorialFieldTip: If there is no tutorial with this name, a new one will be created. If there is a tutorial with this name, the course participants will be registered for it. diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index a9ce21d18..a8315ef26 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -21,9 +21,10 @@ LmsQualificationValidUntil: Gültig bis TableQualificationLastRefresh: Zuletzt erneuert TableQualificationFirstHeld: Erstmalig TableQualificationBlockedDue: Suspendiert -TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und wer hat das veranlasst? +TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst? TableQualificationNoRenewal: Storniert -TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versand, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein. +TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein. +QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus LmsUser: Inhaber TableLmsEmail: E-Mail TableLmsIdent: LMS Identifikation @@ -36,6 +37,7 @@ TableLmsStaff: Interner Mitarbeiter? TableLmsStarted: Begonnen TableLmsReceived: Letzte Rückmeldung TableLmsNotified: Versand Benachrichtigung +TableLmsNotifiedTooltip: Benachrichtigungen werden erst versendet wenn das LMS bestätigt die Eröffnung des E-Learning für den Benutzer bestätigt hat, was ein paar Stunden dauern kann! TableLmsEnded: Beended TableLmsStatus: Status E-Learning TableLmsSuccess: Bestanden @@ -61,10 +63,10 @@ LmsErrorNoRefreshElearning: Fehler: E-Learning wird nicht automatisch gestartet, MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig -MailBodyQualificationRenewal qname@Text: Sie müssen Qualifikation #{qname} demnächst durch einen E-Learning Kurs erneuern, siehe Anhang. +MailBodyQualificationRenewal qname@Text: Sie müssen die Qualifikation #{qname} demnächst durch einen E-Learning Kurs erneuern, siehe Anhang. MailBodyQualificationExpiry: Diese Qualifikation läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden! MailBodyQualificationExpired: Diese Qualifikation is nun abgelaufen. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen ab sofort nicht länger ausgeübt werden! Es ist möglich, dass die Qualifikation vorzeit ungültig wurde, z.B. wegen erfolgloser Teilnahme an einem verpflichtendem E-Learning. -LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PDF-Passwort verschlüsselt. Falls kein PDF-Passwort hinterlegt wurde, ist das PDF-Passwort Ihre Fraport Ausweisnummer, inklusive Punkt und der Ziffer danach. +LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PDF-Passwort verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort Ihre Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach. LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Learning verlängert werden. LmsActNotify: Benachrichtigung E-Learning erneut per Post oder E-Mail versenden LmsActRenewPin: Neue zufällige E-Learning PIN zuweisen @@ -86,4 +88,4 @@ MppBadLanguage: Sprache muss derzeit "de" oder "en" sein. LmsAutomaticQueuing n@Natural: Die folgenden Funktionen werden normalerweise einmal pro Tag um #{show n} Uhr ausgeführt. LmsManualQueuing: Die folgenden Funktionen sollten einmal pro Tag ausgeführt werden. BtnLmsEnqueue: Nutzer mit ablaufenden Qualifikationen zum E-Learning anmelden und benachrichtigen -BtnLmsDequeue: Nutzer mit beendetem E-Learning ggf. benachrichtigen und aufräumen \ No newline at end of file +BtnLmsDequeue: Nutzer mit beendetem E-Learning ggf. benachrichtigen und aufräumen diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index ef14f66c9..3eaae500d 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -21,9 +21,10 @@ LmsQualificationValidUntil: Valid until TableQualificationLastRefresh: Last renewed TableQualificationFirstHeld: First held TableQualificationBlockedDue: Suspended -TableQualificationBlockedTooltip: When was the qualification temporarily suspended and who requested this? +TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended? TableQualificationNoRenewal: Canceled TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid. +QualificationUserNoRenewal: Expires without further notification LmsUser: Licensee TableLmsEmail: Email TableLmsIdent: LMS Identifier @@ -36,6 +37,7 @@ TableLmsStaff: Staff? TableLmsStarted: Started TableLmsReceived: Last update TableLmsNotified: Notification sent +TableLmsNotifiedTooltip: Notfications are not sent before the LMS acknowledges the opening of the e-learning course for the user, which may take several hours! TableLmsEnded: Ended TableLmsStatus: Status e-learning TableLmsSuccess: Completed @@ -86,4 +88,4 @@ MppBadLanguage: Language currently restricted to "en" or "de". LmsAutomaticQueuing n@Natural: The following functions are executed daily at #{show n} o'clock. LmsManualQueuing: The following functions should be executed daily. BtnLmsEnqueue: Enqueue users with expiring qualifications for e-learning and notify them. -BtnLmsDequeue: Dequeue users with finished e-learning and notify, if appropriate. \ No newline at end of file +BtnLmsDequeue: Dequeue users with finished e-learning and notify, if appropriate. diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index ae5a5eff4..7e22bc31c 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -30,6 +30,7 @@ MenuLogout !ident-ok: Logout MenuCourseList: Kurse MenuCourseMembers: Kursteilnehmer:innen MenuCourseAddMembers: Kursteilnehmer:innen hinzufügen +MenuTutorialAddMembers: Tutorium Teilnehmer:innen hinzufügen MenuCourseCommunication: Kursmitteilung (E-Mail) MenuCourseExamOffice: Prüfungsbeauftragte MenuTermShow: Semester diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 938038732..b517d4136 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -29,7 +29,8 @@ MenuLogin: Login MenuLogout: Logout MenuCourseList: Courses MenuCourseMembers: Participants -MenuCourseAddMembers: Add participants +MenuCourseAddMembers: Add course participants +MenuTutorialAddMembers: Add tutorium participants MenuCourseCommunication: Course message (email) MenuCourseExamOffice: Exam offices MenuTermShow: Semesters diff --git a/models/users.model b/models/users.model index 40ae1bee2..77a330744 100644 --- a/models/users.model +++ b/models/users.model @@ -88,7 +88,8 @@ UserGroupMember UserCompany user UserId company CompanyId OnDeleteCascade OnUpdateCascade - supervisor Bool -- is this user a company supervisor? + 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? UniqueUserCompany user company -- a user may belong to multiple companies, but to each one only once deriving Generic UserSupervisor diff --git a/nix/docker/demo-version.json b/nix/docker/demo-version.json index 4df134a2d..e3f82320d 100644 --- a/nix/docker/demo-version.json +++ b/nix/docker/demo-version.json @@ -1,3 +1,3 @@ { - "version": "27.0.18" + "version": "27.0.19" } diff --git a/nix/docker/version.json b/nix/docker/version.json index 4df134a2d..e3f82320d 100644 --- a/nix/docker/version.json +++ b/nix/docker/version.json @@ -1,3 +1,3 @@ { - "version": "27.0.18" + "version": "27.0.19" } diff --git a/package-lock.json b/package-lock.json index bfc7bfd35..8f0e38252 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.0.18", + "version": "27.0.19", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 571b6f854..12c51d31d 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.0.18", + "version": "27.0.19", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 1aca0a7f1..2ce9b059e 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 27.0.18 +version: 27.0.19 dependencies: - base - yesod diff --git a/routes b/routes index 4b5251a75..be87d159d 100644 --- a/routes +++ b/routes @@ -209,6 +209,7 @@ /edit TEditR GET POST !tutorANDtutor-control /delete TDeleteR GET POST /participants TUsersR GET POST !tutor + /participants/add TAddUserR GET POST !tutor /register TRegisterR POST !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registered /communication TCommR GET POST !tutor /tutor-invite TInviteR GET POST !tutorANDtutor-control diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index d01835b7b..fcc6a1f8f 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -199,10 +199,11 @@ data Transaction } | TransactionQualificationUserEdit - { transactionQualificationUser :: QualificationUserId - , transactionQualification :: QualificationId - , transactionUser :: UserId - , transactionQualificationValidUntil :: Day + { transactionQualificationUser :: QualificationUserId + , transactionQualification :: QualificationId + , transactionUser :: UserId + , transactionQualificationValidUntil :: Day + , transactionQualificationScheduleRenewal :: Maybe Bool -- Maybe, because some update may leave it unchanged (also avoids DB Migration) } | TransactionQualificationUserDelete { transactionQualificationUser :: QualificationUserId diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 16f50b94d..1dd2c68e1 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -283,11 +283,12 @@ breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of TUsersR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR) - TEditR -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR - TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR - TCommR -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR - TRegisterR -> i18nCrumb MsgBreadcrumbTutorialRegister . Just $ CourseR tid ssh csh CShowR - TInviteR -> i18nCrumb MsgBreadcrumbTutorInvite . Just $ CTutorialR tid ssh csh tutn TUsersR + TAddUserR -> i18nCrumb MsgMenuTutorialAddMembers . Just $ CTutorialR tid ssh csh tutn TUsersR + TEditR -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR + TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR + TCommR -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR + TRegisterR -> i18nCrumb MsgBreadcrumbTutorialRegister . Just $ CourseR tid ssh csh CShowR + TInviteR -> i18nCrumb MsgBreadcrumbTutorInvite . Just $ CTutorialR tid ssh csh tutn TUsersR breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of SShowR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbSheet . Just $ CourseR tid ssh csh SheetListR) $ do @@ -1631,6 +1632,17 @@ pageActions (CTutorialR tid ssh csh tutn TUsersR) = do membersSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh CUsersR return [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuTutorialAddMembers + , navRoute = CTutorialR tid ssh csh tutn TAddUserR + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary { navLink = NavLink { navLabel = MsgMenuCourseMembers , navRoute = CourseR tid ssh csh CUsersR diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index c43da2b16..d231fd94d 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -182,7 +182,8 @@ upsertCampusUser upsertMode ldapData = do userDefaultConf <- getsYesod $ view _appUserDefaults (newUser,userUpdate) <- decodeUser now userDefaultConf upsertMode ldapData - + --TODO: newUser should be associated with a company and company supervisor through Handler.Utils.Company.upsertUserCompany, but this is called by upsertAvsUser already - conflict? + oldUsers <- for (userLdapPrimaryKey newUser) $ \pKey -> selectKeysList [ UserLdapPrimaryKey ==. Just pKey ] [] user@(Entity userId userRec) <- case oldUsers of diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index e9bbde606..a0895774f 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -146,6 +146,7 @@ retrieveUnreachableUsers :: E.SqlQuery (E.SqlExpr (Entity User)) retrieveUnreachableUsers = do user <- E.from $ E.table @User E.where_ $ E.isNothing (user E.^. UserPostAddress) + E.&&. E.isNothing (user E.^. UserCompanyDepartment) E.&&. E.not_ ((user E.^. UserEmail) `E.like` E.val "%@%.%") return user @@ -225,4 +226,4 @@ retrieveDriversRWithoutF nowaday = do {- getAdjustLicences :: SchoolId -> QualificationShortand -> Handler Html --} \ No newline at end of file +-} diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 8c0f53cd9..3ab112505 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -333,8 +333,9 @@ embedRenderMessage ''UniWorX ''LicenceTableAction id data LicenceTableActionData = LicenceTableChangeAvsData | LicenceTableRevokeFDriveData --TODO: add { licenceTableChangeFDriveQId :: QualificationId to avoid lookup later - | LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId - , licenceTableChangeFDriveEnd :: Day + | LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId + , licenceTableChangeFDriveEnd :: Day + , licenceTableChangeFDriveRenew :: Maybe Bool } deriving (Eq, Ord, Read, Show, Generic) @@ -423,7 +424,7 @@ getProblemAvsSynchR = do nups <- runDB $ do qId <- getKeyBy404 $ UniqueQualificationAvsLicence $ Just alic selectedUsers <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] [] - forM_ selectedUsers $ upsertQualificationUser qId nowaday $ pred nowaday + forM_ selectedUsers $ upsertQualificationUser qId nowaday (pred nowaday) Nothing return $ length selectedUsers addMessageI Success $ MsgRevokeFraDriveLicences alic nups redirect ProblemAvsSynchR -- must be outside runDB @@ -433,7 +434,7 @@ getProblemAvsSynchR = do uas <- selectList [UserAvsPersonId <-. Set.toList apids] [] let uids = view _userAvsUser <$> uas -- addMessage Info $ text2Html $ "UIDs: " <> tshow uids -- DEBUG - forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd + forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd licenceTableChangeFDriveRenew (length uids,) <$> get404 licenceTableChangeFDriveQId addMessageI Success $ MsgSetFraDriveLicences (citext2string qualificationShorthand) n redirect ProblemAvsSynchR -- must be outside runDB @@ -577,6 +578,7 @@ mkLicenceTable PaginationParameters{..} dbtIdent aLic apids = do else singletonMap LicenceTableGrantFDrive $ LicenceTableGrantFDriveData <$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid <*> apreq dayField (fslI MsgLmsQualificationValidUntil) Nothing -- apreq?! + <*> aopt (convertField not not (boolField . Just $ SomeMessage MsgBoolIrrelevant)) (fslI MsgQualificationUserNoRenewal) Nothing ] dbtParams = DBParamsForm { dbParamsFormMethod = POST diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index 0e079ec23..e129b9d53 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -4,6 +4,7 @@ module Handler.Course.ParticipantInvite ( getCAddUserR, postCAddUserR + , getTAddUserR, postTAddUserR ) where import Import @@ -116,9 +117,16 @@ instance Monoid AddParticipantsResult where mappend = (<>) -getCAddUserR, postCAddUserR :: TermId -> SchoolId -> CourseShorthand -> Handler Html +getCAddUserR, postCAddUserR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCAddUserR = postCAddUserR -postCAddUserR tid ssh csh = do +postCAddUserR tid ssh csh = do + today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime + postTAddUserR tid ssh csh (CI.mk $ tshow today) -- Don't use user date display setting, so that tutorial default names conform to all users + + +getTAddUserR, postTAddUserR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html +getTAddUserR = postTAddUserR +postTAddUserR tid ssh csh tut = do cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute @@ -141,11 +149,10 @@ postCAddUserR tid ssh csh = do | otherwise -> redirect $ CourseR tid ssh csh CUsersR - ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do - today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime - auReqUsers <- wreq (textField & cfCommaSeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty + ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do + auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty auReqTutorial <- optionalActionW - ( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just . CI.mk $ tshow today) ) -- TODO: use user date display setting + ( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just tut) ) ( fslI MsgCourseParticipantsRegisterTutorialOption ) ( Just True ) return $ AddUserRequest <$> auReqUsers <*> auReqTutorial diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index f4ad4555f..d2eafeecd 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -534,7 +534,7 @@ postLmsLSR sid qsh nlimit noffset , sortable (Just "lms-datepin") (i18nLms MsgTableLmsDatePin) $ \(preview $ resultLmsUser . _entityVal . _lmsUserDatePin -> d) -> foldMap dateTimeCell d , sortable (Just "lms-received") (i18nLms MsgTableLmsReceived) $ \(preview $ resultLmsUser . _entityVal . _lmsUserReceived -> d) -> foldMap dateTimeCell $ join d --, sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \(preview $ resultLmsUser . _entityVal . _lmsUserNotified -> d) -> foldMap dateTimeCell $ join d - , sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \row -> + , sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified & cellTooltip MsgTableLmsNotifiedTooltip) $ \row -> -- 4 Cases: -- - No notification: LmsUserNotified == Nothing -- - Email sent : LmsUserNotified == Just _ && PrintJobId == Nothing diff --git a/src/Handler/SAP.hs b/src/Handler/SAP.hs index cf83e6c22..7fd0bd7b0 100644 --- a/src/Handler/SAP.hs +++ b/src/Handler/SAP.hs @@ -53,10 +53,11 @@ instance ToNamedRecord SapUserTableCsv where , "Ausprägung" Csv..= csvSUTausprägung ] --- | Removes all elements containing Nothing, which should not be returend by the query anyway (only qualfications with sap id and users with internal personnel number must be transmitted) +-- | Removes all personalNummer which are not numbers (i.e. excludes E-Accounts), which should not be returned by the query anyway (only qualfications with sap id and users with internal personnel number must be transmitted) -- TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv] sapRes2csv l = [ res | (Ex.Value (Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l + , readMay persNo > Just (0::Int) -- filter E-accounts for SAP export , let res = SapUserTableCsv { csvSUTpersonalNummer = persNo , csvSUTqualifikation = sapId @@ -101,4 +102,4 @@ getQualificationSAPDirectR = do csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered -- direct Download see: --- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod \ No newline at end of file +-- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 325a075a1..912d0c886 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -100,7 +100,7 @@ postTUsersR tid ssh csh tutn = do (TutorialUserGrantQualificationData{..}, selectedUsers) -> do -- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime today <- utctDay <$> liftIO getCurrentTime - runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil + runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers redirect $ CTutorialR tid ssh csh tutn TUsersR (TutorialUserSendMailData{}, selectedUsers) -> do diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index fa83c8ce6..1ee201656 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -188,10 +188,10 @@ postUsersR = do acts = mconcat [ singletonMap UserLdapSync $ pure UserLdapSyncData , singletonMap UserAddSupervisor $ UserAddSupervisorData - <$> apopt (textField & cfCommaSeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing + <$> apopt (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True) , singletonMap UserSetSupervisor $ UserSetSupervisorData - <$> apopt (textField & cfCommaSeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing + <$> apopt (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True) , singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData ] diff --git a/src/Handler/Utils/Company.hs b/src/Handler/Utils/Company.hs index 837bb5181..74990a803 100644 --- a/src/Handler/Utils/Company.hs +++ b/src/Handler/Utils/Company.hs @@ -12,15 +12,22 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Char as Char 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 void $ upsertBy (UniqueUserCompany uid cid) - (UserCompany uid cid False) - [] -upsertUserCompany uid _ = deleteWhere [ UserCompanyUser ==. uid ] + (UserCompany uid cid False False) + [] + superVs <- selectList [UserCompanyCompany ==. cid, UserCompanySupervisor ==. True] [] + upsertManyWhere [ UserSupervisor super uid reroute + | Entity{entityVal=UserCompany{userCompanyUser=super, userCompanySupervisorReroute=reroute, userCompanySupervisor=True}} <- superVs + ] [] [] [] +upsertUserCompany uid _ = + deleteWhere [ UserCompanyUser ==. uid ] -- maybe also delete company supervisors? + upsertCompany :: Text -> DB CompanyId upsertCompany cName = diff --git a/src/Handler/Utils/LMS.hs b/src/Handler/Utils/LMS.hs index 024a68f0e..ee3b89d9f 100644 --- a/src/Handler/Utils/LMS.hs +++ b/src/Handler/Utils/LMS.hs @@ -150,4 +150,4 @@ randomLMSIdentBut banList = untilJustMaxM maxLmsUserIdentRetries getIdentOk randomLMSpw :: MonadIO m => m Text randomLMSpw = randomText extra lengthPassword where - extra = "-+*.:;=!?#$" + extra = "+*:=!?#" -- you cannot distinguish ;: and ., in printed letters diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs index 408ed063f..cb9700ad1 100644 --- a/src/Handler/Utils/Qualification.hs +++ b/src/Handler/Utils/Qualification.hs @@ -11,23 +11,27 @@ module Handler.Utils.Qualification import Import -upsertQualificationUser :: QualificationId -> Day -> Day -> UserId -> DB () -upsertQualificationUser qualificationUserQualification today qualificationUserValidUntil qualificationUserUser = do +upsertQualificationUser :: QualificationId -> Day -> Day -> Maybe Bool -> UserId -> DB () +upsertQualificationUser qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do Entity quid _ <- upsert QualificationUser - { qualificationUserLastRefresh = today - , qualificationUserFirstHeld = today + { qualificationUserFirstHeld = qualificationUserLastRefresh , qualificationUserBlockedDue = Nothing - , qualificationUserScheduleRenewal = True + , qualificationUserScheduleRenewal = fromMaybe True mbScheduleRenewal , .. } - [ QualificationUserValidUntil =. qualificationUserValidUntil - , QualificationUserLastRefresh =. today - , QualificationUserBlockedDue =. Nothing - ] + ( + [ QualificationUserScheduleRenewal =. scheduleRenewal | Just scheduleRenewal <- [mbScheduleRenewal] + ] ++ + [ QualificationUserValidUntil =. qualificationUserValidUntil + , QualificationUserLastRefresh =. qualificationUserLastRefresh + , QualificationUserBlockedDue =. Nothing + ] + ) audit TransactionQualificationUserEdit { transactionQualificationUser = quid , transactionQualification = qualificationUserQualification , transactionUser = qualificationUserUser , transactionQualificationValidUntil = qualificationUserValidUntil + , transactionQualificationScheduleRenewal = mbScheduleRenewal } \ No newline at end of file diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index d40992ab3..d2707ff66 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -59,11 +59,11 @@ abbrvName User{userDisplayName, userFirstName, userSurname} = assemble = Text.intercalate "." --- deprecated, used getPostalAddressIfPreferred +-- deprecated, used getPostalPreferenceAndAddress userPrefersLetter :: User -> Bool userPrefersLetter = fst . getPostalPreferenceAndAddress --- deprecated, used getPostalAddressIfPreferred +-- deprecated, used getPostalPreferenceAndAddress userPrefersEmail :: User -> Bool userPrefersEmail = not . userPrefersLetter @@ -821,7 +821,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do return $ UserSupervisor E.<# E.val newUserId E.<&> (userSupervisor E.^. UserSupervisorUser) - E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications) + E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications) ) (\current excluded -> [ UserSupervisorRerouteNotifications E.=. (current E.^. UserSupervisorRerouteNotifications E.||. excluded E.^. UserSupervisorRerouteNotifications) ] ) deleteWhere [ UserSupervisorSupervisor ==. oldUserId] @@ -847,6 +847,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do E.<# E.val newUserId E.<&> (userCompany E.^. UserCompanyCompany) E.<&> (userCompany E.^. UserCompanySupervisor) + E.<&> (userCompany E.^. UserCompanySupervisorReroute) ) (\current _excluded -> [ UserCompanySupervisor E.=. (current E.^. UserCompanySupervisor)] ) deleteWhere [ UserCompanyUser ==. oldUserId] diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 0d519e183..a10f320bd 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -73,16 +73,18 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do <*> getBy (UniqueQualificationUser nQualification jRecipient) <*> getBy (UniqueLmsQualificationUser nQualification jRecipient) case query of - (Just User{userDisplayName}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do + (Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do let qname = CI.original qualificationName let letter = LetterRenewQualificationF { lmsLogin = lmsUserIdent , lmsPin = lmsUserPin , qualHolder = userDisplayName + , qualHolderSN = userSurname , qualExpiry = qualificationUserValidUntil - , qualId = nQualification + , qualId = nQualification , qualName = qname , qualShort = CI.original qualificationShorthand + , qualSchool = qualificationSchool , qualDuration = qualificationValidDuration } $logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname diff --git a/src/Model/Types/Mail.hs b/src/Model/Types/Mail.hs index c64b71bf1..cba46cefd 100644 --- a/src/Model/Types/Mail.hs +++ b/src/Model/Types/Mail.hs @@ -81,6 +81,18 @@ instance Default NotificationSettings where defaultOff = HashSet.fromList [ NTSheetSoonInactive , NTExamRegistrationSoonInactive + , NTSubmissionRated + , NTSubmissionEdited + , NTSubmissionUserCreated + , NTSubmissionUserDeleted + , NTSheetActive + , NTSheetHint + , NTSheetSolution + , NTSheetInactive + , NTCorrectionsAssigned + , NTCorrectionsNotDistributed + , NTUserAuthModeUpdate + , NTCourseRegistered ] instance ToJSON NotificationSettings where diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index e9c7203c9..f5d8af0f3 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -22,6 +22,7 @@ import Utils.Lens import Text.Blaze (Markup) import qualified Text.Blaze.Internal as Blaze (null) import qualified Data.Text as T +import qualified Data.Char as C import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI @@ -849,6 +850,17 @@ cfCI = convertField CI.mk CI.original cfCommaSeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text) cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . T.splitOn ",") (T.intercalate ", " . Set.toList) +cfAnySeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text) +cfAnySeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . T.split anySeparator) (T.intercalate ", " . Set.toList) + where anySeparator :: Char -> Bool + anySeparator c = C.isSeparator c || c == ',' || c == ';' + +-- -- TODO: consider using package ordered-containers? +-- cfAnySeparatedList :: (Functor m) => Field m Text -> Field m [Text] +-- cfAnySeparatedList = guardField (not . null) . convertField (mapMaybe (assertM' (not . T.null) . T.strip) . T.split anySeparator) (T.intercalate ", ") +-- where anySeparator :: Char -> Bool +-- anySeparator c = C.isSeparator c || c == ',' || c == ';' + isoField :: Functor m => AnIso' a b -> Field m a -> Field m b isoField (cloneIso -> fieldIso) = convertField (view fieldIso) (review fieldIso) diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index fd03915d5..2700c2fad 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -42,7 +42,7 @@ import System.Process.Typed -- for calling pdftk for pdf encryption import Handler.Utils.Users import Handler.Utils.DateTime import Handler.Utils.Mail -import Handler.Utils.Widgets (nameHtml') +import Handler.Utils.Widgets (nameHtml, nameHtml') import Handler.Utils.Avs (updateReceivers) import Jobs.Handler.SendNotification.Utils @@ -368,28 +368,47 @@ convertProto f (IsTime t) = P.toMetaValue $ f t class MDLetter l where getTemplate :: Proxy l -> Text - getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment - getMailBody :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment - letterMeta :: l -> Lang -> DateTimeFormatter -> P.Meta + getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment + getMailBody :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX) -- only used if letter is sent by email as pdf attachment + letterMeta :: l -> DateTimeFormatter -> Lang -> P.Meta getPJId :: l -> PrintJobIdentification data LetterRenewQualificationF = LetterRenewQualificationF { lmsLogin :: LmsIdent , lmsPin :: Text , qualHolder :: UserDisplayName + , qualHolderSN :: UserSurname , qualExpiry :: Day , qualId :: QualificationId , qualName :: Text , qualShort :: Text + , qualSchool :: SchoolId , qualDuration :: Maybe Int } deriving (Eq, Show) +-- this type is specific to this letter to avoid code duplication for derived data or constants +data LetterRenewQualificationFData = LetterRenewQualificationFData { lmsUrl, lmsUrlLogin, lmsIdent :: Text } + deriving (Eq, Show) + +letterRenewalQualificationFData :: LetterRenewQualificationF -> LetterRenewQualificationFData +letterRenewalQualificationFData LetterRenewQualificationF{lmsLogin} = LetterRenewQualificationFData{..} + where + lmsUrl = "https://drive.fraport.de" + lmsUrlLogin = lmsUrl <> "/?login=" <> lmsIdent + lmsIdent = getLmsIdent lmsLogin + instance MDLetter LetterRenewQualificationF where getTemplate _ = templateRenewal getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l - getMailBody l = SomeMessage $ MsgMailBodyQualificationRenewal $ qualName l - letterMeta LetterRenewQualificationF{..} _lang DateTimeFormatter{ format } = mkMeta + -- getMailBody l = SomeMessage $ MsgMailBodyQualificationRenewal $ qualName l + getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } = + let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l + in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet") + + letterMeta l@LetterRenewQualificationF{..} DateTimeFormatter{ format } _lang = + let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l + in mkMeta [ toMeta "login" lmsIdent , toMeta "pin" lmsPin , toMeta "examinee" qualHolder @@ -398,10 +417,7 @@ instance MDLetter LetterRenewQualificationF where , toMeta "url-text" lmsUrl , toMeta "url" lmsUrlLogin ] - where - lmsUrl = "https://drive.fraport.de" - lmsUrlLogin = lmsUrl <> "/?login=" <> lmsIdent - lmsIdent = getLmsIdent lmsLogin + getPJId LetterRenewQualificationF{..} = PrintJobIdentification { pjiName = "Renewal" @@ -418,8 +434,7 @@ sendEmailOrLetter recipient letter = do let tmpl = getTemplate $ pure letter pjid = getPJId letter -- Below are only needed if sent by email - mailSubject = getMailSubject letter - mailBody = getMailBody letter + mailSubject = getMailSubject letter undername = underling ^. _userDisplayName -- nameHtml' underling undermail = CI.original $ underling ^. _userEmail now <- liftIO getCurrentTime @@ -428,7 +443,8 @@ sendEmailOrLetter recipient letter = do let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr isSupervised = recipient /= svr lang = selectDeEn $ rcvrUsr & userLanguages -- select either German or English only, default de; see Utils.Lang - lMeta = letterMeta letter lang formatter <> mkMeta ( + mailBody = getMailBody letter formatter + lMeta = letterMeta letter formatter lang <> mkMeta ( ( if isSupervised then [ toMeta "supervisor" (rcvrUsr & userDisplayName) diff --git a/templates/letter/din5008.latex b/templates/letter/din5008.latex index 76d67a42d..fc4dc02ee 100644 --- a/templates/letter/din5008.latex +++ b/templates/letter/din5008.latex @@ -138,7 +138,7 @@ $endif$ $endif$ \begin{textblock}{65}(84,232)%hpos,vpos - \textcolor{black!33}{ + \textcolor{black!39}{ \begin{labeling}{Login:x} \item[Login:] $login$ \item[Pin:] $pin$ diff --git a/templates/letter/fraport_renewal.md b/templates/letter/fraport_renewal.md index 0aab28550..07978d9ed 100644 --- a/templates/letter/fraport_renewal.md +++ b/templates/letter/fraport_renewal.md @@ -89,7 +89,7 @@ Sollte bis zum Ablaufdatum das E-Learning nicht erfolgreich abgeschlossen sein, zur Wiedererlangung der Fahrberechtigung "F" erneut ein Grundkurs bei der Fahrerausbildung absolviert werden. Bei Fragen können Sie sich gerne an das Team der Fahrerausbildung wenden. -(Please contact us if you prefer letters in English.) +(Please contact us if you prefer letters in English.!) $else$ diff --git a/templates/mail/body/qualificationRenewal.hamlet b/templates/mail/body/qualificationRenewal.hamlet new file mode 100644 index 000000000..66a619e37 --- /dev/null +++ b/templates/mail/body/qualificationRenewal.hamlet @@ -0,0 +1,25 @@ +$newline never + +$# SPDX-FileCopyrightText: 2022 Steffen Jost +$# +$# SPDX-License-Identifier: AGPL-3.0-or-later + +

+ _{SomeMessage $ MsgMailBodyQualificationRenewal qualName} + +

+

+
_{SomeMessage MsgQualificationName} +
+ + #{qualName} +
_{SomeMessage MsgLmsUser} +
#{nameHtml qualHolder qualHolderSN} +
_{SomeMessage MsgLmsQualificationValidUntil} +
#{format SelFormatDate qualExpiry} + +

+ _{SomeMessage MsgLmsRenewalInstructions} # + + + _{SomeMessage MsgMppURL} #{lmsUrl} diff --git a/templates/mail/genericMailLetter.hamlet b/templates/mail/genericMailLetter.hamlet index 703596b65..434debd80 100644 --- a/templates/mail/genericMailLetter.hamlet +++ b/templates/mail/genericMailLetter.hamlet @@ -18,8 +18,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

_{mailSubject} -

- _{mailBody} + ^{mailBody} $if isSupervised

_{SomeMessage MsgMailSupervisorNote} diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index e4545302e..e5a687782 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -28,6 +28,8 @@ import Data.List (foldl) import System.Directory (getModificationTime) import System.FilePath.Glob (glob) +import Database.Persist.Postgresql + {- Needed for File Tests only import qualified Data.Conduit.Combinators as C import Paths_uniworx (getDataFileName) @@ -435,7 +437,7 @@ fillDb = do manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel matUsers <- selectList [UserMatrikelnummer !=. Nothing] [] insertMany_ [UserAvs (AvsPersonId n) uid n | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers] - + let tmin = -1 tmax = 2 trange = [tmin..tmax] @@ -488,20 +490,33 @@ fillDb = do nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" 33 False Nothing ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" 44 False Nothing bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" 5555 False Nothing - void . insert' $ UserCompany jost fraportAg True - void . insert' $ UserCompany svaupel nice True - void . insert' $ UserCompany gkleen nice False - void . insert' $ UserCompany gkleen fraGround False - void . insert' $ UserCompany fhamann bpol False - void . insert' $ UserCompany fhamann ffacil True - void . insert' $ UserCompany fhamann nice False - void . insert' $ UserSupervisor jost gkleen True - void . insert' $ UserSupervisor jost svaupel False - void . insert' $ UserSupervisor jost sbarth False - void . insert' $ UserSupervisor jost tinaTester True - void . insert' $ UserSupervisor svaupel gkleen False - void . insert' $ UserSupervisor svaupel fhamann True - void . insert' $ UserSupervisor sbarth tinaTester True + void . insert' $ UserCompany jost fraportAg True True + void . insert' $ UserCompany svaupel nice True False + void . insert' $ UserCompany gkleen nice False False + void . insert' $ UserCompany gkleen fraGround False True + void . insert' $ UserCompany fhamann bpol False False + void . insert' $ UserCompany fhamann ffacil True True + void . insert' $ UserCompany fhamann nice False False + -- void . insert' $ UserSupervisor jost gkleen True + -- void . insert' $ UserSupervisor jost svaupel False + -- void . insert' $ UserSupervisor jost sbarth False + -- void . insert' $ UserSupervisor jost tinaTester True + -- void . insert' $ UserSupervisor svaupel gkleen False + -- void . insert' $ UserSupervisor svaupel fhamann True + -- void . insert' $ UserSupervisor sbarth tinaTester True + let supvs = [ UserSupervisor jost gkleen True + , UserSupervisor jost svaupel False + , UserSupervisor jost sbarth False + , UserSupervisor jost tinaTester True + , UserSupervisor svaupel gkleen False + , UserSupervisor svaupel fhamann True + , UserSupervisor sbarth tinaTester True + , UserSupervisor gkleen fhamann False + ] + upsertManyWhere supvs [] [] [] + -- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok + -- insertMany_ supvs -- NOTE: multiple calls like this throw an error! + ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional (Just ifiAuthorshipStatement) True SchoolAuthorshipStatementModeRequired (Just ifiAuthorshipStatement) False mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True avn <- insert' $ School "Fahrerausbildung" "FA" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True diff --git a/test/ModelSpec.hs b/test/ModelSpec.hs index d3b8698e4..58220bdef 100644 --- a/test/ModelSpec.hs +++ b/test/ModelSpec.hs @@ -139,6 +139,7 @@ instance Arbitrary User where userCompanyDepartment <- arbitrary userPinPassword <- arbitrary userPostAddress <- arbitrary -- TODO: not a good address + userPostLastUpdate <- arbitrary userPrefersPostal <- arbitrary userExamOfficeGetSynced <- arbitrary userExamOfficeGetLabels <- arbitrary diff --git a/test/User.hs b/test/User.hs index 60e32e0b3..239488fff 100644 --- a/test/User.hs +++ b/test/User.hs @@ -56,4 +56,5 @@ fakeUser adjUser = adjUser User{..} userCompanyDepartment = Nothing userPinPassword = Nothing userPostAddress = Nothing + userPostLastUpdate = Nothing userPrefersPostal = userDefaultPrefersPostal