From cc07d700ed9ea45a14d67d7017407137e6739ab3 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 1 Nov 2022 12:25:26 +0100 Subject: [PATCH 01/10] chore(letters): fix some spellings and formats --- .../uniworx/categories/print/de-de-formal.msg | 2 +- .../categories/qualification/de-de-formal.msg | 36 +++++++++---------- .../utils/navigation/menu/de-de-formal.msg | 10 +++--- src/Handler/LMS/Fake.hs | 2 +- templates/letter/fraport_renewal.md | 28 +++++++-------- 5 files changed, 39 insertions(+), 39 deletions(-) diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index 0bf2a71c7..ac5192a91 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/messages/uniworx/categories/print/de-de-formal.msg @@ -17,4 +17,4 @@ PrintCourse: Kurse PrintQualification: Qualifikation PrintPDF !ident-ok: PDF PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden -PrintLmsUser: E-Lernen Benachrichtigung? \ No newline at end of file +PrintLmsUser: E-Learning Benachrichtigung? \ No newline at end of file diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 588846007..1cbc49ee6 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -8,8 +8,8 @@ QualificationDescription: Beschreibung QualificationValidDuration: Gültigkeitsdauer QualificationAuditDuration: Aufbewahrung Audit Log QualificationRefreshWithin: Erneurerungszeitraum -QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E-Lernens -QualificationElearningStart: E-Lernen automatisch starten +QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E-Learning +QualificationElearningStart: E-Learning automatisch starten TableQualificationCountActive: Aktive TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation TableQualificationCountTotal: Gesamt @@ -21,8 +21,8 @@ TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend au LmsUser: Inhaber TableLmsEmail: E-Mail TableLmsIdent: Identifikation -TableLmsElearning: E-Lernen -TableLmsPin: E-Lernen Pin +TableLmsElearning: E-Learning +TableLmsPin: E-Learning Pin TableLmsResetPin: Pin zurücksetzen? TableLmsDatePin: Pin erstellt TableLmsDelete: Löschen? @@ -31,16 +31,16 @@ TableLmsStarted: Begonnen TableLmsReceived: Letzte Rückmeldung TableLmsNotified: Versand Benachrichtigung TableLmsEnded: Beended -TableLmsStatus: Status E-Lernen +TableLmsStatus: Status E-Learning TableLmsSuccess: Bestanden TableLmsFailed: Gesperrt FilterLmsValid: Aktuell gültig FilterLmsRenewal: Erneuerung anstehend FilterLmsNotified: Benachrichtigt -CsvColumnLmsIdent: E-Lernen Identifikator, einzigartig pro Qualifikation und Teilnehmer -CsvColumnLmsPin: PIN des E-Lernen Zugangs +CsvColumnLmsIdent: E-Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer +CsvColumnLmsPin: PIN des E-Learning Zugangs CsvColumnLmsResetPin: Wird die PIN bei der nächsten Synchronisation zurückgesetzt? -CsvColumnLmsDelete: Wird der Identifikator in der E-Lernen Plattform bei der nächsten Synchronisation gelöscht? +CsvColumnLmsDelete: Wird der Identifikator in der E-Learning Plattform bei der nächsten Synchronisation gelöscht? CsvColumnLmsStaff: Handelt es sich um einen internen Mitarbeiter? (Aus historischen Gründen, wird momentan ignoriert.) CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme (UTC) CsvColumnLmsFailed: User was blocked by LMS, usually due to too many attempts @@ -51,25 +51,25 @@ LmsResultUpdate: LMS Ergebnis aktualisierung LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel LmsDirectUpload: Direkter Upload für automatisierte Systeme -LmsErrorNoRefreshElearning: Fehler: E-Lernen wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde. +LmsErrorNoRefreshElearning: Fehler: E-Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde. 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: Sie müssen diese Qualifikaton demnächst durch einen E-Lernen Kurs erneuern. +MailBodyQualificationRenewal: Sie müssen diese Qualifikaton demnächst durch einen E-Learning Kurs erneuern. MailBodyQualificationExpiry: Diese Qualifikaton läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden! -MailBodyQualificationExpired: Diese Qualifikaton 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-Lernen. +MailBodyQualificationExpired: Diese Qualifikaton 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. -LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Lernen verlängert werden. -LmsActNotify: Benachrichtigung E-Lernen erneut per Post oder E-Mail versenden -LmsActRenewPin: Neue zufällige E-Lernen PIN zuweisen -LmsActRenewNotify: Neue zufällige E-Lernen PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden -LmsNotificationSend n@Int: E-Lernen Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet. -LmsPinRenewal n@Int: E-Lernen Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}. +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 +LmsActRenewNotify: Neue zufällige E-Learning PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden +LmsNotificationSend n@Int: E-Learning Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet. +LmsPinRenewal n@Int: E-Learning Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}. LmsActionFailed n@Int: Aktion nicht durchgeführt für #{n} #{pluralDE n "Person" "Personen"}, da diese derzeit nicht an einer Prüfung teilnehmen. MppOpening: Anrede MppClosing: Grußformel MppDate: Datum -MppURL: Link E-Lernen +MppURL: Link E-Learning MppLogin !ident-ok: Login MppPin !ident-ok: Pin MppRecipient: Empfänger diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 30977a6be..b3005b8d3 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -128,11 +128,11 @@ MenuCourseEventEdit: Kurstermin bearbeiten MenuLanguage: Sprache MenuQualifications: Qualifikationen -MenuLms: E-Lernen -MenuLmsEdit: Bearbeiten E-Lernen -MenuLmsUsers: Export E-Lernen Benutzer -MenuLmsUserlist: Melden E-Lernen Benutzer -MenuLmsResult: Melden Ergebnisse E-Lernen +MenuLms !ident-ok: E-Learning +MenuLmsEdit: Bearbeiten E-Learning +MenuLmsUsers: Export E-Learning Benutzer +MenuLmsUserlist: Melden E-Learning Benutzer +MenuLmsResult: Melden Ergebnisse E-Learning MenuLmsUpload: Hochladen MenuLmsDirectUpload: Direkter Upload MenuLmsDirectDownload: Direkter Download diff --git a/src/Handler/LMS/Fake.hs b/src/Handler/LMS/Fake.hs index 6f916c122..a9b3b1703 100644 --- a/src/Handler/LMS/Fake.hs +++ b/src/Handler/LMS/Fake.hs @@ -150,7 +150,7 @@ fakeQualificationUsers (Entity qid Qualification{qualificationRefreshWithin}) (u ] someLangs = [ (Just $ Languages ["de-de"] , DateTimeFormat "%a %d %b %Y %T", DateTimeFormat "%a %d.%m.%Y", DateTimeFormat "%T") , (Nothing , DateTimeFormat "%d.%m.%y %R" , DateTimeFormat "%d.%m.%y" , DateTimeFormat "%R") - , (Just $ Languages ["en-eu","de"], DateTimeFormat "%a %d %b %Y %T", DateTimeFormat "%b %d %y" , DateTimeFormat "%I:%M %p") + , (Just $ Languages ["en-eu","de"], DateTimeFormat "%a %d %b %Y %T", DateTimeFormat "%b/%d/%y" , DateTimeFormat "%I:%M %p") , (Just $ Languages ["fr"] , DateTimeFormat "%d-%m-%Y %R" , DateTimeFormat "%d-%m-%Y" , DateTimeFormat "%R") , (Just $ Languages ["fr","en"] , DateTimeFormat "%B %d %Y %R" , DateTimeFormat "%B %d %y" , DateTimeFormat "%I:%M:%S %p") ] diff --git a/templates/letter/fraport_renewal.md b/templates/letter/fraport_renewal.md index a23833298..1e6bcccc1 100644 --- a/templates/letter/fraport_renewal.md +++ b/templates/letter/fraport_renewal.md @@ -1,22 +1,22 @@ --- ### Metadaten, welche hier eingestellt werden: # Absender -de-subject: Verlängerung Vorfeldführerschein -en-subject: Renewal of apron driving License +de-subject: 'Verlängerung Fahrberechtigung "F" (Vorfeldführerschein)' +en-subject: Renewal of apron driving license author: Fraport AG - Fahrerausbildung (AVN-AR) -phone: +49 69 690-30306 +phone: +49 69 690-28467 email: fahrerausbildung@fraport.de -place: Frankfurt/Main +place: Frankfurt am Main return-address: - 60547 Frankfurt de-opening: Sehr geehrte Damen und Herren, en-opening: Dear driver, de-closing: | Mit freundlichen Grüßen, - Ihre Fahrerausbildung. + Ihre Fahrerausbildung en-closing: | - Best wishes, - Your fraport driving instructors from "Fahrerausbildung". + With kind reagards, + Your Fraport Driver Training encludes: hyperrefoptions: hidelinks @@ -53,8 +53,8 @@ $endfor$ $if(is-de)$ -die Gültigkeit Ihres Vorfeldführerscheines läuft demnächst ab, am $expiry$. -Durch die erfolgreiche Teilnahme an einem E-Lernen können Sie die Gültigkeit +die Gültigkeit Ihres Vorfeldführerscheins läuft demnächst ab, am $expiry$. +Durch die erfolgreiche Teilnahme an einem E-Learning können Sie die Gültigkeit $if(validduration)$ um $validduration$ Monate $endif$ @@ -70,7 +70,7 @@ URL : [$url-text$]($url$) -Sobald die Frist abgelaufen ist, muss zur Wiedererlangung des Vorfeldführerscheins +Sobald die Frist abgelaufen ist, muss zur Wiedererlangung des Fahrberechtigung "F" erneut der Grundkurs bei der Fahrerausbildung absolviert werden. @@ -81,12 +81,12 @@ $else$ your apron diving licence is about to expire soon, on $expiry$. -You may renew your apron driving licence +You can extend the validity $if(validduration)$ - by $validduration$ month + by $validduration$ months $endif$ -through successfully -completing an e-learning course. Please use the login data from the protected area below. +by successfully participating in +an e-learning. Please use the login data from the protected area below. Examinee From 40cba1ab9b888948efa8b040edb4a9ca6d30bb09 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 1 Nov 2022 12:42:15 +0100 Subject: [PATCH 02/10] chore(letter): minor typo fix --- messages/uniworx/categories/print/en-eu.msg | 2 +- templates/letter/fraport_renewal.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index b6839bd40..b611ff61b 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/messages/uniworx/categories/print/en-eu.msg @@ -16,5 +16,5 @@ PrintSender: Sender PrintCourse: Course PrintQualification: Qualification PrintPDF: PDF -PrintManualRenewal: Manual sending of an apron driving licence renewal letter +PrintManualRenewal: Manual sending of an apron driver's licence renewal letter PrintLmsUser: E-learning notification? \ No newline at end of file diff --git a/templates/letter/fraport_renewal.md b/templates/letter/fraport_renewal.md index 1e6bcccc1..9cc14c732 100644 --- a/templates/letter/fraport_renewal.md +++ b/templates/letter/fraport_renewal.md @@ -70,7 +70,7 @@ URL : [$url-text$]($url$) -Sobald die Frist abgelaufen ist, muss zur Wiedererlangung des Fahrberechtigung "F" +Sobald die Frist abgelaufen ist, muss zur Wiedererlangung der Fahrberechtigung "F" erneut der Grundkurs bei der Fahrerausbildung absolviert werden. From a6b62674d2e527018a2c92ab3d1442d8488a63d7 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 3 Nov 2022 15:48:30 +0100 Subject: [PATCH 03/10] test(mail): modify sendTestMail to find out how addHtmlMarkdownAlternatives truly works --- .../send/send_notifications/en-eu.msg | 2 +- src/Jobs/Handler/SendTestEmail.hs | 19 +++++++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/messages/uniworx/categories/send/send_notifications/en-eu.msg b/messages/uniworx/categories/send/send_notifications/en-eu.msg index 3a3d18ddf..d6af818f2 100644 --- a/messages/uniworx/categories/send/send_notifications/en-eu.msg +++ b/messages/uniworx/categories/send/send_notifications/en-eu.msg @@ -135,7 +135,7 @@ UserAuthModeLDAPChangedToPWHash: You can now log in using your FRADrive-internal AuthPWHashTip: You now need to use the login form labeled "FRADrive login". Please ensure that you have already set a password when you try to log in. PasswordResetEmailIncoming: For security reasons you will receive a link to the page on which you can set and later change your password in a separate email. MailFradrive: FRADrive -MailBodyFradrive: is the apron driving licence management app of Fraport AG. +MailBodyFradrive: is the apron driver's licence management app of Fraport AG. #userRightsUpdate.hs + templates MailSubjectUserRightsUpdate name: Permissions for #{name} changed diff --git a/src/Jobs/Handler/SendTestEmail.hs b/src/Jobs/Handler/SendTestEmail.hs index c6aa205f4..2b4fe3e32 100644 --- a/src/Jobs/Handler/SendTestEmail.hs +++ b/src/Jobs/Handler/SendTestEmail.hs @@ -14,6 +14,13 @@ import Handler.Utils.DateTime dispatchJobSendTestEmail :: Email -> MailContext -> JobHandler UniWorX dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMailContext $ do _mailTo .= [Address Nothing jEmail] + -- TODO: remove me after the test! + addHtmlMarkdownAlternatives $ \(MsgRenderer _mr) -> [shamlet| +

+ Testheader +

+ Dieser Abschnitt ist ein Test, ob mehrfache Mailparts ankommen. + |] replaceMailHeader "Auto-Submitted" $ Just "auto-generated" setSubjectI MsgMailTestSubject now <- liftIO getCurrentTime @@ -21,6 +28,18 @@ dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMail nD <- formatTimeMail SelFormatDate now nT <- formatTimeMail SelFormatTime now addHtmlMarkdownAlternatives $ \(MsgRenderer mr) -> [shamlet| +

+ #{mr MsgMailTestContent} + +

+ #{mr MsgMailTestDateTime} +

    +
  • #{nDT} +
  • #{nD} +
  • #{nT} + |] + addHtmlMarkdownAlternatives $ \(MsgRenderer mr) -> [shamlet| +

    Repetition just for Testing

    #{mr MsgMailTestContent} From 8a60cd8c028906fe5d87086ce624a521ea8b0135 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 3 Nov 2022 16:49:43 +0100 Subject: [PATCH 04/10] chore(lpr): sanitze printjob names, remove unusable printAckFree route --- routes | 1 - src/Foundation/Navigation.hs | 1 - src/Handler/PrintCenter.hs | 7 +----- src/Utils.hs | 41 ++++++++++++++++++++++++++++++++++++ src/Utils/Print.hs | 3 ++- 5 files changed, 44 insertions(+), 9 deletions(-) diff --git a/routes b/routes index 9a5ea50ad..f888da39e 100644 --- a/routes +++ b/routes @@ -71,7 +71,6 @@ /print PrintCenterR GET POST !system-printer /print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer /print/acknowledge/direct PrintAckDirectR POST !system-printer -/print/acknowledge/free/direct PrintAckFreeR POST !development /print/send PrintSendR GET POST /print/download/#CryptoUUIDPrintJob PrintDownloadR GET !system-printer diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index e28735137..1cb1690d2 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -120,7 +120,6 @@ breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenter breadcrumb PrintDownloadR{} = i18nCrumb MsgMenuPrintDownload $ Just PrintCenterR breadcrumb PrintAckR{} = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed -breadcrumb PrintAckFreeR{} = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR breadcrumb (SchoolR ssh sRoute) = case sRoute of diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index cfe7fd6c4..aa09a11c6 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -10,8 +10,7 @@ module Handler.PrintCenter , getPrintCenterR, postPrintCenterR , getPrintSendR , postPrintSendR , getPrintAckR , postPrintAckR - , postPrintAckDirectR - , postPrintAckFreeR + , postPrintAckDirectR ) where import Import @@ -447,7 +446,3 @@ postPrintAckDirectR = do $logErrorS "APC" msg return (badRequest400, msg) sendResponseStatus status msg -- must be outside of runDB; otherweise transaction is rolled back - --- synonym, used during development to test with and without access control simultaneously -postPrintAckFreeR :: Handler Html -postPrintAckFreeR = postPrintAckDirectR \ No newline at end of file diff --git a/src/Utils.hs b/src/Utils.hs index 9b15bc12c..8b74bbaf9 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -23,6 +23,7 @@ import qualified Data.CaseInsensitive as CI import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as CBS +import qualified Data.Char as Char import qualified Data.Text as Text import qualified Data.Text.Encoding as Text @@ -298,6 +299,46 @@ citext2lower = Text.toLower . CI.original citext2string :: CI Text -> String citext2string = Text.unpack . CI.original +-- | Convert or remove all non-ascii characters, e.g. for filenames +text2asciiAlphaNum :: Text -> Text +text2asciiAlphaNum = Text.filter (\c -> Char.isAlphaNum c && Char.isAscii c) + . Text.replace "ä" "ae" + . Text.replace "Ä" "Ae" + . Text.replace "Æ" "ae" + . Text.replace "æ" "ae" + . Text.replace "Å" "Aa" + . Text.replace "å" "aa" + . Text.replace "â" "a" + . Text.replace "à" "a" + . Text.replace "á" "a" + . Text.replace "Ö" "Oe" + . Text.replace "ö" "oe" + . Text.replace "œ" "oe" + . Text.replace "Ø" "Oe" + . Text.replace "ø" "oe" + . Text.replace "ò" "o" + . Text.replace "ò" "o" + . Text.replace "ò" "o" + . Text.replace "ó" "o" + . Text.replace "Ü" "Ue" + . Text.replace "ü" "ue" + . Text.replace "ù" "u" + . Text.replace "ú" "u" + . Text.replace "û" "u" + . Text.replace "ë" "e" + . Text.replace "ê" "e" + . Text.replace "è" "e" + . Text.replace "é" "e" + . Text.replace "ï" "i" + . Text.replace "î" "i" + . Text.replace "ì" "i" + . Text.replace "í" "i" + . Text.replace "ß" "ss" + . Text.replace "ç" "c" + . Text.replace "ş" "s" + . Text.replace "ğ" "g" + . Text.replace "ñ" "n" + -- | Convert text as it is to Html, may prevent ambiguous types -- This function definition is mainly for documentation purposes text2Html :: Text -> Html diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index a896d8e9e..1bbac1544 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -278,7 +278,8 @@ sendLetter printJobName pdf (printJobRecipient, printJobSender) printJobCourse p nameSender = abbrvName <$> sender nameCourse = CI.original . courseShorthand <$> course nameQuali = CI.original . qualificationShorthand <$> quali - let jobFullName = T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) + let jobFullName = text2asciiAlphaNum $ + T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) printJobFilename = T.unpack $ jobFullName <> ".pdf" -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code printJobFile = LBS.toStrict pdf From 457f4dd6b11044963123c3965308c6788e678077 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 3 Nov 2022 18:59:35 +0100 Subject: [PATCH 05/10] chore(lms): properly show all print job acknowledgements on lms page --- .../uniworx/categories/print/de-de-formal.msg | 2 + messages/uniworx/categories/print/en-eu.msg | 2 + src/Handler/LMS.hs | 93 ++++++++----------- src/Handler/Utils/Widgets.hs | 3 + src/Utils/Icon.hs | 4 +- templates/letter/fraport_renewal.md | 6 +- 6 files changed, 54 insertions(+), 56 deletions(-) diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index ac5192a91..7a865802b 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/messages/uniworx/categories/print/de-de-formal.msg @@ -8,9 +8,11 @@ PrintJobFilename: Dateiname PrintJobId !ident-ok: Id PrintJobCreated: Gesendet PrintJobAcknowledged: Bestätigt +PrintJobUnacknowledged: Noch nicht gedruckt PrintJobAcknowledge n@Int64: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} als gedruckt und versendet bestätigt PrintJobAcknowledgeFailed: Keine Druckaufträge bestätigt aufgrund zwischenzeitlicher Änderungen. Bitte die Seite im Browser aktualisieren! PrintJobAcknowledgeQuestion n@Int d@Text: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} vom #{d} als gedruckt und versendet bestätigen? +PrintJobAcknowledgements: Versanddatum von Briefen an PrintRecipient: Empfänger PrintSender !ident-ok: Sender PrintCourse: Kurse diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index b611ff61b..a63eb1256 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/messages/uniworx/categories/print/en-eu.msg @@ -8,9 +8,11 @@ PrintJobFilename: Filename PrintJobId: Id PrintJobCreated: Created PrintJobAcknowledged: Acknowledged +PrintJobUnacknowledged: Not yet printed by print center PrintJobAcknowledge n: #{n} #{pluralENs n "print-job"} marked as printed and mailed PrintJobAcknowledgeFailed: No print-jobs acknowledged, due to intermediate changes. Please reload this page! PrintJobAcknowledgeQuestion n d: Mark #{n} #{pluralENs n "print-job"} issued on #{d} as printed and mailed already? +PrintJobAcknowledgements: Sent-dates for Letter to PrintRecipient: Recipient PrintSender: Sender PrintCourse: Course diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 825223418..5eaf53078 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -252,23 +252,19 @@ instance CsvColumnsExplained LmsTableCsv where type LmsTableExpr = ( E.SqlExpr (Entity QualificationUser) `E.InnerJoin` E.SqlExpr (Entity User) - ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser)) - `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity PrintJob)) - + ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser)) queryQualUser :: LmsTableExpr -> E.SqlExpr (Entity QualificationUser) -queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1) +queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 2 1) queryUser :: LmsTableExpr -> E.SqlExpr (Entity User) -queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1) +queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 2 1) queryLmsUser :: LmsTableExpr -> E.SqlExpr (Maybe (Entity LmsUser)) -queryLmsUser = $(sqlLOJproj 3 2) +queryLmsUser = $(sqlLOJproj 2 2) -queryPrintJob :: LmsTableExpr -> E.SqlExpr (Maybe (Entity PrintJob)) -queryPrintJob = $(sqlLOJproj 3 3) -type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity PrintJob), E.Value (Maybe [Maybe UTCTime])) +type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), E.Value (Maybe [Maybe UTCTime])) resultQualUser :: Lens' LmsTableData (Entity QualificationUser) resultQualUser = _dbrOutput . _1 @@ -279,11 +275,8 @@ resultUser = _dbrOutput . _2 resultLmsUser :: Traversal' LmsTableData (Entity LmsUser) resultLmsUser = _dbrOutput . _3 . _Just -resultPrintJob :: Traversal' LmsTableData (Entity PrintJob) -resultPrintJob = _dbrOutput . _4 . _Just - resultPrintAck :: Traversal' LmsTableData [Maybe UTCTime] -resultPrintAck = _dbrOutput . _5 . _unValue . _Just +resultPrintAck = _dbrOutput . _4 . _unValue . _Just instance HasEntity LmsTableData User where hasEntity = resultUser @@ -319,20 +312,14 @@ isRenewPinAct LmsActRenewPinData = True lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser) , E.SqlExpr (Entity User) - , E.SqlExpr (Maybe (Entity LmsUser)) - , E.SqlExpr (Maybe (Entity PrintJob)) + , E.SqlExpr (Maybe (Entity LmsUser)) , E.SqlExpr (E.Value (Maybe [Maybe UTCTime])) ) -lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` printJob) = do - -- E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting; - -- instead we use notExits in printJob join condition; experiments with separate sub-query showed that we would need two subsqueries to learn wether the request was indeed the latest - E.on $ lmsUser E.?. LmsUserIdent E.=?. printJob E.?. PrintJobLmsUser - E.&&. -- is the latest created printJob for this LmsUser; note that notExists has in general a pretty good performance in postgresql - E.notExists (E.from $ \otherpj -> - E.where_ $ E.isJust (otherpj E.^. PrintJobLmsUser) - E.&&. ((lmsUser E.?. LmsUserIdent) E.==. (otherpj E.^. PrintJobLmsUser)) - E.&&. ((printJob E.?. PrintJobCreated) E.<. E.just (otherpj E.^. PrintJobCreated)) - ) +lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) = do + -- RECALL: another outer join on PrintJob did not work out well, since + -- - E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting; + -- - using noExsists on printJob join condition works, but only deliver single value; + -- experiments with separate sub-query showed that we would need two subsqueries to learn whether the request was indeed the latest E.on $ user E.^. UserId E.=?. lmsUser E.?. LmsUserUser E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser @@ -340,8 +327,8 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.Left let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do E.where_ $ E.isJust (pj E.^. PrintJobLmsUser) E.&&. ((lmsUser E.?. LmsUserIdent) E.==. (pj E.^. PrintJobLmsUser)) - pure $ E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) [E.asc $ pj E.^. PrintJobCreated] - return (qualUser, user, lmsUser, printJob, printAcknowledged) + pure $ E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) [E.desc $ pj E.^. PrintJobCreated] -- latest comes first! This is assumed to be the case later on! + return (qualUser, user, lmsUser, printAcknowledged) mkLmsTable :: forall h p cols act act'. @@ -381,9 +368,7 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do , single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted)) , single ("lms-datepin" , SortColumn $ queryLmsUser >>> (E.?. LmsUserDatePin)) , single ("lms-received", SortColumn $ queryLmsUser >>> (E.?. LmsUserReceived)) - --, single ("lms-notified", SortColumn $ queryLmsUser >>> (E.?. LmsUserNotified)) - , single ("lms-notified", SortColumn $ \row -> E.coalesce [queryPrintJob row E.?. PrintJobAcknowledged, queryLmsUser row E.?. LmsUserNotified]) -- prefer printJob acknowledgement date, if it exists - -- , single ("lms-notified", SortColumn $ \row -> E.greatest (queryPrintJob row E.?. PrintJobAcknowledged, queryLmsUser row E.?. LmsUserNotified)) -- bad idea, since resending increase notifyDate but just schedules yet another print job + , single ("lms-notified", SortColumn $ queryLmsUser >>> (E.?. LmsUserNotified)) -- cannot include printJob acknowledge date , single ("lms-ended" , SortColumn $ queryLmsUser >>> (E.?. LmsUserEnded)) ] dbtFilter = mconcat @@ -397,18 +382,7 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday | otherwise -> E.true ) - -- , single ("lms-notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.?. LmsUserNotified))) - , single ("lms-notified", FilterColumn $ \row criterion -> - let luser = queryLmsUser row - pjob = queryPrintJob row - in - case getLast criterion of - Just True -> E.isJust (luser E.?. LmsUserNotified) - E.&&. (E.isNothing (pjob E.?. PrintJobId) E.||. E.isJust (pjob E.?. PrintJobAcknowledged)) - Just False -> E.isNothing (luser E.?. LmsUserNotified) - E.||. (E.isJust (pjob E.?. PrintJobId) E.&&. E.isNothing (pjob E.?. PrintJobAcknowledged)) - Nothing -> E.true - ) + , single ("lms-notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.?. LmsUserNotified))) ] dbtFilterUI mPrev = mconcat [ fltrUserNameEmailHdrUI MsgLmsUser mPrev @@ -511,18 +485,33 @@ postLmsR sid qsh = do -- - Email sent : LmsUserNotified == Just _ && PrintJobId == Nothing -- - Letter printed : LmsUserNotified == Just _ && PrintJobId == Just _ -- - Letter sent : LmsUserNotified == Just _ && PrintJobId == Just _ && PrintJobAcknowledged == Just _ - let notifyDate = join $ row ^? resultLmsUser . _entityVal . _lmsUserNotified - letterDate = join $ row ^? resultPrintJob . _entityVal . _printJobAcknowledged - -- letterSent = isJust (row ^? resultPrintJob . _entityKey) && (isNothing letterDate || letterDate > notifyDate) -- bad idea, since a resending increase notifyDay but just reschedules a print job - letterSent = isJust (row ^? resultPrintJob . _entityKey) -- note the difference to letterDate! - notNotified = isNothing notifyDate - cIcon = iconFixedCell $ iconLetterOrEmail letterSent - cDate = if letterSent - then foldMap dateTimeCell letterDate - else foldMap dateTimeCell notifyDate + let notifyDate = join $ row ^? resultLmsUser . _entityVal . _lmsUserNotified + recipient = row ^. hasUser + letterDates = row ^? resultPrintAck + lastLetterDate = headDef Nothing =<< letterDates + letterSent = isJust letterDates && (isNothing lastLetterDate || lastLetterDate >= notifyDate) -- was a letter attempted to send last (not 100% safe, if an email is sent after an unacknowledged letter) + notNotified = isNothing notifyDate + cIcon = iconFixedCell $ iconLetterOrEmail letterSent + cDate = if | not letterSent -> foldMap dateTimeCell notifyDate + | Just d <- lastLetterDate -> dateTimeCell d + | otherwise -> i18nCell MsgPrintJobUnacknowledged + cAckDates = case letterDates of + Just ackDates@(_:_:_) -> spacerCell <> modalCell [whamlet| +

    + _{MsgPrintJobAcknowledgements} ^{userWidget recipient} +