Merge branch 'master' into fradrive/lms-type-refactor

CHANGELOG.md

@@ -2,6 +2,34 @@
 
 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.4.14](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.13...v27.4.14) (2023-07-14)
+
+
+### Bug Fixes
+
+* **avs:** eliminate call to undefined in Esqueleto.Internals ([240c6f8](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/240c6f81f81d1872317da01411fa67ec97e3b16d))
+* **job:** fix [#95](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/95) by implementing queued job deletion for admins ([5b9a554](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5b9a5545457dbe506d20f7362fb6e0d6bae4f7f4))
+
+## [27.4.13](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.12...v27.4.13) (2023-07-12)
+
+
+### Bug Fixes
+
+* **avs:** background avs synch yielding undefined due to wrong monad ([2e59d3c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/2e59d3c2ea4d5017be9b4e578b7da12c4da0e2fa))
+* **lms:** add safeguard to LmsUserlist dispatch running twice, thus ending LMS prematurely ([a8df40d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a8df40d9f8943f2e0c4e219074486dbbf0eaf0fe))
+* **lpr:** fix [#96](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/96) by various minor improvements to PrintCenter ([80c632d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/80c632df1ca4871c10cdac1141d87f92a7646cf7))
+* **tutorial:** fix [#94](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/94) tutorial renaming (de) and template naming ([1ce8f75](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1ce8f75c2d192051929b1a74b17f4e6494961901))
+
+## [27.4.12](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.11...v27.4.12) (2023-07-08)
+
+
+### Bug Fixes
+
+* **avs:** attempt to fix avs background jobs ([bbaa42e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bbaa42eefaaae88982b091973adb295cdc0e80ff))
+* **avs:** avs background synchs and lms userlist result no longer block handler ([0beb0e4](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0beb0e4011745ea51906e018c53548bb2f6d978e))
+* **avs:** fix [#7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/7) by sequencing avs background jobs one after another ([6dc3d8d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/6dc3d8d059e132d19c119c5f1de906342fdf6d2c))
+* **notifications:** direct notifications now respect user triggers ([3e5f271](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3e5f271cacfcc5dbd95aa68a342f56db566f8dee))
+
 ## [27.4.11](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.10...v27.4.11) (2023-06-20)
 
 

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

@@ -81,21 +81,21 @@ CourseSubmissionGroup: Feste Abgabegruppe
 SubmissionGroupEmptyIsUnsetTip: Leer lassen um Benutzer:innen aus den jeweiligen Abgabegruppen ersatzlos zu entfernen
 CourseParticipantsRegisterHeading: Kursartteilnehmer:innen hinzufügen
 CourseParticipantsRegisterActionAddParticipants: Personen zur Kursart anmelden
-CourseParticipantsRegisterActionAddTutorialMembers: Personen zur Kursart und Kursgruppe anmelden
+CourseParticipantsRegisterActionAddTutorialMembers: Personen zur Kursart und Kurs anmelden
 CourseParticipantsRegisterUsersField: Zur Kursart anzumeldende Personen
 CourseParticipantsRegisterUsersFieldTip: Bitte Ausweiskartennummer inklusive Punkt, Fraport Personalnummer oder Email angeben. Mehrere Personen bitte mit Komma oder Leerzeichen trennen.
-CourseParticipantsRegisterTutorialOption: Kursartteilnehmer:innen zu Kursgruppe anmelden?
+CourseParticipantsRegisterTutorialOption: Kursartteilnehmer:innen zu Kurs anmelden?
-CourseParticipantsRegisterTutorialField: Kursgruppe
+CourseParticipantsRegisterTutorialField: Kurs
-CourseParticipantsRegisterTutorialFieldTip: Ist aktuell keine Kursgruppe mit diesem Namen vorhanden, wird eine neue erstellt. Ist bereits eine Kursgruppe mit diesem Namen vorhanden, werden die Kursartteilnehmenden dieser hinzugefügt.
+CourseParticipantsRegisterTutorialFieldTip: Ist aktuell keine Kurs mit diesem Namen vorhanden, wird eine neue erstellt. Ist bereits eine Kurs mit diesem Namen vorhanden, werden die Kursartteilnehmenden dieser hinzugefügt.
 CourseParticipantsRegisterNoneGiven: Es wurden keine anzumeldenden Personen angegeben!
 CourseParticipantsRegisterNotFoundInAvs n@Int: Zu #{n} #{pluralDE n "Angabe konnte keine übereinstimmende Person" "Angaben konnten keine übereinstimmenden Personen"} im AVS gefunden werden
 CourseParticipantsRegisterTutorialFirstDayTip: Wenn ein neuer Kurs gemäß einer Vorlage erstellt wird, werden die Zeiten gemäß dem Starttag angepasst
 
 CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt
 CourseParticipantsAlreadyRegistered n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} #{pluralDE n "ist" "sind"} bereits zur Kursart angemeldet
-CourseParticipantsAlreadyTutorialMember n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} #{pluralDE n "ist" "sind"} bereits in dieser Kursgruppe angemeldet
+CourseParticipantsAlreadyTutorialMember n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} #{pluralDE n "ist" "sind"} bereits in dieser Kurs angemeldet
 CourseParticipantsRegistered n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zur Kursart angemeldet
-CourseParticipantsRegisteredTutorial n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zur Kursgruppe angemeldet
+CourseParticipantsRegisteredTutorial n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zur Kurs angemeldet
 CourseParticipantsRegisterConfirmationHeading: Teilnehmer:innen hinzufügen
 CourseParticipantsRegisterUnnecessary: Alle angeforderten Anmeldungen sind bereits vorhanden. Es wurden keine Änderungen vorgenommen.
 CourseParticipantsRegisterConfirmInvalid: Ungültiges Bestätigungsformular!

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

@@ -3,12 +3,13 @@
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
 HealthReport: Instanz-Zustand
-HealthMatchingClusterConfig: Cluster-geteilte Konfiguration ist aktuell
+HealthCheckMatchingClusterConfig: Cluster-geteilte Konfiguration ist aktuell
-HealthHTTPReachable: Cluster kann an der erwarteten URL über HTTP erreicht werden
+HealthCheckHTTPReachable: Cluster kann an der erwarteten URL über HTTP erreicht werden
-HealthLDAPAdmins: Anteil der Administrator:innen mit LDAP Authentifizierung, welche tatsächlich im LDAP-Verzeichnis gefunden werden können
+HealthCheckLDAPAdmins: Anteil der Administrator:innen mit LDAP Authentifizierung, welche tatsächlich im LDAP-Verzeichnis gefunden werden können
-HealthSMTPConnect: SMTP-Server kann erreicht werden
+HealthCheckSMTPConnect: SMTP-Server kann erreicht werden
-HealthWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
+HealthCheckWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
-HealthActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen
+HealthCheckActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen
+HealthCheckDoesFlush: Abgearbeitete Jobs werden aufgeräumt
 InstanceIdentification: Instanz-Identifikation
 InstanceId: Instanz-Nummer
 ClusterId: Cluster-Nummer

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

@@ -3,12 +3,13 @@
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
 HealthReport: Health report
-HealthMatchingClusterConfig: Cluster config matches
+HealthCheckMatchingClusterConfig: Cluster config matches
-HealthHTTPReachable: Cluster can be reached under the expected URL via HTTP
+HealthCheckHTTPReachable: Cluster can be reached under the expected URL via HTTP
-HealthLDAPAdmins: Proportion of administrators with LDAP authentication that were actually found in the LDAP directory
+HealthCheckLDAPAdmins: Proportion of administrators with LDAP authentication that were actually found in the LDAP directory
-HealthSMTPConnect: SMTP server is reachable
+HealthCheckSMTPConnect: SMTP server is reachable
-HealthWidgetMemcached: Memcached server is serving widgets correctly
+HealthCheckWidgetMemcached: Memcached server is serving widgets correctly
-HealthActiveJobExecutors: Proportion of job workers accepting new jobs
+HealthCheckActiveJobExecutors: Proportion of job workers accepting new jobs
+HealthCheckDoesFlush: Executed jobs are removed
 InstanceIdentification: Instance identification
 InstanceId: Instance id
 ClusterId: Cluster id

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

@@ -4,6 +4,7 @@
 
 PJActAcknowledge: Druck und Versand bestätigen
 PJActReprint: Erneut drucken über APC
+PJActReprintIgnoreReroute: Drucken auch bei aktiver Mail-Umleitung erzwingen
 PrintJobName: Bezeichnung
 PrintJobFilename: Dateiname
 PrintJobId !ident-ok: Id 

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

@@ -4,6 +4,7 @@
 
 PJActAcknowledge: Acknowledge printing and mailing
 PJActReprint: Print again via APC
+PJActReprintIgnoreReroute: Force printing to APC, even if mail-reroute-to option is active
 PrintJobName: Description
 PrintJobFilename: Filename
 PrintJobId: Id 

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

@@ -66,6 +66,7 @@ BreadcrumbFaq !ident-ok: FAQ
 BreadcrumbSheetPersonalisedFiles: Personalisierte Dateien herunterladen
 BreadcrumbCourseSheetPersonalisedFiles: Vorlage für personalisierte Übungsblatt-Dateien herunterladen
 BreadcrumbAdminCrontab !ident-ok: Crontab
+BreadcrumbAdminJobs !ident-ok: Jobs
 BreadcrumbError: Fehler
 BreadcrumbUpload !ident-ok: Upload
 BreadcrumbUserAdd: Benutzer:in anlegen

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

@@ -66,6 +66,7 @@ BreadcrumbFaq: FAQ
 BreadcrumbSheetPersonalisedFiles: Download personalised sheet files
 BreadcrumbCourseSheetPersonalisedFiles: Download template for personalised sheet files
 BreadcrumbAdminCrontab: Crontab
+BreadcrumbAdminJobs !ident-ok: Jobs
 BreadcrumbError: Error
 BreadcrumbUpload: Upload
 BreadcrumbUserAdd: Add user

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

@@ -107,6 +107,7 @@ MenuFaq !ident-ok: FAQ
 MenuSheetPersonalisedFiles: Personalisierte Dateien herunterladen
 MenuCourseSheetPersonalisedFiles: Vorlage für personalisierte Übungsblatt-Dateien herunterladen
 MenuAdminCrontab !ident-ok: Crontab
+MenuAdminJobs: Job Warteschlange
 MenuGlossary: Begriffsverzeichnis
 MenuVersion: Versionsgeschichte
 MenuCourseNewsNew: Neue Kursartnachricht

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

@@ -108,6 +108,7 @@ MenuFaq: FAQ
 MenuSheetPersonalisedFiles: Download personalised sheet files
 MenuCourseSheetPersonalisedFiles: Download template for personalised sheet files
 MenuAdminCrontab: Crontab
+MenuAdminJobs: Job queue
 MenuGlossary: Glossary
 MenuVersion: Version history
 MenuCourseNewsNew: Add course type news

messages/uniworx/utils/table_column/de-de-formal.msg

@@ -78,3 +78,11 @@ TableCompany: Firma
 TableCompanies: Firmen
 TableCompanyNos: Firmennummern
 TableSupervisor: Ansprechpartner
+TableCreationTime: Erstellungszeit
+TableJob !ident-ok: Job
+TableJobContent !ident-ok: Parameter
+TableJobLockTime: Bearbeitung seit
+TableJobLockInstance: Bearbeiter
+TableJobCreationInstance: Ersteller
+ActJobDelete: Job entfernen
+TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} Jobs entfernt

messages/uniworx/utils/table_column/en-eu.msg

@@ -78,3 +78,11 @@ TableCompany: Company
 TableCompanies: Companies
 TableCompanyNos: Company numbers
 TableSupervisor: Supervisor
+TableCreationTime: Creation
+TableJob !ident-ok: Job
+TableJobContent !ident-ok: Parameters
+TableJobLockTime: Lock time
+TableJobLockInstance: Worker
+TableJobCreationInstance: Creator
+ActJobDelete: Delete job
+TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} queued jobs deleted

nix/docker/demo-version.json

@@ -1,3 +1,3 @@
 {
-  "version": "27.4.11"
+  "version": "27.4.14"
 }

nix/docker/version.json

@@ -1,3 +1,3 @@
 {
-  "version": "27.4.11"
+  "version": "27.4.14"
 }

package-lock.json

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

package.json

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

package.yaml

@@ -1,5 +1,5 @@
 name: uniworx
-version: 27.4.11
+version: 27.4.14
 dependencies:
   - base
   - yesod

routes

@@ -66,6 +66,7 @@
 /admin/errMsg                 AdminErrMsgR     GET POST
 /admin/tokens                 AdminTokensR     GET POST
 /admin/crontab                AdminCrontabR    GET
+/admin/crontab/jobs           AdminJobsR       GET POST
 /admin/avs                    AdminAvsR        GET POST
 /admin/avs/#CryptoUUIDUser    AdminAvsUserR    GET
 /admin/ldap                   AdminLdapR       GET POST

src/Application.hs

@@ -550,8 +550,8 @@ warpSettings foundation = defaultSettings
                                                    & Set.filter (is _Just . (foundation ^. _appHealthCheckInterval))
                                   atomically $ do
                                     results <- readTVar $ foundation ^. _appHealthReport
-                                    guard $ activeChecks == Set.map (classifyHealthReport . snd) results
+                                    guard $ activeChecks `Set.isSubsetOf` Set.map (classifyHealthReport . snd) results
-                                    guard . (== Min HealthSuccess) $ foldMap (Min . healthReportStatus . snd) results
+                                    guard . (/= Min HealthFailure) $ foldMap (Min . healthReportStatus . snd) results
                                   notifyReady
                               | otherwise
                                 -> notifyReady
@@ -679,7 +679,7 @@ appMain = runResourceT $ do
                              interval <- mInterval
                              let lastSuccess = maybeMonoid mResults
                                    & Set.filter (\(_, rep) -> classifyHealthReport rep == hc)
-                                   & Set.filter (\(_, rep) -> healthReportStatus rep >= HealthSuccess)
+                                   & Set.filter (\(_, rep) -> healthReportStatus rep > HealthFailure)
                                    & Set.mapMonotonic (view _1)
                                    & Set.lookupMax
 

src/Foundation/I18n.hs

@@ -319,6 +319,7 @@ appLanguagesOpts = do
       langOptions = map mkOption $ toList appLanguages
   return $ mkOptionList langOptions
 
+embedRenderMessage ''UniWorX ''HealthCheck id
 embedRenderMessage ''UniWorX ''MessageStatus ("Message" <>)
 embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel
 embedRenderMessage ''UniWorX ''StudyFieldType id

src/Foundation/Navigation.hs

@@ -112,6 +112,7 @@ breadcrumb AdminTestPdfR        = i18nCrumb MsgMenuAdminTest              $ Just
 breadcrumb AdminErrMsgR         = i18nCrumb MsgMenuAdminErrMsg            $ Just AdminR
 breadcrumb AdminTokensR         = i18nCrumb MsgMenuAdminTokens            $ Just AdminR
 breadcrumb AdminCrontabR        = i18nCrumb MsgBreadcrumbAdminCrontab     $ Just AdminR
+breadcrumb AdminJobsR           = i18nCrumb MsgBreadcrumbAdminJobs        $ Just AdminCrontabR
 breadcrumb AdminAvsR            = i18nCrumb MsgMenuAvs                    $ Just AdminR
 breadcrumb AdminAvsUserR{}      = i18nCrumb MsgAvsPersonInfo              $ Just AdminAvsR
 breadcrumb AdminLdapR           = i18nCrumb MsgMenuLdap                   $ Just AdminR
@@ -2398,6 +2399,13 @@ pageActions PrintCenterR = do
   dayLinks <- mapM toDayAck $ Map.toAscList dayMap
   return $ manualSend : take 9 dayLinks
 
+pageActions AdminCrontabR = return 
+  [ NavPageActionPrimary
+    { navLink = defNavLink MsgMenuAdminJobs AdminJobsR
+    , navChildren = []
+    }
+  ]
+
 pageActions _ = return []
 
 submissionList :: ( MonadIO m

src/Handler/Admin.hs

@@ -55,8 +55,7 @@ getAdminProblemsR = do
     (Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException)
     (Right AvsLicenceDifferences{..}) -> do
       let problemIds = avsLicenceDiffRevokeAll <> avsLicenceDiffGrantVorfeld <> avsLicenceDiffRevokeRollfeld <> avsLicenceDiffGrantRollfeld      
-      -- mapM_  (queueJob' . flip JobSynchroniseAvsId cutOffAvsSynch) problemIds
+      forM_ (take 42 $ Set.toList problemIds) $ queueJob' . flip JobSynchroniseAvsId (Just nowaday)      
-      runDBJobs . forM_ problemIds $ queueDBJob . flip JobSynchroniseAvsId (Just nowaday)
       return $ Right
         ( Set.size avsLicenceDiffRevokeAll
         , Set.size avsLicenceDiffGrantVorfeld

src/Handler/Admin/Crontab.hs

@@ -6,23 +6,35 @@
 
 module Handler.Admin.Crontab
   ( getAdminCrontabR
+  , getAdminJobsR
+  , postAdminJobsR
   ) where
 
 import Import
 import Jobs
-import Handler.Utils.DateTime
+import Handler.Utils
 
+-- import Data.Aeson (fromJSON)
+-- import qualified Data.Aeson as Aeson
+-- import qualified Data.Aeson.Types as Aeson
 import qualified Data.Aeson.Encode.Pretty as Pretty          
-import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder')
 
+-- import qualified Data.CaseInsensitive as CI
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy.Builder as Text.Builder
 
+import qualified Data.Set as Set
+import qualified Data.Map as Map
 import qualified Data.HashSet as HashSet
 import qualified Data.HashMap.Strict as HashMap
 
 import qualified Data.UUID as UUID
 
+import Database.Persist.Sql (deleteWhereCount)
+import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Utils as E
+-- import Database.Esqueleto.Utils.TH
+
 
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 1
@@ -89,10 +101,125 @@ getAdminCrontabR = do
     provideJson mCrontab'
     provideRep . return . Text.Builder.toLazyText $ doEnc mCrontab'
   where
-    doEnc :: _ => a -> _
+    doEnc :: ToJSON a => a -> _
-    doEnc = encodePrettyToTextBuilder' Pretty.defConfig
+    doEnc = Pretty.encodePrettyToTextBuilder' Pretty.defConfig
       { Pretty.confIndent = Pretty.Spaces 2
       , Pretty.confCompare = comparing $ \t -> ( t `elem` ["instruction", "job", "notification"]
                                                , Text.splitOn "-" t
                                                )
       }
+
+
+data JobTableAction = ActJobDelete
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
+
+instance Universe JobTableAction
+instance Finite JobTableAction
+nullaryPathPiece ''JobTableAction $ camelToPathPiece' 1
+embedRenderMessage ''UniWorX ''JobTableAction id
+
+-- Not yet needed, since there is no additional data for now (also, postprocess did not type somehow)
+-- data JobTableActionData = ActJobDeleteData
+--   deriving (Eq, Ord, Read, Show, Generic)
+
+
+getAdminJobsR, postAdminJobsR :: Handler Html
+getAdminJobsR = postAdminJobsR
+postAdminJobsR = do
+  let
+    jobsDBTable = DBTable{..}
+      where
+        resultJob :: Lens' (DBRow (Entity QueuedJob)) (Entity QueuedJob)
+        resultJob = _dbrOutput
+
+        dbtIdent :: Text
+        dbtIdent = "queued-jobs"
+
+        dbtSQLQuery = return
+        dbtRowKey = (E.^. QueuedJobId)
+        dbtProj = dbtProjId
+        dbtColonnade = mconcat
+          [ dbSelect (applying _2) id (return . view (resultJob . _entityKey))
+          , sortable (Just "job")               (i18nCell MsgTableJob)                  $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe textCell $ getJobName queuedJobContent
+          , sortable (Just "creation-time")     (i18nCell MsgTableCreationTime)         $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> dateTimeCell queuedJobCreationTime
+          , sortable (Just "content")           (i18nCell MsgTableJobContent)           $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cell [whamlet|#{doEnc queuedJobContent}|] & addCellClass ("json"::Text)
+          , sortable (Just "lock-time")         (i18nCell MsgTableJobLockTime)          $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe dateTimeCell queuedJobLockTime
+          , sortable (Just "lock-instance")     (i18nCell MsgTableJobLockInstance)      $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe (stringCell . show) queuedJobLockInstance
+          , sortable (Just "creation-instance") (i18nCell MsgTableJobCreationInstance)  $ \(view $ resultJob . _entityVal -> QueuedJob{..}) ->            stringCell $ show  queuedJobCreationInstance
+          ]
+        dbtSorting = Map.fromList 
+          [ ("creation-time"    , SortColumnNullsInv (E.^. QueuedJobCreationTime))
+          , ("job"              , SortColumn         (\v -> v E.^. QueuedJobContent E.->>. "job"))
+          , ("content"          , SortColumn         (E.^. QueuedJobContent))
+          , ("lock-time"        , SortColumnNullsInv (E.^. QueuedJobLockTime))
+          , ("lock-instance"    , SortColumn         (E.^. QueuedJobLockInstance))
+          , ("creation-instance", SortColumn         (E.^. QueuedJobCreationInstance))
+          ]
+        dbtFilter = Map.fromList
+          [
+            ("job", FilterColumn $ E.mkContainsFilter (\v -> v E.^. QueuedJobContent E.->>. "job"))
+          ]
+        dbtFilterUI = \mPrev -> mconcat
+          [
+            prismAForm (singletonFilter "job" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableJob)
+          ]
+        dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
+        acts :: Map JobTableAction (AForm Handler JobTableAction)
+        acts = Map.singleton ActJobDelete $ pure ActJobDelete
+        dbtParams = DBParamsForm 
+          { dbParamsFormAdditional = 
+            renderAForm FormStandard
+               $  (, mempty) . First . Just
+              <$> multiActionA acts (fslI MsgTableAction) Nothing          
+          , dbParamsFormMethod    = POST
+          , dbParamsFormAction    = Nothing -- Just $ SomeRoute currentRoute
+          , dbParamsFormAttrs     = []
+          , dbParamsFormSubmit    = FormSubmit
+          , dbParamsFormEvaluate  = liftHandler . runFormPost
+          , dbParamsFormResult    = id
+          , dbParamsFormIdent     = def
+          }
+        dbtCsvEncode = noCsvEncode
+        dbtCsvDecode = Nothing
+        dbtExtraReps = []
+    -- jobsDBTableValidator :: PSValidator (MForm Handler) (FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob))))
+    jobsDBTableValidator = def 
+      & defaultSorting [SortDescBy "creation-time"]
+    -- postprocess :: FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob))) 
+    --             -> FormResult (JobTableAction, Set QueuedJobId)
+    postprocess inp = do 
+      (First (Just act), jobMap) <- inp
+      let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
+      return (act, jobSet)
+  (jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable)
+
+  formResult jobActRes $ \case
+    (ActJobDelete, jobIds) -> do
+      let jobReq  = length jobIds
+      rmvd <- fromIntegral <$> runDB (deleteWhereCount
+        [ QueuedJobLockTime ==. Nothing
+        , QueuedJobLockInstance ==. Nothing
+        , QueuedJobId <-. Set.toList jobIds
+        ])
+      addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq)
+      reloadKeepGetParams AdminJobsR
+
+
+  siteLayoutMsg MsgMenuAdminJobs $ do
+    setTitleI MsgMenuAdminJobs
+    [whamlet|
+      ^{jobsTable}
+    |]
+  where
+    doEnc :: ToJSON a => a -> _
+    doEnc = Pretty.encodePrettyToTextBuilder' Pretty.defConfig
+      { Pretty.confIndent = Pretty.Spaces 2
+      , Pretty.confCompare = comparing $ \t -> ( t `elem` ["job", "notification"]
+                                               , Text.splitOn "-" t
+                                               )
+      }
+  
+    getJobName :: Value -> Maybe Text
+    getJobName (Object o) 
+      | Just (String s) <- HashMap.lookup "job" o = Just s -- $ kebabToCamel s
+    getJobName _ = Nothing

src/Handler/Course/ParticipantInvite.hs

@@ -52,7 +52,7 @@ tutorialDefaultName :: Maybe TutorialType -> Day -> TutorialName
 tutorialDefaultName Nothing     = CI.mk . tshow  -- Don't use user date display setting, so that tutorial default names conform to all users
 tutorialDefaultName (Just ttyp) = 
   let prefix = CI.mk $ snd $ Text.breakOnEnd (CI.original tutorialTypeSeparator) $ CI.original ttyp
-  in  ((prefix <> tutorialTypeSeparator) <>) . tutorialDefaultName Nothing
+  in  (<> (tutorialTypeSeparator <> prefix)) . tutorialDefaultName Nothing
 
 data ButtonCourseRegisterMode = BtnCourseRegisterConfirm | BtnCourseRegisterAbort
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)

src/Handler/Health.hs

@@ -6,7 +6,7 @@ module Handler.Health where
 
 import Import
 
--- import Handler.Utils
+import Handler.Utils.DateTime (formatTimeW)
 
 import qualified Data.Aeson.Encode.Pretty as Aeson
 import qualified Data.Text.Lazy.Builder as Builder
@@ -34,7 +34,7 @@ getHealthR = do
       waitResult <- atomically $ maybe (pure $ Left False) (fmap (const $ Left True) . waitDelay) delay <|> (fmap Right . assertM (not. Set.null) $ readTVar reportStore)
       case waitResult of
         Left False -> sendResponseStatus noContent204 ()
-        Left True  -> sendResponseStatus internalServerError500 ("System is not generating HealthReports" :: Text)
+        Left True  -> sendResponseStatus internalServerError500 ("System is not generating HealthReports" :: Text) -- can this ever happen after it was non-null?
         Right _    -> redirect HealthR
     Just healthReports -> do
       let (Max lastUpdated, Min status) = ofoldMap1 (Max *** Min . healthReportStatus) healthReports
@@ -48,37 +48,41 @@ getHealthR = do
       setLastModified lastUpdated
 
       let status'
-            | HealthSuccess <- status
+            | HealthFailure <- status
-            = ok200
-            | otherwise
             = internalServerError500
+            | otherwise
+            = ok200
       sendResponseStatus status' <=< selectRep $ do
         provideRep . siteLayoutMsg MsgHealthReport $ do
           setTitleI MsgHealthReport
           [whamlet|
             $newline never
+            <h2>
+              $case status
+                $of HealthSuccess
+                  _{MsgMessageSuccess}
+                $of HealthInactive
+                  _{MsgMessageWarning}
+                $of _
+                  _{MsgMessageError}
+            <hr>
             <dl .deflist>
-              $forall (_, report) <- healthReports'
+              $forall (lUp, report) <- healthReports'
-                $case report
+                $case healthReportStatus report
-                  $of HealthMatchingClusterConfig passed
+                  $of HealthInactive
-                    <dt .deflist__dt>_{MsgHealthMatchingClusterConfig}
+                  $of hcstatus
-                    <dd .deflist__dd>#{boolSymbol passed}
+                    <dt .deflist__dt>
-                  $of HealthHTTPReachable (Just passed)
+                      _{classifyHealthReport report}
-                    <dt .deflist__dt>_{MsgHealthHTTPReachable}
+                    <dd .deflist__dd>
-                    <dd .deflist__dd>#{boolSymbol passed}
+                      #{boolSymbol (healthOk hcstatus)} #
-                  $of HealthLDAPAdmins (Just found)
+                      $case report
-                    <dt .deflist__dt>_{MsgHealthLDAPAdmins}
+                        $of HealthLDAPAdmins (Just found)
-                    <dd .deflist__dd>#{textPercent found 1}
+                          #{textPercent found 1}  
-                  $of HealthSMTPConnect (Just passed)
+                        $of HealthActiveJobExecutors (Just active)
-                    <dt .deflist__dt>_{MsgHealthSMTPConnect}
+                          #{textPercent active 1}
-                    <dd .deflist__dd>#{boolSymbol passed}
+                        $of _
-                  $of HealthWidgetMemcached (Just passed)
+                      <div>
-                    <dt .deflist__dt>_{MsgHealthWidgetMemcached}
+                        ^{formatTimeW SelFormatDateTime lUp}                      
-                    <dd .deflist__dd>#{boolSymbol passed}
-                  $of HealthActiveJobExecutors (Just active)
-                    <dt .deflist__dt>_{MsgHealthActiveJobExecutors}
-                    <dd .deflist__dd>#{textPercent active 1}
-                  $of _
           |]
         provideJson healthReports
         provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReports
@@ -105,7 +109,7 @@ getInstanceR = do
     provideRep . return $ tshow instanceInfo
 
 
--- Most simple page for simple liveness checks
+-- Most simple page for simple liveness checks, but it always delivers 200
 getStatusR :: Handler Html
 getStatusR = do
   starttime <- getsYesod appStartTime

src/Handler/LMS.hs

@@ -348,7 +348,6 @@ instance Finite LmsTableAction
 nullaryPathPiece ''LmsTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''LmsTableAction id
 
--- Not yet needed, since there is no additional data for now:
 data LmsTableActionData = LmsActNotifyData
                         | LmsActRenewNotifyData
                         | LmsActRenewPinData            -- no longer used
@@ -692,14 +691,14 @@ postLmsR sid qsh = do
 
         fromIntegral <$> deleteWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. usersList]
 
-      runDBJobs $ forM_ selectedUsers $ \uid ->
+      forM_ selectedUsers $ \uid ->
-        queueDBJob $ JobLmsEnqueueUser { jQualification = qid, jUser = uid }
+        queueJob' $ JobLmsEnqueueUser { jQualification = qid, jUser = uid }
       let mStatus  = bool Success Warning $ delUsers < numUsers
       addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers      
       reloadKeepGetParams $ LmsR sid qsh
 
     (action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do      
-      numExaminees <- runDBJobs $ do
+      numExaminees <- runDB $ do
         okUsers <- selectList [ LmsUserQualification  ==. qid                       -- matching qualification
                               , LmsUserEnded          ==. Nothing                   -- not yet deleted
                               , LmsUserStatus         ==. Nothing                   -- not yet decided
@@ -710,7 +709,7 @@ postLmsR sid qsh = do
             newPin <- liftIO randomLMSpw
             update lid [LmsUserPin =. newPin, LmsUserDatePin =. now, LmsUserResetPin =. True]
           when (isNotifyAct action) $
-            queueDBJob $ JobUserNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid' False }
+            queueJob' $ JobUserNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid' False }
         return $ length okUsers
       let numSelected  = length selectedUsers
           diffSelected = numSelected - numExaminees

src/Handler/LMS/Result.hs

@@ -212,7 +212,7 @@ postLmsResultR sid qsh = do
 
 -- Direct File Upload/Download
 
-saveResultCsv :: QualificationId -> Int -> LmsResultTableCsv -> JobDB Int
+saveResultCsv :: QualificationId -> Int -> LmsResultTableCsv -> DB Int
 saveResultCsv qid i LmsResultTableCsv{..} = do
     now <- liftIO getCurrentTime
     void $ upsert
@@ -238,12 +238,12 @@ postLmsResultUploadR sid qsh = do
     FormSuccess file -> do
       -- content <- fileSourceByteString file
       -- return $ Just (fileName file, content)
-      nr <- runDBJobs $ do
+      nr <- runDB $ do
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
         nr <- runConduit $ fileSource file
                 .| decodeCsv
                 .| foldMC (saveResultCsv qid) 0
-        queueDBJob $ JobLmsResults qid
+        queueJob' $ JobLmsResults qid
         return nr
       addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen")
       redirect $ LmsResultR sid qsh
@@ -267,7 +267,7 @@ postLmsResultDirectR sid qsh = do
   (status, msg) <- case files of
     [(fhead,file)] -> do
       lmsDecoder <- getLmsCsvDecoder
-      runDBJobs $ do
+      runDB $ do
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
         enr <- try $ runConduit $ fileSource file
                 .| lmsDecoder
@@ -279,7 +279,7 @@ postLmsResultDirectR sid qsh = do
           Right nr -> do
             let msg = "Success. LMS Result upload file " <> fileName file <> " containing " <> tshow nr <> " rows for " <> fhead <> ".  "
             $logInfoS "LMS" msg
-            when (nr > 0) $ queueDBJob $ JobLmsResults qid
+            when (nr > 0) $ queueJob' $ JobLmsResults qid
             return (ok200, msg)
     []     -> do
       let msg = "Result upload file missing."

src/Handler/LMS/Userlist.hs

@@ -212,7 +212,7 @@ postLmsUserlistR sid qsh = do
 -- Direct File Upload/Download
 --  saveUserlistCsv :: (PersistUniqueWrite backend, MonadIO m, BaseBackend backend ~ SqlBackend, Enum b) =>
 --                      Key Qualification -> b -> LmsUserlistTableCsv -> ReaderT backend m b
-saveUserlistCsv :: QualificationId -> Int -> LmsUserlistTableCsv -> JobDB Int
+saveUserlistCsv :: QualificationId -> Int -> LmsUserlistTableCsv -> DB Int
 saveUserlistCsv qid i LmsUserlistTableCsv{..} = do
     now <- liftIO getCurrentTime
     void $ upsert
@@ -236,10 +236,10 @@ postLmsUserlistUploadR sid qsh = do
   ((result,widget), enctype) <- runFormPost makeUserlistUploadForm
   case result of
     FormSuccess file -> do
-      nr <- runDBJobs $ do
+      nr <- runDB $ do
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
         nr <- runConduit $ fileSource file .| decodeCsv .| foldMC (saveUserlistCsv qid) 0
-        queueDBJob $ JobLmsUserlist qid
+        queueJob' $ JobLmsUserlist qid
         return nr
       addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen")
       redirect $ LmsUserlistR sid qsh
@@ -263,7 +263,7 @@ postLmsUserlistDirectR sid qsh = do
   (status, msg) <- case files of
     [(fhead,file)] -> do
       lmsDecoder <- getLmsCsvDecoder
-      runDBJobs $ do
+      runDB $ do
         qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
         enr <- try $ runConduit $ fileSource file
                 .| lmsDecoder
@@ -275,7 +275,7 @@ postLmsUserlistDirectR sid qsh = do
           Right nr -> do
             let msg = "Success. LMS Userlist upload file " <> fileName file <> " containing " <> tshow nr <> " rows for " <> fhead <> ".  "
             $logInfoS "LMS" msg 
-            when (nr > 0) $ queueDBJob $ JobLmsUserlist qid
+            when (nr > 0) $ queueJob' $ JobLmsUserlist qid
             return (ok200, msg)
     []     -> do
       let msg = "Userlist upload file missing."

src/Handler/PrintCenter.hs

@@ -127,7 +127,7 @@ nullaryPathPiece ''PJTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''PJTableAction id
 
 -- Not yet needed, since there is no additional data for now:
-data PJTableActionData  = PJActAcknowledgeData | PJActReprintData
+data PJTableActionData  = PJActAcknowledgeData | PJActReprintData { ignoreReroute :: Maybe Bool }
   deriving (Eq, Ord, Read, Show, Generic)
 
 type PJTableExpr = (                  E.SqlExpr (Entity PrintJob)
@@ -192,7 +192,7 @@ mkPJTable = do
     dbtRowKey = queryPrintJob >>> (E.^. PrintJobId)
     dbtProj = dbtProjId
     dbtColonnade = mconcat
-      [ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged)
+      [ dbSelect (applying _2) id (return . view (resultPrintJob . _entityKey)) -- condition for dbSelectIf: (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged)
       , sortable (Just "created")      (i18nCell MsgPrintJobCreated)       $ \(   view $ resultPrintJob . _entityVal . _printJobCreated        -> t) ->      dateTimeCell t
       , sortable (Just "acknowledged") (i18nCell MsgPrintJobAcknowledged)  $ \(   view $ resultPrintJob . _entityVal . _printJobAcknowledged   -> t) -> maybeDateTimeCell t
       , sortable (Just "filename")     (i18nCell MsgPrintPDF)  $ \r -> let k = r ^. resultPrintJob . _entityKey
@@ -262,7 +262,8 @@ mkPJTable = do
           = let acts :: Map PJTableAction (AForm Handler PJTableActionData)
                 acts = mconcat
                   [ singletonMap PJActAcknowledge $ pure PJActAcknowledgeData
-                  , singletonMap PJActReprint     $ pure PJActReprintData
+                  , singletonMap PJActReprint     $ PJActReprintData
+                      <$> aopt checkBoxField (fslI MsgPJActReprintIgnoreReroute) Nothing
                   ]
              in renderAForm FormStandard
                $  (, mempty) . First . Just
@@ -292,15 +293,23 @@ postPrintCenterR = do
       num <- runDB $ updateWhereCount  [PrintJobAcknowledged ==. Nothing, PrintJobId <-. pjIds] [PrintJobAcknowledged =. Just now]
       addMessageI Success $ MsgPrintJobAcknowledge num
       reloadKeepGetParams PrintCenterR
-    (PJActReprintData, Set.toList -> pjIds) -> do
+    (PJActReprintData{ignoreReroute}, Set.toList -> pjIds) -> do
       let countOk = either (const $ Sum 0) (const $ Sum 1)          
-      oks <- runDB $ forM pjIds $ fmap countOk . reprintPDF
+      oks <- runDB $ forM pjIds $ fmap countOk . reprintPDF (fromMaybe False ignoreReroute)
       let nr_oks = getSum $ mconcat oks
           nr_tot = length pjIds
           mstat  = bool Warning Success $ nr_oks == nr_tot
       addMessageI mstat $ MsgPrintJobReprint nr_oks nr_tot
       reloadKeepGetParams PrintCenterR
-
+  siteConf <- getYesod  
+  let lprConf = siteConf ^. _appLprConf
+      reroute = siteConf ^. _appMailRerouteTo
+      lprWgt  = [whamlet|
+          LPR Konfiguration ist #{lprQueue lprConf}@#{lprHost lprConf}:#{lprPort lprConf}
+          <div>
+            $maybe _ <- reroute
+              Mail-reroute-to ist gesetzt, somit werden alle lpr Kommandos unterdrückt!          
+        |]
   siteLayoutMsg MsgMenuApc $ do
     setTitleI MsgMenuApc
     $(widgetFile "print-center") --  i18nWidgetFile? Currently no text contained; displays just the table only

src/Handler/Users.hs

@@ -359,11 +359,11 @@ postUsersR = do
       | Set.null usersSet && isNotSetSupervisor act ->
           addMessageI Info MsgActionNoUsersSelected          
     (UserLdapSyncData, userSet) -> do
-      runDBJobs . forM_ userSet $ \uid -> queueDBJob $ JobSynchroniseLdapUser uid
+      forM_ userSet $ \uid -> queueJob' $ JobSynchroniseLdapUser uid
       addMessageI Success . MsgSynchroniseLdapUserQueued $ Set.size userSet      
       redirectKeepGetParams UsersR
     (UserAvsSyncData, userSet) -> do
-      runDBJobs . forM_ userSet $ \uid -> queueDBJob $ JobSynchroniseAvsUser uid Nothing
+      forM_ userSet $ \uid -> queueJob' $ JobSynchroniseAvsUser uid Nothing
       addMessageI Success . MsgSynchroniseAvsUserQueued $ Set.size userSet      
       redirectKeepGetParams UsersR
     (UserHijack, Set.minView -> Just (uid, _)) ->

src/Jobs.hs

@@ -593,7 +593,7 @@ handleJobs' wNum = C.mapM_ $ \jctl -> hoist delimitInternalState . withJobWorker
       newReport@(healthReportStatus -> newStatus) <- lift $ generateHealthReport kind
 
       $logInfoS logIdent [st|#{tshow kind}: #{toPathPiece newStatus}|]
-      unless (newStatus == HealthSuccess) $ do
+      unless (newStatus > HealthFailure) $ do
         $logErrorS logIdent [st|#{tshow kind}: #{tshow newReport}|]
   
       liftIO $ do

src/Jobs/Handler/LMS.hs

@@ -298,7 +298,7 @@ dispatchJobLmsUserlist :: QualificationId -> JobHandler UniWorX
 dispatchJobLmsUserlist qid = JobHandlerAtomic act
   where
     act :: YesodJobDB UniWorX ()
-    act = do
+    act = whenM (exists [LmsUserlistQualification ==. qid]) $ do -- safeguard against multiple calls, which would close all learners due to first case below
       now <- liftIO getCurrentTime              
       -- result :: [(Entity LmsUser, Entity LmsUserlist)]
       results <- E.select $ do

src/Jobs/Handler/SynchroniseAvs.hs

@@ -12,9 +12,9 @@ module Jobs.Handler.SynchroniseAvs
 
 import Import
 
-import qualified Database.Esqueleto.Legacy as E hiding (upsert)
+-- import qualified Database.Esqueleto.Legacy as E hiding (upsert)
-import qualified Database.Esqueleto.PostgreSQL as E
+-- import qualified Database.Esqueleto.PostgreSQL as E
-import qualified Database.Esqueleto.Utils as E
+-- import qualified Database.Esqueleto.Utils as E
 
 import qualified Data.Conduit.List as C
 import Jobs.Queue
@@ -23,23 +23,23 @@ import Handler.Utils.Avs
 
 dispatchJobSynchroniseAvs :: Natural -> Natural -> Natural -> Maybe Day -> JobHandler UniWorX
 dispatchJobSynchroniseAvs numIterations epoch iteration pause  
-  -- TODO: refactor so that the AvsIdLookup becomes obsolete
+  = JobHandlerException . runDB $ do
-  = JobHandlerAtomic . runConduit $
+      now <- liftIO getCurrentTime
-      readUsers .| filterIteration .| sinkDBJobs
+      todos <- runConduit $ readUsers .| filterIteration now .| sinkList
+      putMany todos
   where
-    readUsers :: ConduitT () UserId (YesodJobDB UniWorX) ()
+    readUsers :: ConduitT () UserId _ ()
     readUsers = selectKeys [] []
 
-    filterIteration :: ConduitT UserId Job (YesodJobDB UniWorX) ()
+    filterIteration :: UTCTime -> ConduitT UserId AvsSync _ ()
-    filterIteration = C.mapMaybeM $ \userId -> runMaybeT $ do
+    filterIteration now = C.mapMaybeM $ \userId -> runMaybeT $ do
       let
         userIteration, currentIteration :: Integer
         userIteration = toInteger (hash epoch `hashWithSalt` userId) `mod` toInteger numIterations
         currentIteration = toInteger iteration `mod` toInteger numIterations
       --  $logDebugS "SynchronisAvs" [st|User ##{tshow (fromSqlKey userId)}: sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|]
       guard $ userIteration == currentIteration      
-      
+      return $ AvsSync userId now pause      
-      return $ JobSynchroniseAvsUser userId pause
 
 -- dispatchJobSynchroniseAvs' :: Natural -> Natural -> Natural -> Maybe Day -> JobHandler UniWorX
 -- dispatchJobSynchroniseAvs' numIterations epoch iteration pause = JobHandlerAtomic $ do 
@@ -47,32 +47,34 @@ dispatchJobSynchroniseAvs numIterations epoch iteration pause
 
 dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe Day -> JobHandler UniWorX
 dispatchJobSynchroniseAvsId apid pause = JobHandlerException $ do 
-  ok <- runDBJobs $
+  ok <- runDB $ getBy (UniqueUserAvsId apid) >>= 
-    getBy (UniqueUserAvsId apid) >>= \case
+    \case
       (Just Entity{entityVal=UserAvs{userAvsUser=uid}}) -> do -- known user 
         workJobSychronizeAvs uid pause
         return True
-      Nothing -> -- unknown avsPersonId, attempt to create user
+      _ -> -- unknown avsPersonId, attempt to create user
         return False
-  -- flip (maybeM $ return False) (getBy $ UniqueUserAvsId apid) $ \Entity{entityVal=UserAvs{userAvsUser=uid}} -> do -- known user 
-  --   workJobSychronizeAvs uid pause
-  --   return True
   unless ok $ void $ maybeCatchAll $ upsertAvsUserById apid
 
 
 dispatchJobSynchroniseAvsUser :: UserId -> Maybe Day -> JobHandler UniWorX
-dispatchJobSynchroniseAvsUser uid pause = JobHandlerException $ runDBJobs $ workJobSychronizeAvs uid pause
+dispatchJobSynchroniseAvsUser uid pause = JobHandlerException $ runDB $ workJobSychronizeAvs uid pause
 
-workJobSychronizeAvs :: UserId -> Maybe Day -> JobDB ()
+workJobSychronizeAvs :: UserId -> Maybe Day -> DB ()
 workJobSychronizeAvs uid pause = do
     now <- liftIO getCurrentTime
-    void $ E.upsert
+    -- void $ E.upsert
-      AvsSync { avsSyncUser         = uid
+    --   AvsSync { avsSyncUser         = uid
-              , avsSyncCreationTime = now
+    --           , avsSyncCreationTime = now
-              , avsSyncPause        = pause
+    --           , avsSyncPause        = pause
-              }
+    --           }
-      [ \oldSync -> (AvsSyncPause E.=. E.greatest (E.val pause) (oldSync E.^. AvsSyncPause)) oldSync ]
+    --   [ \oldSync -> (AvsSyncPause E.=. E.greatest (E.val pause) (oldSync E.^. AvsSyncPause)) oldSync ] -- causes Esqueleto to call undefined at Database.Esqueleto.Internal.Internal.renderUpdates:1308
-    queueDBJob JobSynchroniseAvsQueue
+    maybeM 
+      (insert_ AvsSync{avsSyncUser=uid, avsSyncCreationTime=now, avsSyncPause=pause})
+      (\Entity{entityKey=asid, entityVal=AvsSync{avsSyncPause=oldPause}} ->
+        update asid [AvsSyncPause =. max pause oldPause, AvsSyncCreationTime =. now])
+      (getBy $ UniqueAvsSyncUser uid)
+    queueJob' JobSynchroniseAvsQueue
 
 dispatchJobSynchroniseAvsQueue :: JobHandler UniWorX
 dispatchJobSynchroniseAvsQueue = JobHandlerException $ do

src/Jobs/Queue.hs

@@ -152,7 +152,7 @@ sinkDBJobs :: ConduitT Job Void (YesodJobDB UniWorX) ()
 sinkDBJobs = C.mapM_ queueDBJob
 
 runDBJobs :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => YesodJobDB UniWorX a -> m a
--- | Replacement for/Wrapper around `runDB` when jobs need to be queued as part of a database transaction
+-- | Blocking! Replacement for/Wrapper around `runDB` when jobs need to be queued as part of a database transaction
 --
 -- Jobs get immediately executed if the transaction succeeds
 runDBJobs act = do
@@ -161,7 +161,7 @@ runDBJobs act = do
   forM_ jIds $ flip runReaderT app . writeJobCtl . JobCtlPerform
   return ret
 
-
+-- | Blocking!
 runDBJobs' :: YesodJobDB UniWorX a -> DB a
 runDBJobs' act = do
   (ret, jIds) <- mapReaderT runWriterT act

src/Model/Types/Health.hs

@@ -27,6 +27,8 @@ instance Finite HealthCheck
 instance Hashable HealthCheck
 instance NFData HealthCheck
 
+-- embedRenderMessage ''UniWorX ''HealthCheck id -- not possible here
+
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 2
   } ''HealthCheck
@@ -66,9 +68,9 @@ classifyHealthReport HealthMatchingClusterConfig{} = HealthCheckMatchingClusterC
 classifyHealthReport HealthLDAPAdmins{}            = HealthCheckLDAPAdmins
 classifyHealthReport HealthHTTPReachable{}         = HealthCheckHTTPReachable
 classifyHealthReport HealthSMTPConnect{}           = HealthCheckSMTPConnect             
-classifyHealthReport HealthWidgetMemcached{}       = HealthCheckWidgetMemcached
+classifyHealthReport HealthWidgetMemcached{}       = HealthCheckWidgetMemcached         -- kein Neustart notwendig
 classifyHealthReport HealthActiveJobExecutors{}    = HealthCheckActiveJobExecutors      
-classifyHealthReport HealthDoesFlush{}             = HealthCheckDoesFlush
+classifyHealthReport HealthDoesFlush{}             = HealthCheckDoesFlush               -- evtl. kein Neustart notwendig
 
 -- | `HealthReport` classified (`classifyHealthReport`) by badness
 --
@@ -76,7 +78,7 @@ classifyHealthReport HealthDoesFlush{}             = HealthCheckDoesFlush
 --
 -- Currently all consumers of this type check for @(== HealthSuccess)@; this
 -- needs to be adjusted on a case-by-case basis if new constructors are added
-data HealthStatus = HealthFailure | HealthSuccess
+data HealthStatus = HealthFailure | HealthInactive | HealthSuccess
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
 
 instance Universe HealthStatus
@@ -87,17 +89,30 @@ deriveJSON defaultOptions
   } ''HealthStatus
 nullaryPathPiece ''HealthStatus $ camelToPathPiece' 1
 
+healthOk :: HealthStatus -> Bool
+healthOk HealthFailure  = False
+healthOk HealthInactive = True
+healthOk HealthSuccess  = True
+
 healthReportStatus :: HealthReport -> HealthStatus
 -- ^ Classify `HealthReport` by badness
 healthReportStatus = \case  
-  HealthMatchingClusterConfig       False  -> HealthFailure
+  HealthMatchingClusterConfig       True   -> HealthSuccess
-  HealthHTTPReachable         (Just False) -> HealthFailure
+  HealthHTTPReachable         (Just True ) -> HealthSuccess
+  HealthHTTPReachable         Nothing      -> HealthInactive
   HealthLDAPAdmins            (Just prop )
-    | prop <= 0                            -> HealthFailure
+    | prop > 0                             -> HealthSuccess
-  HealthSMTPConnect           (Just False) -> HealthFailure
+  HealthLDAPAdmins            Nothing      -> HealthInactive  
+  HealthSMTPConnect           (Just True ) -> HealthSuccess
+  HealthSMTPConnect           Nothing      -> HealthInactive
   HealthWidgetMemcached       (Just False) -> HealthFailure -- TODO: investigate this failure mode; do we just handle it gracefully?
+  HealthWidgetMemcached       (Just True ) -> HealthSuccess
+  HealthWidgetMemcached       Nothing      -> HealthInactive
+  HealthActiveJobExecutors    Nothing      -> HealthInactive
   HealthActiveJobExecutors    (Just prop )
-    | prop <= 0                            -> HealthFailure
+    | prop > 0                             -> HealthSuccess
-  HealthDoesFlush              mProp
+  HealthDoesFlush             Nothing      -> HealthInactive
-    | maybe True (>= 2) mProp              -> HealthFailure
+  HealthDoesFlush             (Just prop ) 
-  _other                                   -> maxBound -- Minimum badness
+    | prop >= 2                            -> HealthFailure 
+    | otherwise                            -> HealthSuccess
+  _other                                   -> HealthFailure

src/Utils/PathPiece.hs

@@ -9,6 +9,7 @@ module Utils.PathPiece
   , splitCamel, dropCamel
   , camelToPathPiece, camelToPathPiece', camelToPathPiece''
   , nameToPathPiece, nameToPathPiece'
+  , kebabToCamel
   , tuplePathPiece
   , pathPieceJSON, pathPieceJSONKey
   , pathPieceBinary
@@ -237,6 +238,11 @@ nameToPathPiece' dropN = camelToPathPiece' dropN . repack . nameBase
 nameToPathPiece :: Textual t => Name -> t
 nameToPathPiece = nameToPathPiece' 0
 
+-- | convert kebab-case to CamelCase
+kebabToCamel :: Text -> Text
+-- kebabToCamel = Text.filter (not . Char.isSpace) . Text.toTitle . Text.replace "-" " " -- eliminates all space
+kebabToCamel = mconcat . fmap Text.toTitle . Text.split ('-'==) -- preserves existing spaces
+
 
 tuplePathPiece :: Int -> DecQ
 tuplePathPiece tupleDim = do

src/Utils/Print.hs

@@ -278,12 +278,12 @@ printLetter' pji pdf = do
       insert_ PrintJob {..}
       return $ Right (ok, printJobFilename)
 
-reprintPDF :: PrintJobId -> DB (Either Text Text)
+reprintPDF :: Bool -> PrintJobId -> DB (Either Text Text)
-reprintPDF pjid = maybeM (return $ Left "Print job id is unknown.") reprint $ get pjid
+reprintPDF ignoreReroute pjid = maybeM (return $ Left "Print job id is unknown.") reprint $ get pjid
   where 
     reprint :: PrintJob -> DB (Either Text Text)
     reprint pj@PrintJob{..} = do 
-      result <- lprPDF printJobFilename $ LBS.fromStrict printJobFile
+      result <- lprPDF' ignoreReroute printJobFilename $ LBS.fromStrict printJobFile
       whenIsRight result $ const $ do 
         now <- liftIO getCurrentTime        
         insert_ pj{ printJobAcknowledged  = Nothing
@@ -460,26 +460,29 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read
 
 -- | Internal only, use `printLetter` instead
 lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => FilePath -> LBS.ByteString -> m (Either Text Text)
-lprPDF (sanitizeCmdArg' -> jb) bs = do
+lprPDF = lprPDF' False
-    mbLprServerArg <- getLprServerArg
+
-    case mbLprServerArg of
+lprPDF' :: (MonadHandler m, HasAppSettings (HandlerSite m)) => Bool -> FilePath -> LBS.ByteString -> m (Either Text Text)
-      Nothing -> return $ Right "Print command ignored due to setting 'mail-reroute-to' being set."
+lprPDF' ignoreReroute (sanitizeCmdArg' -> jb) bs = maybeM hdlFail hdlLpr getLprServerArg
-      Just lprServerArg -> do
-        let pc = setStdin (byteStringInput bs) $
-                  proc "lpr" $
-                    jobname ++                                      -- -J jobname -- a name for job identification at printing site
-                    [ lprServerArg                                  -- -P queue@hostname:port
-                    , "-"                                           -- read from stdin
-                    ]
-            jobname | null jb   = []
-                    | otherwise = ["-J " <> jb]            
-        exit2either <$> readProcess' pc
   where 
+    hdlFail = return $ Right "Print command ignored due to setting 'mail-reroute-to' being set."
+    
+    hdlLpr lprServerArg = do
+      let pc = setStdin (byteStringInput bs) $
+                proc "lpr" $
+                  jobname ++                                      -- -J jobname -- a name for job identification at printing site
+                  [ lprServerArg                                  -- -P queue@hostname:port
+                  , "-"                                           -- read from stdin
+                  ]
+          jobname | null jb   = []
+                  | otherwise = ["-J " <> jb]            
+      exit2either <$> readProcess' pc
+    
     getLprServerArg = do
       rerouteMail <- getsYesod $ view _appMailRerouteTo
-      case rerouteMail of
+      case (ignoreReroute, rerouteMail) of
-        Just _  -> return Nothing
+        (False, Just _) -> return Nothing
-        Nothing -> do
+        _ -> do
           LprConf{..} <- getsYesod $ view _appLprConf
           return . Just $ "-P " <> lprQueue <> "@" <> lprHost <> ":" <> show lprPort
 

templates/i18n/info-lecturer/de-de-formal.hamlet

@@ -285,9 +285,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
     <dt .deflist__dt> Ausbilder:innen
     <dd .deflist__dd>
       <p>
-        Ausbilder:innen werden ad hoc pro Kursgruppe festgelegt.
+        Ausbilder:innen werden ad hoc pro Kurs festgelegt.
         <br />
-        Eine Kursgruppe kann beliebig viele Ausbilder:innen haben und ein Ausbilder kann beliebig viele Kursegruppen betreuen.
+        Eine Kurs kann beliebig viele Ausbilder:innen haben und ein Ausbilder kann beliebig viele Kursegruppen betreuen.
 
       <p>
         Ausbilder:innen haben Zugriff auf die Namen und Studiendaten ihrer Kursteilnehmer:innen, können Mitteilungen an sie verschicken (analog zu Kursartmitteilungen) und Teilnehmer:innen aus ihrem Kurs entfernen.
@@ -307,16 +307,16 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
         <br />
         Eine vorherige Anmeldung zur Kursart ist Voraussetzung.
       <p>
-        Die Anmeldung kann pro Kursgruppe zeitlich beschränkt werden.
+        Die Anmeldung kann pro Kurs zeitlich beschränkt werden.
       <p>
-        Kursgruppen können mit einer <i>Registrierungs-Gruppe</i> versehen werden. 
+        Kurse können mit einer <i>Registrierungs-Gruppe</i> versehen werden. 
         Es handelt sich hierbei um einen beliebig wählbaren Text, der ansonsten keine Bedeutung hat.
         <br />
         Lernenden wird die Anmeldung nur in <i>einem Kurs pro Registrierungs-Gruppe</i> erlaubt.
 
         Leere Registrierungs-Gruppen (d.h. es wurde keine Registrierungs-Gruppe angegeben) zählen hierbei als verschieden.
       <p>
-        Um die Anmeldung in beliebig viele Kursgruppen zuzulassen können alle Registrierungs-Gruppen leer gelassen werden.
+        Um die Anmeldung in beliebig viele Kurse zuzulassen können alle Registrierungs-Gruppen leer gelassen werden.
     
     <dt .deflist__dt> ^{newFeat 2019 10 10} Nachmeldung
     <dt .deflist__dd>

templates/print-center.hamlet

@@ -7,3 +7,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 <section>
   <p> 
     ^{pjTable}
+
+<section>
+  ^{modal "APC Konfiguration" (Right lprWgt)}