Merge branch 'master' into fradrive/api-avs

CHANGELOG.md

@@ -2,6 +2,10 @@
 
 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.
 
+## [26.5.14](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.5.13...v26.5.14) (2022-11-06)
+
+## [26.5.13](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.5.12...v26.5.13) (2022-11-03)
+
 ## [26.5.12](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.5.11...v26.5.12) (2022-10-31)
 
 ## [26.5.11](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v26.5.9...v26.5.11) (2022-10-31)

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

@@ -8,13 +8,15 @@ 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
 PrintQualification: Qualifikation
 PrintPDF !ident-ok: PDF
 PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden
-PrintLmsUser: E-Lernen Benachrichtigung?
+PrintLmsUser: E-Learning Benachrichtigung?

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

@@ -8,13 +8,15 @@ PrintJobFilename: Filename
 PrintJobId: Id 
 PrintJobCreated: Created
 PrintJobAcknowledged: Acknowledged
+PrintJobUnacknowledged: Not yet printed
 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
 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?

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
+QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E-Learning
-QualificationElearningStart: E-Lernen automatisch starten
+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
+TableLmsElearning: E-Learning
-TableLmsPin: E-Lernen Pin
+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
+CsvColumnLmsIdent: E-Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer
-CsvColumnLmsPin: PIN des E-Lernen Zugangs
+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.
+LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Learning verlängert werden.
-LmsActNotify: Benachrichtigung E-Lernen erneut per Post oder E-Mail versenden
+LmsActNotify: Benachrichtigung E-Learning erneut per Post oder E-Mail versenden
-LmsActRenewPin: Neue zufällige E-Lernen PIN zuweisen
+LmsActRenewPin: Neue zufällige E-Learning PIN zuweisen
-LmsActRenewNotify: Neue zufällige E-Lernen PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden
+LmsActRenewNotify: Neue zufällige E-Learning 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.
+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-Lernen Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}.
+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

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

@@ -128,11 +128,11 @@ MenuCourseEventEdit: Kurstermin bearbeiten
 MenuLanguage: Sprache
 
 MenuQualifications: Qualifikationen
-MenuLms: E-Lernen
+MenuLms !ident-ok: E-Learning
-MenuLmsEdit: Bearbeiten E-Lernen
+MenuLmsEdit: Bearbeiten E-Learning
-MenuLmsUsers: Export E-Lernen Benutzer
+MenuLmsUsers: Export E-Learning Benutzer
-MenuLmsUserlist: Melden E-Lernen Benutzer
+MenuLmsUserlist: Melden E-Learning Benutzer
-MenuLmsResult: Melden Ergebnisse E-Lernen
+MenuLmsResult: Melden Ergebnisse E-Learning
 MenuLmsUpload: Hochladen
 MenuLmsDirectUpload: Direkter Upload
 MenuLmsDirectDownload: Direkter Download

nix/docker/demo-version.json

@@ -1,3 +1,3 @@
 {
-  "version": "26.5.12"
+  "version": "26.5.14"
 }

nix/docker/version.json

@@ -1,3 +1,3 @@
 {
-  "version": "26.5.12"
+  "version": "26.5.14"
 }

package-lock.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "26.5.12",
+  "version": "26.5.14",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "26.5.12",
+  "version": "26.5.14",
   "description": "",
   "keywords": [],
   "author": "",

package.yaml

@@ -1,5 +1,5 @@
 name: uniworx
-version: 26.5.12
+version: 26.5.14
 dependencies:
   - base
   - yesod

routes

@@ -72,7 +72,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
 

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

src/Handler/LMS.hs

@@ -253,22 +253,18 @@ 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))
-
 
 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
@@ -320,19 +313,13 @@ 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 (E.Value (Maybe [Maybe UTCTime])) -- outer maybe indicates, whether a printJob exists, inner maybe indicates all acknowledged printJobs
-                                                               , E.SqlExpr (E.Value (Maybe [Maybe UTCTime])) -- Nutzbar zum sortieren und filtern!
                                                                )
-lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` printJob) = do
+lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) = do
-    -- E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting; 
+    -- RECALL: another outer join on PrintJob did not work out well, since
-    -- 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.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting;
-    E.on $ lmsUser E.?. LmsUserIdent E.=?. printJob E.?. PrintJobLmsUser
+    --   - using noExsists on printJob join condition works, but only deliver single value;
-        E.&&. -- is the latest created printJob for this LmsUser; note that notExists has in general a pretty good performance in postgresql
+    --  experiments with separate sub-query showed that we would need two subsqueries to learn whether the request was indeed the latest
-              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))
-              )
     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, which does not work
     E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
@@ -342,8 +329,10 @@ 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]
+                    let pjOrder = [E.desc $ pj E.^. PrintJobCreated, E.desc $ pj E.^. PrintJobAcknowledged] -- latest created comes first! This is assumed to be the case later on!
-    return (qualUser, user, lmsUser, printJob, printAcknowledged)
+                    pure $ --(E.arrayAggWith E.AggModeAll (pj E.^. PrintJobCreated     ) pjOrder, -- return two aggregates only works with select, the restricted typr of subSelect does not seem to support this!
+                           E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) pjOrder                           
+    return (qualUser, user, lmsUser, printAcknowledged)
 
 
 newtype LmsTableFilterProj = LmsTableFilterProj { ltProjFilterMayAccess  :: Maybe Bool }
@@ -382,12 +371,11 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
       qusr <-    view $ _dbtProjRow . resultQualUser
       user <-    view $ _dbtProjRow . resultUser
       lusr <- preview $ _dbtProjRow . resultLmsUser      
-      pjob <- preview $ _dbtProjRow . resultPrintJob
       pjac <- preview $ _dbtProjRow . resultPrintAck
       forMM_ (view $ _dbtProjFilter . _ltProjFilterMayAccess) $ \b -> do 
         euid <- encrypt $ user ^. _entityKey
         guardM . lift . lift . fmap (== b) . hasReadAccessTo . urlRoute $ ForProfileDataR euid -- TODO create a page with proper rights; this is only for admins!        
-      return (qusr,user,lusr,pjob,E.Value pjac)
+      return (qusr,user,lusr,E.Value pjac)
 
     dbtColonnade = cols
     dbtSorting = mconcat
@@ -402,9 +390,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 $ queryLmsUser  >>> (E.?. LmsUserNotified)) -- cannot include printJob acknowledge date
-      , 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-ended"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserEnded))
       ]
     dbtFilter = mconcat
@@ -419,18 +405,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 . 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
-        )
       ]
     dbtFilterUI mPrev = mconcat
       [ fltrUserNameEmailHdrUI MsgLmsUser mPrev
@@ -533,19 +508,41 @@ 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
+              let notifyDate      = join $ row ^? resultLmsUser  . _entityVal . _lmsUserNotified
-                  letterDate  = join $ row ^? resultPrintJob . _entityVal . _printJobAcknowledged
+                  lmsident        = row ^? resultLmsUser . _entityVal . _lmsUserIdent                  
-                  -- letterSent  = isJust (row ^? resultPrintJob . _entityKey) && (isNothing letterDate || letterDate > notifyDate) -- bad idea, since a resending increase notifyDay but just reschedules a print job
+                  recipient       = row ^. hasUser                  
-                  letterSent  = isJust (row ^? resultPrintJob . _entityKey)    -- note the difference to letterDate!
+                  letterDates     = row ^? resultPrintAck
-                  notNotified = isNothing notifyDate
+                  lastLetterDate  = headDef Nothing =<< letterDates
-                  cIcon       = iconFixedCell $ iconLetterOrEmail letterSent
+                  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)
-                  cDate       = if letterSent
+                  notNotified     = isNothing notifyDate
-                                  then foldMap dateTimeCell letterDate
+                  cIcon           = iconFixedCell $ iconLetterOrEmail letterSent
-                                  else foldMap dateTimeCell notifyDate
+                  cDate           = if | not letterSent  ->  foldMap dateTimeCell notifyDate
+                                       | Just d <- lastLetterDate -> dateTimeCell d
+                                       | otherwise -> i18nCell MsgPrintJobUnacknowledged
+                  cAckDates = case letterDates of
+                    Just ackDates@(_:_:_) -> spacerCell <> modalCell [whamlet|
+                          <h1>
+                            _{MsgPrintJobAcknowledgements} ^{userWidget recipient}
+                          <ul>
+                            $forall mbackdate <- ackDates
+                              <li>
+                                #{iconLetter} #
+                                  $maybe ackdate <- mbackdate
+                                    ^{formatTimeW SelFormatDateTime ackdate}
+                                  $nothing
+                                    _{MsgPrintJobUnacknowledged}
+                          $maybe _lu <- lmsident
+                            <p>
+                              <a href=@{PrintCenterR}>
+                                Link to PrintJob
+                        |]
+                        -- (PrintCenterR, [("pj-lmsid", toPathPiece lu)])
+                    _ -> mempty
+
               in if notNotified
                   then mempty
-                  else cIcon <> spacerCell <> cDate
+                  else cIcon <> spacerCell <> cDate <> cAckDates
-          , sortable (Just "lms-notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> textCell (show d)
+          -- , sortable (Just "lms-notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> textCell (show d)
           , sortable (Just "lms-ended")     (i18nLms MsgTableLmsEnded)    $ \(preview $ resultLmsUser  . _entityVal . _lmsUserEnded    -> d) -> foldMap dateTimeCell $ join d
           ]
           where

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")
                  ]

src/Handler/PrintCenter.hs

@@ -11,7 +11,6 @@ module Handler.PrintCenter
   , getPrintSendR  , postPrintSendR
   , getPrintAckR   , postPrintAckR
   , postPrintAckDirectR  
-  , postPrintAckFreeR
   ) where
 
 import Import
@@ -230,6 +229,7 @@ mkPJTable = do
       , single ("pj-sender"       , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender)        (E.?. UserDisplayName))
       , single ("pj-course"       , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse)        (E.?. CourseName))
       , single ("pj-qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName))
+      , single ("pj-lmsid"        , FilterColumn . E.mkContainsFilterWith Just $ views (to queryPrintJob)      (E.^. PrintJobLmsUser))
       , single ("acknowledged"    , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
       ]
     dbtFilterUI mPrev = mconcat
@@ -243,6 +243,7 @@ mkPJTable = do
       , prismAForm (singletonFilter "pj-sender"       . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintSender)
       , prismAForm (singletonFilter "pj-course"       . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintCourse)
       , prismAForm (singletonFilter "pj-qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintQualification)
+      , prismAForm (singletonFilter "pj-lmsid"        . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgPrintLmsUser)
       , prismAForm (singletonFilter "acknowledged"    . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged)
       ]
     dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
@@ -447,7 +448,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 

src/Handler/Utils/Mail.hs

@@ -9,6 +9,7 @@ module Handler.Utils.Mail
   , addFileDB
   , addHtmlMarkdownAlternatives
   , addHtmlMarkdownAlternatives'
+  , addHtmlMarkdownAlternatives''
   ) where
 
 import Import
@@ -169,26 +170,36 @@ addHtmlMarkdownAlternatives html' = do
       { P.writerReferenceLinks = True
       }
 
-{-
+-- | provide a name for the part 
-addHtmlMarkdownAlternatives' :: ( HandlerSite m ~ UniWorX
+addHtmlMarkdownAlternatives' :: ( MonadMail m
-                                , MonadMail m
+                                , ToMailPart (HandlerSite m) (NamedMailPart Html)
-                                , ToMailPart (HandlerSite m) Html
                                 , ToMailHtml (HandlerSite m) a
-                                ) => a -> m ()
+                                ) => Text -> a -> m ()
-addHtmlMarkdownAlternatives' = addHtmlMarkdownAlternatives
+addHtmlMarkdownAlternatives' fn html' = do  
--}
+  html <- toMailHtml html'
-
--- For now failed attempt to use with i18nHaletFile or widgets:
-addHtmlMarkdownAlternatives' :: ( HandlerSite m ~ UniWorX
-                                , MonadMail m
-                                , YesodMail (HandlerSite m)
-                                ) => Html -> m ()
-addHtmlMarkdownAlternatives' html = do  
   markdown <- runMaybeT $ renderMarkdownWith htmlReaderOptions writerOptions html
 
   addAlternatives $ do
-    providePreferredAlternative html
+    providePreferredAlternative $ NamedMailPart { namedPart = html, disposition = AttachmentDisposition fn } 
-    whenIsJust markdown provideAlternative
+    whenIsJust markdown $ provideAlternative . NamedMailPart (AttachmentDisposition (fn <> ".txt"))
+  where
+    writerOptions = markdownWriterOptions
+      { P.writerReferenceLinks = True
+      }
+
+
+-- | provide a name for the part 
+addHtmlMarkdownAlternatives'' :: ( MonadMail m
+                                , ToMailPart (HandlerSite m) (NamedMailPart Html)
+                                , ToMailHtml (HandlerSite m) a
+                                ) => Text -> a -> m ()
+addHtmlMarkdownAlternatives'' fn html' = do  
+  html <- toMailHtml html'
+  markdown <- runMaybeT $ renderMarkdownWith htmlReaderOptions writerOptions html
+
+  addAlternatives $ do
+    providePreferredAlternative $ NamedMailPart { disposition = InlineDisposition fn, namedPart = html } 
+    whenIsJust markdown $ provideAlternative . NamedMailPart (AttachmentDisposition (fn <> ".txt"))
   where
     writerOptions = markdownWriterOptions
       { P.writerReferenceLinks = True

src/Handler/Utils/Widgets.hs

@@ -56,6 +56,9 @@ nameWidget :: Text    -- ^ userDisplayName
            -> Widget
 nameWidget displayName surname = toWidget $ nameHtml displayName surname
 
+userWidget :: HasUser c => c -> Widget
+userWidget x = nameWidget (x ^. _userDisplayName) (x ^._userSurname)
+
 -- | toWidget-Version of @nameEmailHtml@, for convenience
 nameEmailWidget :: UserEmail -- ^ userEmail
                 -> Text    -- ^ userDisplayName

src/Jobs/Handler/SendTestEmail.hs

@@ -10,6 +10,7 @@ import Import
 
 import Handler.Utils.Mail
 import Handler.Utils.DateTime
+-- import Handler.Utils.I18n
 
 dispatchJobSendTestEmail :: Email -> MailContext -> JobHandler UniWorX
 dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMailContext $ do
@@ -38,7 +39,7 @@ dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMail
         <li>#{nD}
         <li>#{nT}
     |]
-  addHtmlMarkdownAlternatives $ \(MsgRenderer mr) -> [shamlet|
+  addHtmlMarkdownAlternatives' "addOne" $ \(MsgRenderer mr) -> [shamlet|
     <h2>Repetition just for Testing
     <p>
       #{mr MsgMailTestContent}
@@ -50,3 +51,19 @@ dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMail
         <li>#{nD}
         <li>#{nT}
     |]
+  addHtmlMarkdownAlternatives'' "addTwo" $ \(MsgRenderer mr) -> [shamlet|
+    <h2>Repetition just for Testing
+    <p>
+      #{mr MsgMailTestContent}
+
+    <p>
+      #{mr MsgMailTestDateTime}
+      <ul>
+        <li>#{nDT}
+        <li>#{nD}
+        <li>#{nT}
+    |]
+  -- let test = $(i18nHamletFile "test")
+  -- addHtmlMarkdownAlternatives' "addTest" (test :: Html) --  Text.Blaze.Internal.MarkupM  Text.Blaze.Internal.Markup
+
+  

src/Mail.hs

@@ -23,6 +23,7 @@ module Mail
     -- * Monadically constructing Mail
   , PrioritisedAlternatives
   , ToMailPart(..)
+  , NamedMailPart(..)
   , addAlternatives, provideAlternative, providePreferredAlternative
   , addPart, addPart', modifyPart, partIsAttachment
   , MonadHeader(..)
@@ -435,6 +436,16 @@ instance YesodMail site => ToMailPart site YamlValue where
     _partContent .= PartContent (fromStrict $ Yaml.encode val)
 
 
+data NamedMailPart a = NamedMailPart { disposition :: Disposition, namedPart :: a } 
+
+instance ToMailPart site a => ToMailPart site (NamedMailPart a) where
+  type MailPartReturn site (NamedMailPart a) = MailPartReturn site a
+  toMailPart nmp = do 
+    r <- toMailPart $ namedPart nmp 
+    _partDisposition .= disposition nmp
+    return r    
+
+
 addAlternatives :: (MonadMail m)
                 => Writer (PrioritisedAlternatives m) ()
                 -> m ()
@@ -447,7 +458,7 @@ provideAlternative, providePreferredAlternative
   :: (MonadMail m, HandlerSite m ~ site, ToMailPart site a)
   => a
   -> Writer (PrioritisedAlternatives m) ()
-provideAlternative part = tell $ mempty { otherAlternatives = Seq.singleton $ execStateT (toMailPart part) initialPart }
+provideAlternative          part = tell $ mempty { otherAlternatives  = Seq.singleton $ execStateT (toMailPart part) initialPart }
 providePreferredAlternative part = tell $ mempty { preferredAlternative = Last . Just $ execStateT (toMailPart part) initialPart }
 
 addPart :: ( MonadMail m

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

src/Utils/Icon.hs

@@ -110,6 +110,7 @@ data Icon
   | IconReset
   | IconBlocked
   | IconPrintCenter
+  | IconLetter
   | IconAt
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
   deriving anyclass (Universe, Finite, NFData)
@@ -200,6 +201,7 @@ iconText = \case
     IconReset                   -> "undo" -- From fontawesome v6 onwards: "arrow-rotate-left"
     IconBlocked                 -> "ban"
     IconPrintCenter             -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk"
+    IconLetter                  -> "mail-bulk" -- Problem "envelope" already used for email as well
     IconAt                      -> "at"
 
 nullaryPathPiece ''Icon $ camelToPathPiece' 1
@@ -300,7 +302,7 @@ iconExamRegister True  = icon IconExamRegisterTrue
 iconExamRegister False = icon IconExamRegisterFalse
 
 iconLetterOrEmail :: Bool -> Markup
-iconLetterOrEmail True  = icon IconPrintCenter
+iconLetterOrEmail True  = icon IconLetter
 iconLetterOrEmail False = icon IconAt
 
 ----------------

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  

templates/i18n/test/de-de-formal.hamlet

@@ -0,0 +1,13 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<section>
+  <h2>
+    Diese Datei ist nur zum testen von i18nHamlet gedacht.
+    
+  <p>
+    Ein wesentliches Merkmale dieser Datei ist, #
+    dass es keine Abhängigkeiten gibt.

templates/i18n/test/en-eu.hamlet

@@ -0,0 +1,13 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<section>
+  <h2>
+    This file is only for testing i18nHamlet
+    
+  <p>
+    That the file has no external dependencies
+    is a central feature of this file.

templates/letter/fraport_renewal.md

@@ -1,22 +1,22 @@
 ---
 ### Metadaten, welche hier eingestellt werden:
 # Absender
-de-subject: Verlängerung Vorfeldführerschein
+de-subject: 'Verlängerung Fahrberechtigung "F" (Vorfeldführerschein)'
-en-subject: Renewal of apron driving License
+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,
+  With kind regards,
-    Your fraport driving instructors from "Fahrerausbildung".
+    Your Fraport Driver Training
 encludes:
 hyperrefoptions: hidelinks
 
@@ -53,8 +53,8 @@ $endfor$
 $if(is-de)$
 
 <!-- deutsche Version des Briefes  -->
-die Gültigkeit Ihres Vorfeldführerscheines läuft demnächst ab, am $expiry$.
+die Gültigkeit Ihres Vorfeldführerscheins läuft demnächst ab, am $expiry$.
-Durch die erfolgreiche Teilnahme an einem E-Lernen können Sie die Gültigkeit
+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 der Fahrberechtigung "F"
 erneut der Grundkurs bei der Fahrerausbildung absolviert werden.
 
 
@@ -80,13 +80,13 @@ $else$
 
 <!-- englische Version des Briefes  -->
 
-your apron diving licence is about to expire soon, on $expiry$.
+your apron diving license 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 
+by successfully participating in
-completing an e-learning course. Please use the login data from the protected area below.
+an e-learning. Please use the login data from the protected area below.
 
 Examinee
 
@@ -97,7 +97,7 @@ URL
   :[$url-text$]($url$)
 
 
-Should your apron driving licence expire before completing this 
+Should your apron driving license expire before completing this 
 e-learning course, then a renewal requires your full participation
 of the basic training course again.