Merge branch 'test' into oauth2

2024-03-19 22:51:37 +01:00 · 2024-03-19 22:51:37 +01:00 · 3119dff6fe
commit 3119dff6fe
parent 1dd83af6aa f7f3532b30
57 changed files with 889 additions and 429 deletions
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -2,6 +2,30 @@

 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.59](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.58...v27.4.59) (2024-02-13)
+
+
+### Bug Fixes
+
+* **sql:** remove potential bug in relation to missing parenthesis after not_ ([42695cf](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/42695cf5ef9f21691dc027f1ec97d57eec72f03e))
+
+## [27.4.58](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.57...v27.4.58) (2024-02-08)
+
+
+### Bug Fixes
+
+* **health:** negative interface routes working as intended now ([3303c4e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3303c4eebf928e527d2f9c1eb6e2495c10b94b13))
+* **lms:** previouly failed notifications will be sent again ([263894b](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/263894b05899ce55635d790f5334729fbc655ecc))
+
+## [27.4.57](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.56...v27.4.57) (2024-02-06)
+
+
+### Bug Fixes
+
+* **course:** fix [#147](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/147) abort addd participant aborts now ([d332c0c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d332c0c11afd8b1dfe1343659f0b1626c968bbde))
+* **health:** fix [#151](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/151) by offering route /health/interface/* ([c71814d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c71814d1ef1efc16c278136dfd6ebd86bd1d20db))
+* **health:** fix [#153](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/153) and offer interface health route matching ([ce3852e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ce3852e3d365e62b32d181d58b7cbcc749e49373))
+
 ## [27.4.56](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.55...v27.4.56) (2023-12-20)


--- a/messages/faq/de-de-formal.msg
+++ b/messages/faq/de-de-formal.msg
@ -1,11 +1,9 @@
-# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+# SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later

+FAQLoginExpired: Mein Passwort ist abgelaufen und muss erneuert werden
 FAQNoCampusAccount: Ich habe keine Fraport AG Kennung (Büko-Login); kann ich trotzdem Zugang zum System erhalten?
 FAQForgottenPassword: Ich habe mein Passwort vergessen
 FAQCampusCantLogin: Ich kann mich mit meiner Fraport AG Kennung (Büko-Login) nicht anmelden
-FAQCourseCorrectorsTutors: Wie kann ich Ausbilder oder Korrektoren für meine Kursart konfigurieren?
-FAQNotLecturerHowToCreateCourses: Wie kann ich eine neue Kursart anlegen?
-FAQExamPoints: Warum kann ich bei meiner Klausur keine Punkte eintragen?
-FAQInvalidCredentialsAdAccountDisabled: Ich kann mich nicht anmelden und bekomme die Meldung „Benutzereintrag gesperrt“
+FAQNotLecturerHowToCreateCourses: Wie kann ich eine neue Kursart anlegen?
--- a/messages/faq/en-eu.msg
+++ b/messages/faq/en-eu.msg
@ -1,11 +1,9 @@
-# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+# SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later

+FAQLoginExpired: My password expired
 FAQNoCampusAccount: I don't have Fraport AG credentials (Büko login); can I still get access?
 FAQForgottenPassword: I have forgotten my password
 FAQCampusCantLogin: I can't log in using my Fraport AG credentials (Büko login)
-FAQCourseCorrectorsTutors: How can I add instructors or correctors to my course?
-FAQNotLecturerHowToCreateCourses: How can I create new courses?
-FAQExamPoints: Why can't I enter achievements for my exam as points?
-FAQInvalidCredentialsAdAccountDisabled: I can't log in and am instead given the message “Account disabled”
+FAQNotLecturerHowToCreateCourses: How can I create new courses?
--- a/messages/uniworx/categories/admin/de-de-formal.msg
+++ b/messages/uniworx/categories/admin/de-de-formal.msg
@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+# SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later

@ -121,8 +121,15 @@ ProblemsAvsSynchHeading: Synchronisation AVS Fahrberechtigungen
 ProblemsAvsErrorHeading: Fehlermeldungen
 ProblemsInterfaceSince: Berücksichtigt werden nur Erfolge und Fehler seit 

+InterfacesOk: Schnittstellen sind ok.
+InterfacesFail n@Int: #{pluralDEeN n "Schnittstellenproblem"}!
+InterfaceStatus !ident-ok: Status
+InterfaceName: Schnittstelle
 InterfaceLastSynch: Zuletzt
 InterfaceSubtype: Betreffend
 InterfaceWrite: Schreibend

-AdminUserPassword: Passwort
+AdminUserPassword: Passwort
+InterfaceSuccess: Rückmeldung
+InterfaceInfo: Nachricht
+InterfaceFreshness: Prüfungszeitraum (h)
--- a/messages/uniworx/categories/admin/en-eu.msg
+++ b/messages/uniworx/categories/admin/en-eu.msg
@ -121,8 +121,15 @@ ProblemsAvsSynchHeading: Synchronisation AVS Driving Licences
 ProblemsAvsErrorHeading: Error Log
 ProblemsInterfaceSince: Only considering successes and errors since 

+InterfacesOk: Interfaces are ok.
+InterfacesFail n: #{pluralENsN n "interface problem"}!
+InterfaceStatus: Status
+InterfaceName: Interface
 InterfaceLastSynch: Last
 InterfaceSubtype: Affecting
 InterfaceWrite: Write

-AdminUserPassword: Password
+AdminUserPassword: Password
+InterfaceSuccess: Returned
+InterfaceInfo: Message
+InterfaceFreshness: Check hours
--- a/messages/uniworx/categories/courses/courses/de-de-formal.msg
+++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg
@ -95,7 +95,7 @@ CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} pe
 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 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 Kurs angemeldet
+CourseParticipantsRegisteredTutorial n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zum Kurs angemeldet
 CourseParticipantsRegisterConfirmationHeading: Teilnehmer:innen hinzufügen
 CourseParticipantsRegisterUnnecessary: Alle angeforderten Anmeldungen sind bereits vorhanden. Es wurden keine Änderungen vorgenommen.
 CourseParticipantsRegisterConfirmInvalid: Ungültiges Bestätigungsformular!
--- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg
+++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg
@ -23,6 +23,7 @@ MenuPayments: Zahlungsbedingungen

 MenuInstance: Instanz-Identifikation
 MenuHealth: Instanz-Zustand
+MenuHealthInterface: Schnittstellen Zustand
 MenuHelp: Hilfe
 MenuAccount: Konto
 MenuProfile: Anpassen
@ -146,6 +147,8 @@ MenuExternalUser: Externe Benutzer
 MenuApc: Druckerei
 MenuPrintSend: Manueller Briefversand
 MenuPrintDownload: Brief herunterladen
+MenuPrintLog: LPR Schnittstelle
+MenuPrintAck: Druckbestätigung

 MenuApiDocs: API-Dokumentation (Englisch)
 MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger)
--- a/messages/uniworx/utils/navigation/menu/en-eu.msg
+++ b/messages/uniworx/utils/navigation/menu/en-eu.msg
@ -23,6 +23,7 @@ MenuPayments: Payment Terms

 MenuInstance: Instance identification
 MenuHealth: Instance health
+MenuHealthInterface: Interface health
 MenuHelp: Support
 MenuAccount: Account
 MenuProfile: Settings
@ -146,6 +147,8 @@ MenuExternalUser: External users
 MenuApc: Printing
 MenuPrintSend: Send Letter
 MenuPrintDownload: Download Letter
+MenuPrintLog: LPR Interface
+MenuPrintAck: Acknowledge Printing

 MenuApiDocs: API documentation
 MenuSwagger: OpenAPI 2.0 (Swagger)
--- a/models/audit.model
+++ b/models/audit.model
@ -14,9 +14,18 @@ TransactionLog
 InterfaceLog  
  interface Text
  subtype   Text
-  write     Bool        -- requestMethod /= GET, i.e. True implies a write to FRADrive
+  write     Bool                  -- requestMethod /= GET, i.e. True implies a write to FRADrive
  time      UTCTime
-  rows      Int Maybe   -- number of datasets transmitted  
-  info      Text        -- addtional status information  
+  rows      Int Maybe             -- number of datasets transmitted  
+  info      Text                  -- addtional status information
+  success   Bool default=true     -- false logs a failure; but it will be overwritten by next transaction, but logged in TransactionLog
  UniqueInterfaceSubtypeWrite interface subtype write
-  deriving Eq Read Show Generic
+  deriving Eq Read Show Generic
+
+InterfaceHealth
+  interface Text
+  subtype   Text Maybe
+  write     Bool Maybe
+  hours     Int  
+  UniqueInterfaceHealth interface subtype write !force -- Note that nullable fields must be either empty or unique
+  deriving Eq Read Show Generic
--- a/models/lms.model
+++ b/models/lms.model
@ -20,7 +20,7 @@ Qualification
  SchoolQualificationShort school shorthand            -- must be unique per school and shorthand
  SchoolQualificationName  school name                 -- must be unique per school and name
  -- across all schools, only one qualification may be a driving licence:
-  UniqueQualificationAvsLicence avsLicence      !force
+  UniqueQualificationAvsLicence avsLicence      !force -- either empty or unique
    -- NOTE: two NULL values are not equal for the purpose of Uniqueness constraints!
  deriving Eq Generic

@ -40,21 +40,22 @@ Qualification
 --  - PinReset==1 mit bestehendem Passwort kann problemlos erneut gesendet werden
 --  - Flag "interner Mitarbeiter" wird von Know-How ignoriert / nicht ausgewertet (legacy)

-QualificationPrecondition                       -- NOTE: this can only be enforced through a background job adding or removing qualifications
-  qualification     QualificationId OnDeleteCascade OnUpdateCascade -- AND: not unique, ie. qualification can have multiple required preconditions
-  required          [QualificationId]           -- OR : alternatives, any one will suffice
-  continuous        Bool                        -- expiring precondition blocks qualification
-  deriving Generic
+-- QualificationPrecondition                       -- NOTE: this can only be enforced through a background job adding or removing qualifications
+--   qualification     QualificationId OnDeleteCascade OnUpdateCascade -- AND: not unique, ie. qualification can have multiple required preconditions
+--   required          [QualificationId]           -- OR : alternatives, any one will suffice
+--   continuous        Bool                        -- expiring precondition blocks qualification
+--   deriving Generic

 -- Maybe an alternative for online qualification validity checking, transitivity through recursive CTEs? (already available in our version)
-- QualificationRequirement
+--QualificationRequirement
 --   qualification     QualificationId OnDeleteCascade OnUpdateCascade
 --   requirement       QualificationId OnDeleteCascade OnUpdateCascade
 --   group             Text -- OR: several requirements within the same group are considered equivalent
 --   UniqueQualificationRequirement qualification requirement
+--   deriving Generic
 --

-- TODO: connect Qualification with Exams!
+-- TODO: connect Qualifications with Exams!?

 QualificationEdit
  user            UserId
@ -81,6 +82,7 @@ QualificationUserBlock
  from              UTCTime  
  reason            Text  
  blocker           UserId Maybe
+  -- precondition      Bool  default=false  -- if true, this was due to a precondition
  deriving Eq Ord Read Show Generic

  -- LMS Interface Tables, need regular processing by background jobs, per QualificationId:
--- a/nix/docker/version.json
+++ b/nix/docker/version.json
@ -1,3 +1,3 @@
 {
-  "version": "27.4.56"
+  "version": "27.4.59"
 }
--- a/package-lock.json
+++ b/package-lock.json
@ -1,6 +1,6 @@
 {
  "name": "uni2work",
-  "version": "27.4.56",
+  "version": "27.4.59",
  "lockfileVersion": 1,
  "requires": true,
  "dependencies": {
--- a/package.json
+++ b/package.json
@ -1,6 +1,6 @@
 {
  "name": "uni2work",
-  "version": "27.4.56",
+  "version": "27.4.59",
  "description": "",
  "keywords": [],
  "author": "",
--- a/package.yaml
+++ b/package.yaml
@ -1,5 +1,5 @@
 name: uniworx
-version: 27.4.56
+version: 27.4.59
 dependencies:
  - base
  - yesod
--- a/32
+++ b/32
@ -82,24 +82,26 @@

 /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/direct             PrintAckDirectR GET POST  !system-printer
 /print/send                           PrintSendR      GET POST
 /print/download/#CryptoUUIDPrintJob   PrintDownloadR  GET       !system-printer
+/print/log                            PrintLogR       GET       !system-printer

-/health                       HealthR          GET              !free
-/instance                     InstanceR        GET              !free
-/info                         InfoR            GET              !free
-/info/lecturer                InfoLecturerR    GET              !free
-/info/supervisor              InfoSupervisorR  GET              !free
-/info/legal                   LegalR           GET              !free
-/info/glossary                GlossaryR        GET              !free
-/info/faq                     FaqR             GET              !free
-/info/terms-of-use            TermsOfUseR      GET              !free
-/info/payments                PaymentsR        GET              !free
-/imprint                      ImprintR         GET              !free
-/data-protection              DataProtectionR  GET              !free
-/version                      VersionR         GET              !free
-/status                       StatusR          GET              !free
+/health                       HealthR           GET             !free
+/health/interface/+Texts      HealthInterfaceR  GET             !free
+/instance                     InstanceR         GET             !free
+/info                         InfoR             GET             !free
+/info/lecturer                InfoLecturerR     GET             !free
+/info/supervisor              InfoSupervisorR   GET             !free
+/info/legal                   LegalR            GET             !free
+/info/glossary                GlossaryR         GET             !free
+/info/faq                     FaqR              GET             !free
+/info/terms-of-use            TermsOfUseR       GET             !free
+/info/payments                PaymentsR         GET             !free
+/imprint                      ImprintR          GET             !free
+/data-protection              DataProtectionR   GET             !free
+/version                      VersionR          GET             !free
+/status                       StatusR           GET             !free

 /help                         HelpR            GET POST         !free

--- a/src/Application.hs
+++ b/src/Application.hs
@ -148,6 +148,7 @@ import Handler.Material
 import Handler.CryptoIDDispatch
 import Handler.SystemMessage
 import Handler.Health
+import Handler.Health.Interface
 import Handler.Exam
 import Handler.ExamOffice
 import Handler.Metrics
--- a/src/Audit.hs
+++ b/src/Audit.hs
@ -8,7 +8,7 @@ module Audit
  , audit
  , AuditRemoteException(..)
  , getRemote
-  , logInterface
+  , logInterface, logInterface'
  ) where


@ -123,19 +123,49 @@ logInterface :: ( AuthId (HandlerSite m) ~ Key User
         )
      => Text       -- ^ Interface that is used
      -> Text       -- ^ Subtype of the interface, if any
+      -> Bool       -- ^ Success=True, Failure=False
      -> Maybe Int  -- ^ Number of transmitted datasets
      -> Text       -- ^ Any additional information
      -> ReaderT (YesodPersistBackend (HandlerSite m)) m ()
 -- ^ Log a transaction using information available from `HandlerT`, also calls `audit`
-logInterface interfaceLogInterface interfaceLogSubtype interfaceLogRows interfaceLogInfo = do
-  interfaceLogTime  <- liftIO getCurrentTime
+logInterface interfaceLogInterface interfaceLogSubtype interfaceLogSuccess interfaceLogRows interfaceLogInfo = do 
  interfaceLogWrite <- (methodGet /=) . Wai.requestMethod . reqWaiRequest <$> getRequest
-  deleteBy $ UniqueInterfaceSubtypeWrite interfaceLogInterface interfaceLogSubtype interfaceLogWrite -- always replace, deleteBy & insert seems to be safest and fastest
-  insert_ InterfaceLog{..}
+  logInterface' interfaceLogInterface interfaceLogSubtype interfaceLogWrite interfaceLogSuccess interfaceLogRows interfaceLogInfo
+
+logInterface' :: ( AuthId (HandlerSite m) ~ Key User
+         , IsSqlBackend (YesodPersistBackend (HandlerSite m))
+         , SqlBackendCanWrite (YesodPersistBackend (HandlerSite m))
+         , HasInstanceID (HandlerSite m) InstanceId
+         , YesodAuthPersist (HandlerSite m)
+         , MonadHandler m
+         , MonadCatch m
+         , HasAppSettings (HandlerSite m)
+         , HasCallStack
+         )
+      => Text       -- ^ Interface that is used
+      -> Text       -- ^ Subtype of the interface, if any
+      -> Bool       -- ^ True indicates Write Access to FRADrive
+      -> Bool       -- ^ Success=True, Failure=False
+      -> Maybe Int  -- ^ Number of transmitted datasets
+      -> Text       -- ^ Any additional information
+      -> ReaderT (YesodPersistBackend (HandlerSite m)) m ()
+-- ^ Log a transaction using information available from `HandlerT`, also calls `audit`
+logInterface' (Text.strip -> interfaceLogInterface) (Text.strip -> interfaceLogSubtype) interfaceLogWrite interfaceLogSuccess interfaceLogRows (Text.strip -> interfaceLogInfo) = do
+  interfaceLogTime  <- liftIO getCurrentTime
+  -- deleteBy $ UniqueInterfaceSubtypeWrite interfaceLogInterface interfaceLogSubtype interfaceLogWrite -- always replace: deleteBy & insert seems to be safest and fastest
+  -- insert_ InterfaceLog{..}
+  void $ upsertBy (UniqueInterfaceSubtypeWrite interfaceLogInterface interfaceLogSubtype interfaceLogWrite)
+    ( InterfaceLog{..} )
+    [ InterfaceLogTime    =. interfaceLogTime
+    , InterfaceLogRows    =. interfaceLogRows
+    , InterfaceLogInfo    =. interfaceLogInfo
+    , InterfaceLogSuccess =. interfaceLogSuccess
+    ]
  audit TransactionInterface
    { transactionInterfaceName    = interfaceLogInterface
    , transactionInterfaceSubtype = interfaceLogSubtype
    , transactionInterfaceWrite   = interfaceLogWrite
    , transactionInterfaceRows    = interfaceLogRows
    , transactionInterfaceInfo    = interfaceLogInfo
+    , transactionInterfaceSuccess = Just interfaceLogSuccess
    }
--- a/src/Audit/Types.hs
+++ b/src/Audit/Types.hs
@ -240,6 +240,7 @@ data Transaction
    , transactionInterfaceWrite               :: Bool                 -- True implies a write to FRADrive
    , transactionInterfaceRows                :: Maybe Int
    , transactionInterfaceInfo                :: Text
+    , transactionInterfaceSuccess             :: Maybe Bool            -- Just False implies a failure; Maybe used to achieve backwards compatibility
    }
  deriving (Eq, Ord, Read, Show, Generic)

--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -17,6 +17,7 @@ module Database.Esqueleto.Utils
  , (>~.), (<~.)
  , or, and
  , any, all
+  , not__, parens
  , subSelectAnd, subSelectOr
  , mkExactFilter, mkExactFilterWith, mkExactFilterWithComma
  , mkExactFilterLast, mkExactFilterLastWith
@ -252,6 +253,9 @@ subSelectOr  q = parens . E.subSelectUnsafe $ flip (E.unsafeSqlAggregateFunction
 parens :: E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value a)
 parens = E.unsafeSqlFunction ""

+-- | Workaround for Esqueleto-Bug not placing parenthesis after NOT, see #155
+not__ :: E.SqlExpr (E.Value Bool) -> E.SqlExpr (E.Value Bool)
+not__ = E.not_ . parens

 -- Allow usage of Tuples as DbtRowKey, i.e. SqlIn instances for tuples
 $(sqlInTuples [2..16])
@ -705,7 +709,6 @@ interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text
    singleQuote     = Text.Builder.singleton '\''
    wrapSqlString b = singleQuote <> b <> singleQuote

-
 infixl 6 `diffDays`, `diffTimes`

 diffDays :: E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Int)
--- a/src/Foundation/Navigation.hs
+++ b/src/Foundation/Navigation.hs
@ -129,13 +129,14 @@ breadcrumb FirmAllR         = i18nCrumb MsgMenuFirms              Nothing
 breadcrumb FirmsCommR{}     = i18nCrumb MsgMenuFirmsComm        $ Just   FirmAllR
 breadcrumb FirmUsersR{}     = i18nCrumb MsgMenuFirmUsers        $ Just   FirmAllR
 breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors  $ Just $ FirmUsersR fsh
-breadcrumb (FirmCommR   fsh)= i18nCrumb MsgMenuFirmsComm        $ Just $ FirmUsersR fsh                       
+breadcrumb (FirmCommR   fsh)= i18nCrumb MsgMenuFirmsComm        $ Just $ FirmUsersR fsh

 breadcrumb PrintCenterR     = i18nCrumb MsgMenuApc              Nothing
 breadcrumb PrintSendR       = i18nCrumb MsgMenuPrintSend      $ Just PrintCenterR
 breadcrumb PrintDownloadR{} = i18nCrumb MsgMenuPrintDownload  $ Just PrintCenterR
 breadcrumb PrintAckR{}      = i18nCrumb MsgMenuPrintSend      $ Just PrintCenterR -- never displayed
-breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintSend      $ Just PrintCenterR -- never displayed
+breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintAck       $ Just PrintCenterR
+breadcrumb PrintLogR        = i18nCrumb MsgMenuPrintLog       $ Just PrintCenterR

 breadcrumb SchoolListR      = i18nCrumb MsgMenuSchoolList       $ Just AdminR
 breadcrumb (SchoolR ssh sRoute) = case sRoute of
@ -166,9 +167,10 @@ breadcrumb FaqR             = i18nCrumb MsgBreadcrumbFaq            $ Just InfoR
 breadcrumb HelpR            = i18nCrumb MsgMenuHelp            Nothing


-breadcrumb HealthR          = i18nCrumb MsgMenuHealth          Nothing
-breadcrumb InstanceR        = i18nCrumb MsgMenuInstance        Nothing
-breadcrumb StatusR          = i18nCrumb MsgMenuHealth          Nothing  -- never displayed
+breadcrumb HealthR              = i18nCrumb MsgMenuHealth          Nothing
+breadcrumb (HealthInterfaceR _) = i18nCrumb MsgMenuHealthInterface (Just HealthR)
+breadcrumb InstanceR            = i18nCrumb MsgMenuInstance        Nothing
+breadcrumb StatusR              = i18nCrumb MsgMenuHealth          Nothing  -- never displayed

 breadcrumb  QualificationAllR                       = i18nCrumb MsgMenuQualifications Nothing
 breadcrumb (QualificationSchoolR          ssh     ) = useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool . Just $ SchoolListR) $ do -- redirect only, used in other breadcrumbs
@ -193,7 +195,7 @@ breadcrumb (LmsLearnersDirectR  ssh  qsh) = i18nCrumb MsgMenuLmsLearners   $ Jus
 breadcrumb (LmsReportR          ssh  qsh) = i18nCrumb MsgMenuLmsReport     $ Just $ LmsR          ssh qsh
 breadcrumb (LmsReportUploadR    ssh  qsh) = i18nCrumb MsgMenuLmsUpload     $ Just $ LmsReportR    ssh qsh
 breadcrumb (LmsReportDirectR    ssh  qsh) = i18nCrumb MsgMenuLmsUpload     $ Just $ LmsReportR    ssh qsh -- never displayed
-- 
+--
 breadcrumb (LmsIdentR           ssh  qsh _ ) = breadcrumb $ LmsR ssh qsh -- just a redirect
 breadcrumb (LmsUserR            ssh _qsh u ) = i18nCrumb MsgMenuLmsUser       $ Just $ LmsUserSchoolR u ssh
 breadcrumb (LmsUserSchoolR    u _          ) = i18nCrumb MsgMenuLmsUserSchool $ Just $ LmsUserAllR u
@ -294,7 +296,7 @@ breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
  TUsersR  -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do
    guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR
    return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR)
-  TAddUserR   -> i18nCrumb MsgMenuTutorialAddMembers      . Just $ CTutorialR tid ssh csh tutn TUsersR 
+  TAddUserR   -> i18nCrumb MsgMenuTutorialAddMembers      . Just $ CTutorialR tid ssh csh tutn TUsersR
  TEditR      -> i18nCrumb MsgMenuTutorialEdit            . Just $ CTutorialR tid ssh csh tutn TUsersR
  TDeleteR    -> i18nCrumb MsgMenuTutorialDelete          . Just $ CTutorialR tid ssh csh tutn TUsersR
  TCommR      -> i18nCrumb MsgMenuTutorialComm            . Just $ CTutorialR tid ssh csh tutn TUsersR
@ -1330,6 +1332,17 @@ pageActions HealthR = return
      }
    , navChildren = []
    }
+  , NavPageActionPrimary
+    { navLink = NavLink
+      { navLabel       = MsgMenuHealthInterface
+      , navRoute       = HealthInterfaceR []
+      , navAccess'     = NavAccessTrue
+      , navType        = NavTypeLink { navModal = False }
+      , navQuick'      = mempty
+      , navForceActive = False
+      }
+    , navChildren = []
+    }
  ]
 pageActions InstanceR = return
  [ NavPageActionPrimary
@ -2364,7 +2377,7 @@ pageActions (LmsR sid qsh) = return
        [ defNavLink MsgMenuLmsUpload       $ LmsReportUploadR sid qsh
        , defNavLink MsgMenuLmsDirectUpload $ LmsReportDirectR sid qsh
        ]
-    }  
+    }
  , NavPageActionSecondary {
      navLink = defNavLink MsgMenuLmsEdit $ LmsEditR sid qsh
    }
@ -2389,7 +2402,7 @@ pageActions (FirmUsersR fsh) = return
  [ NavPageActionPrimary
    { navLink = defNavLink MsgTableCompanyNrSupers $ FirmSupersR fsh
    , navChildren = []
-    }  
+    }
  ]
 pageActions (FirmSupersR fsh) = return
  [ NavPageActionPrimary
@ -2432,10 +2445,30 @@ pageActions PrintCenterR = do
                      , navForceActive = False
                      }
                    }
+      printLog = NavPageActionSecondary
+                    { navLink = NavLink
+                      { navLabel       = MsgMenuPrintLog
+                      , navRoute       = PrintLogR
+                      , navAccess'     = NavAccessTrue
+                      , navType        = NavTypeLink { navModal = False }
+                      , navQuick'      = mempty
+                      , navForceActive = False
+                      }
+                    }
+      printAck = NavPageActionSecondary
+                    { navLink = NavLink
+                      { navLabel       = MsgMenuPrintAck
+                      , navRoute       = PrintAckDirectR
+                      , navAccess'     = NavAccessTrue
+                      , navType        = NavTypeLink { navModal = False }
+                      , navQuick'      = mempty
+                      , navForceActive = False
+                      }
+                    }
  dayLinks <- mapM toDayAck $ Map.toAscList dayMap
-  return $ manualSend : take 9 dayLinks
+  return $ manualSend : printLog : printAck : take 9 dayLinks

-pageActions AdminCrontabR = return 
+pageActions AdminCrontabR = return
  [ NavPageActionPrimary
    { navLink = defNavLink MsgMenuAdminJobs AdminJobsR
    , navChildren = []
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@ -24,6 +24,7 @@ import qualified Database.Esqueleto.Utils as E
 import Handler.Utils
 import Handler.Utils.Avs
 import Handler.Utils.Users
+import Handler.Health.Interface

 import Handler.Admin.Test as Handler.Admin
 import Handler.Admin.ErrorMessage as Handler.Admin
@ -54,13 +55,15 @@ getAdminProblemsR = do
      flagNonZero n | n <= 0    = flagError True
                    | otherwise = messageTooltip =<< handlerToWidget (messageI Error (MsgProblemsDriverSynch n))                                    

-  (usersAreReachable, driversHaveAvsIds, rDriversHaveFs, noStalePrintJobs, noBadAPCids, interfaceTable) <- runDB $ (,,,,,) 
+  (usersAreReachable, driversHaveAvsIds, rDriversHaveFs, noStalePrintJobs, noBadAPCids, (interfaceOks, interfaceTable)) <- runDB $ (,,,,,) 
      <$> areAllUsersReachable 
      <*> allDriversHaveAvsId now
      <*> allRDriversHaveFs now
      <*> (not <$> exists [PrintJobAcknowledged ==. Nothing, PrintJobCreated  <. cutOffOldTime])
      <*> (not <$> exists [PrintAcknowledgeProcessed ==. False])      
-      <*> fmap (view _2) (mkInterfaceLogTable flagError cutOffOldTime)
+      <*>  mkInterfaceLogTable flagError mempty
+  let interfacesBadNr = length $ filter (not . snd) interfaceOks
+      -- interfacesOk = all snd interfaceOks      
  diffLics <- try retrieveDifferingLicences >>= \case
    -- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received"
    (Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException)
@ -235,76 +238,3 @@ retrieveDriversRWithoutF now = do
  E.where_ $ E.exists (hasValidQual AvsLicenceRollfeld)
    E.&&. E.notExists (hasValidQual AvsLicenceVorfeld)
  return usr
-
-
-
-
-
-mkInterfaceLogTable :: (Bool -> Widget) -> UTCTime -> DB (Any, Widget)
-mkInterfaceLogTable flagError cutOffOldTime = do
-  avsSynchStats <- E.select $ do
-    uavs <- E.from $ E.table @UserAvs
-    E.where_ $ uavs E.^. UserAvsLastSynch E.>. E.val cutOffOldTime
-    let isOk = E.isNothing (uavs E.^. UserAvsLastSynchError)
-    E.groupBy isOk
-    E.orderBy [E.descNullsLast isOk]
-    return (isOk, E.countRows, E.max_ $ uavs E.^. UserAvsLastSynch)
-  let 
-    mkBadInfo badRows (fromMaybe cutOffOldTime -> badTime) | badRows > 0 = do
-      fmtCut <- formatTime SelFormatDate cutOffOldTime
-      fmtBad <- formatTime SelFormatDateTime badTime
-      return $ tshow badRows <> " Fehler seit " <> fmtCut <> ", zuletzt um " <> fmtBad
-    mkBadInfo _ _ = return mempty
-    writeAvsSynchStats okRows (fromMaybe cutOffOldTime -> okTime) badInfo = 
-      void $ upsertBy (UniqueInterfaceSubtypeWrite "AVS" "Synch" True)
-        (InterfaceLog "AVS" "Synch" True okTime okRows badInfo)
-        [InterfaceLogTime =. okTime, InterfaceLogRows =. okRows, InterfaceLogInfo =. badInfo]
-  --case $(unValueN 3) <$> avsSynchStats of  
-  case avsSynchStats of 
-    ((E.Value True , E.Value okRows, E.Value okTime):(E.Value False, E.Value badRows, E.Value badTime):_) ->
-      writeAvsSynchStats (Just okRows) okTime =<< mkBadInfo badRows badTime
-    ((E.Value True , E.Value okRows, E.Value okTime):_)    ->
-      writeAvsSynchStats (Just okRows) okTime mempty
-    ((E.Value False, E.Value badRows, E.Value badTime):_) -> do
-      lastOk <- userAvsLastSynch . entityVal <<$>> selectFirst [UserAvsLastSynchError ==. Nothing] [Desc UserAvsLastSynch]
-      writeAvsSynchStats Nothing lastOk =<< mkBadInfo badRows badTime
-    _ -> return ()
-  
-  let
-    flagOld       = flagError . (cutOffOldTime <)
-    resultDBTable = DBTable{..}
-      where
-        resultILog :: Lens' (DBRow (Entity InterfaceLog)) InterfaceLog
-        resultILog = _dbrOutput . _entityVal
-        dbtSQLQuery = return
-        dbtRowKey = (E.^. InterfaceLogId)
-        dbtProj = dbtProjId
-        dbtColonnade = dbColonnade $ mconcat
-          [ sortable Nothing            (textCell "Status"              ) $ wgtCell . flagOld . view (resultILog . _interfaceLogTime)
-          , sortable (Just "interface") (textCell "Interface"           ) $ \(view (resultILog . _interfaceLogInterface) -> n) -> textCell n
-          , sortable (Just "subtype")   (i18nCell MsgInterfaceSubtype   ) $ textCell . view (resultILog . _interfaceLogSubtype)
-          , sortable (Just "write")     (i18nCell MsgInterfaceWrite     ) $ (`ifIconCell` IconEdit) . view (resultILog . _interfaceLogWrite)
-          , sortable (Just "time")      (i18nCell MsgInterfaceLastSynch ) $ dateTimeCell . view (resultILog . _interfaceLogTime)
-          , sortable (Just "rows")      (i18nCell MsgTableRows          ) $ cellMaybe numCell . view (resultILog . _interfaceLogRows)                              
-          , sortable Nothing            (textCell "Info"                ) $ \(view resultILog -> ilt) -> case ilt of
-              InterfaceLog "AVS" "Synch" True _ _ i -> anchorCell ProblemAvsErrorR $ toWgt i
-              InterfaceLog _     _       _    _ _ i -> textCell i 
-          ]
-        dbtSorting = mconcat
-          [ singletonMap "interface" $ SortColumn (E.^. InterfaceLogInterface)
-          , singletonMap "subtype"   $ SortColumn (E.^. InterfaceLogSubtype)
-          , singletonMap "write"     $ SortColumn (E.^. InterfaceLogWrite)
-          , singletonMap "time"      $ SortColumn (E.^. InterfaceLogTime)
-          , singletonMap "rows"      $ SortColumn (E.^. InterfaceLogRows)          
-          ]
-        dbtFilter     = mempty
-        dbtFilterUI   = mempty
-        dbtStyle      = def
-        dbtIdent      = "interface-log" :: Text
-        dbtParams     = def
-        dbtCsvEncode  = noCsvEncode
-        dbtCsvDecode  = Nothing
-        dbtExtraReps  = []
-    resultDBTableValidator = def
-      & defaultSorting [SortAscBy "interface", SortAscBy "subtype", SortAscBy "write"]
-  dbTable resultDBTableValidator resultDBTable
--- a/src/Handler/Course/Edit.hs
+++ b/src/Handler/Course/Edit.hs
@ -279,8 +279,8 @@ getCourseNewR = do
                    , E.desc $ courseCreated course]                                     -- most recent created course
          E.limit 1
          return course
-      template <- case listToMaybe oldCourses of
-        (Just oldTemplate) ->
+      template <- case oldCourses of
+        (oldTemplate:_) ->
            let newTemplate = courseToForm oldTemplate mempty mempty in
            return $ Just $ newTemplate
                { cfCourseId   = Nothing
@ -289,7 +289,7 @@ getCourseNewR = do
                , cfRegTo      = Nothing
                , cfDeRegUntil = Nothing
                }
-        Nothing -> do
+        [] -> do
            (tidOk,sshOk,cshOk) <- runDB $ (,,)
                <$> ifMaybeM mbTid True existsKey
                <*> ifMaybeM mbSsh True existsKey
--- a/src/Handler/Course/List.hs
+++ b/src/Handler/Course/List.hs
@ -226,7 +226,16 @@ getCourseListR = do
        ]
      validator = def
        & defaultSorting [SortDescBy "term",SortAscBy "course"]
-  coursesTable <- runDB $ makeCourseTable colonnade validator
+  now <- liftIO getCurrentTime
+  coursesTable <- runDB $ do
+    activeTs <- selectList [TermActiveFrom <=. now
+                , FilterOr [TermActiveTo >. Just now, TermActiveTo ==. Nothing]
+                , FilterOr [TermActiveFor ==. muid, TermActiveFor ==. Nothing]   -- TermActiveFor <-. [Nothing, muid] did not work as intended
+                ] [Desc TermActiveTerm]
+    let addTermFilter = if null activeTs 
+          then id
+          else defaultFilter $ singletonMap "term" [toPathPiece termActiveTerm | Entity _ TermActive{termActiveTerm} <- activeTs]
+    makeCourseTable colonnade (validator & addTermFilter)
  defaultLayout $ do
    setTitleI MsgCourseListTitle
    $(widgetFile "courses")
--- a/src/Handler/Course/ParticipantInvite.hs
+++ b/src/Handler/Course/ParticipantInvite.hs
@ -192,26 +192,37 @@ handleAddUserR tid ssh csh tdesc ttyp = do

  currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute

-  confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction
-  --   $logDebugS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs
-  unless (Set.null confirmedActs) $ do -- TODO: check that all acts are member of availableActs
-    let
-      users = Map.fromList . fmap (\act -> (crActIdent act, Just . view _1 $ crActUser act)) $ Set.toList confirmedActs
-      tutActs = Set.filter (is _CourseRegisterActionAddTutorialMemberData) confirmedActs
-      actTutorial = crActTutorial <$> Set.lookupMin tutActs -- tutorial ident must be the same for every added member!      
-    registeredUsers <- registerUsers cid users
-    whenIsJust actTutorial $ \(tutName,tutType,tutDay) -> do
-      whenIsJust (tutName <|> fmap (tutorialDefaultName tutType) tutDay) $ \tName -> do
-        tutId <- upsertNewTutorial cid tName tutType tutDay
-        registerTutorialMembers tutId registeredUsers
-        -- when (Set.size tutActs == Set.size confirmedActs) $ -- not sure how this condition might be false at this point
-        redirect $ CTutorialR tid ssh csh tName TUsersR
-    redirect $ CourseR tid ssh csh CUsersR
+  (_ , registerConfirmResult) <- runButtonForm FIDCourseRegisterConfirm    
+  --   $logDebugS "***AbortProblem***" $ tshow registerConfirmResult
+  prefillUsers <- case registerConfirmResult of 
+    Nothing -> return mempty
+    (Just BtnCourseRegisterAbort)   -> do 
+      addMessageI Warning MsgAborted
+      -- prefill confirmed users for convenience. Note that Browser-Back may also return to the filled form, but history.back() does not in Chrome
+      confirmedActs :: [CourseRegisterActionData] <- exceptT (const $ return mempty) return . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction  -- ignore any exception, since it is only used to prefill a form field for convenience
+      return $ Just $ Set.fromList $ fmap crActIdent confirmedActs
+    (Just BtnCourseRegisterConfirm) -> do
+      confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction  
+      --   $logDebugS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs
+      unless (Set.null confirmedActs) $ do -- TODO: check that all acts are member of availableActs
+        let
+          users = Map.fromList . fmap (\act -> (crActIdent act, Just . view _1 $ crActUser act)) $ Set.toList confirmedActs
+          tutActs = Set.filter (is _CourseRegisterActionAddTutorialMemberData) confirmedActs
+          actTutorial = crActTutorial <$> Set.lookupMin tutActs -- tutorial ident must be the same for every added member!      
+        registeredUsers <- registerUsers cid users
+        whenIsJust actTutorial $ \(tutName,tutType,tutDay) -> do
+          whenIsJust (tutName <|> fmap (tutorialDefaultName tutType) tutDay) $ \tName -> do
+            tutId <- upsertNewTutorial cid tName tutType tutDay
+            registerTutorialMembers tutId registeredUsers
+            -- when (Set.size tutActs == Set.size confirmedActs) $ -- not sure how this condition might be false at this point
+            redirect $ CTutorialR tid ssh csh tName TUsersR
+        redirect $ CourseR tid ssh csh CUsersR
+      return mempty
  
-  ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
+  ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . identifyForm FIDCourseRegister . renderWForm FormStandard $ do
    let tutTypesMsg   = [(SomeMessage tt,tt) | tt <- tutTypes]
        tutDefType    = ttyp >>= (\ty -> if ty `elem` tutTypes then Just ty else Nothing)        
-    auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
+    auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) prefillUsers
    auReqTutorial <- optionalActionW
      ( (,,) 
        <$> aopt  (textField & cfStrip & cfCI & addDatalist tutNameSuggestions)
--- a/src/Handler/Health/Interface.hs
+++ b/src/Handler/Health/Interface.hs
@ -0,0 +1,251 @@
+-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
+--
+-- SPDX-License-Identifier: AGPL-3.0-or-later
+
+
+module Handler.Health.Interface
+  (
+    getHealthInterfaceR
+  , mkInterfaceLogTable
+  , runInterfaceChecks
+  )
+ where
+
+import Import
+
+-- import qualified Data.Set as Set
+import qualified Data.Text as Text
+import Handler.Utils
+import Handler.Utils.Concurrent
+
+-- import           Database.Esqueleto.Experimental ((:&)(..))
+import qualified Database.Esqueleto.Experimental as E
+import qualified Database.Esqueleto.Utils as E
+import qualified Database.Esqueleto.Legacy as EL (on)
+import qualified Database.Persist.Sql as E (deleteWhereCount)
+
+
+-- | identify a wildcard argument
+wc2null :: Text -> Maybe Text
+-- wc2null "." = Nothing -- does not work, since dots are eliminated in URLs
+-- wc2null "-" = Nothing -- used as wildcard subtype in lpr interface
+wc2null "_" = Nothing
+wc2null "*" = Nothing
+wc2null  o  = Just o
+
+-- | sloppily parse a boolean, also see Model.Types.Avs.SloppyBool
+pbool :: Text -> Maybe Bool
+pbool (Text.toLower . Text.strip -> w)
+  | w `elem` ["1", "t", "true" ,"wahr", "w"] = Just True
+  | w `elem` ["0", "f", "false","falsch"]    = Just False
+  | otherwise                                = Nothing
+
+-- | parse UniqueInterfaceHealth with subtype and write arguments being optional for the last interface. Wildcards '_' or '.' are also allowed in all places.
+identifyInterfaces :: [Text] -> [Unique InterfaceHealth]
+identifyInterfaces []        = []
+identifyInterfaces [i]       = [UniqueInterfaceHealth i Nothing     Nothing]
+identifyInterfaces [i,s]     = [UniqueInterfaceHealth i (wc2null s) Nothing]
+identifyInterfaces (i:s:w:r) =  UniqueInterfaceHealth i (wc2null s) (pbool w) : identifyInterfaces r
+
+type ReqBanInterfaceHealth = ([Unique InterfaceHealth],[Unique InterfaceHealth])
+
+-- | Interface names prefixed with '-' are to be excluded from the query
+splitInterfaces :: [Unique InterfaceHealth] -> ReqBanInterfaceHealth
+splitInterfaces = foldl' aux mempty
+  where
+    aux (reqs,bans) uih@(UniqueInterfaceHealth i s w)
+      | Just ('-', b) <- Text.uncons i = (reqs, UniqueInterfaceHealth b s w : bans)
+      | otherwise = (uih : reqs, bans)
+
+-- | check whether the first argument is equal or more specialzed (i.e. more Just) than the second
+matchesUniqueInterfaceHealth :: Unique InterfaceHealth -> Unique InterfaceHealth -> Bool
+matchesUniqueInterfaceHealth (UniqueInterfaceHealth ai as aw) (UniqueInterfaceHealth bi bs bw) = ai == bi && eqOrNothing as bs && eqOrNothing aw bw
+  where
+    eqOrNothing _ Nothing = True
+    eqOrNothing a b       = a == b
+
+
+getHealthInterfaceR :: [Text] -> Handler TypedContent
+getHealthInterfaceR (dropWhile (=="force") -> ris) = do               -- for backwards compatibility we ignore leading "force"
+  let interfs = splitInterfaces $ identifyInterfaces ris
+  (missing, allok, res, iltable) <- runInterfaceLogTable interfs
+  when missing notFound                                               -- send 404 if any requested interface was not found
+  let ihstatus = if allok then status200
+                          else internalServerError500
+      plainMsg = if allok then "Interfaces are healthy."
+                          else "Unhealthy interfaces: " <> Text.intercalate ", " [iface | (iface, False) <- res]
+  sendResponseStatus ihstatus <=< selectRep $ do                      -- most browsers send accept:text/html, thus text/plain can be default here
+    provideRep . return . RepPlain $ toContent plainMsg               -- /?_accept=text/plain
+    provideRep . siteLayoutMsg MsgMenuHealthInterface $ do            -- /?_accept=text/html
+      setTitleI MsgMenuHealthInterface
+      [whamlet|
+        <div>
+          #{plainMsg}
+        <div>
+          ^{iltable}
+      |]
+
+
+runInterfaceLogTable :: ReqBanInterfaceHealth -> Handler (Bool, Bool, [(Text,Bool)], Widget)
+runInterfaceLogTable interfs@(reqIfs,_) = do
+  -- we abuse messageTooltip for colored icons here
+  msgSuccessTooltip <- messageI Success MsgMessageSuccess
+  -- msgWarningTooltip <- messageI Warning MsgMessageWarning
+  msgErrorTooltip   <- messageI Error   MsgMessageError
+  let flagError = messageTooltip . bool msgErrorTooltip msgSuccessTooltip
+  (res, twgt) <- runDB $ mkInterfaceLogTable flagError interfs
+  let missing = notNull [ifce | (UniqueInterfaceHealth ifce _subt _writ) <- reqIfs, ifce `notElem` (fst <$> res) ]
+      allok   = all snd res
+  return (missing, allok, res, twgt)
+
+-- ihDebugShow :: Unique InterfaceHealth -> Text
+-- ihDebugShow (UniqueInterfaceHealth i s w) = "(" <> tshow i <> "," <> tshow s <> "," <> tshow w <> ")"
+
+mkInterfaceLogTable :: (Bool -> Widget) -> ReqBanInterfaceHealth -> DB ([(Text,Bool)], Widget)
+mkInterfaceLogTable flagError interfs@(reqIfs, banIfs) = do
+    --   $logWarnS "DEBUG" $ tshow ([ihDebugShow x | x<- reqIfs], [ihDebugShow x | x<- banIfs])
+    void $ liftHandler $ timeoutHandler 42000001 $ runDB $ runInterfaceChecks interfs
+    now <- liftIO getCurrentTime
+    dbTableDB ilvalidator DBTable{dbtColonnade=colonnade now, ..}
+  where
+    sanitize      = text2AlphaNumPlus ['+','-','_','Ä','Ö','Ü','ß','ä','ö','ü']
+    dbtIdent      = "interface-log" :: Text
+    dbtProj       = dbtProjId
+    dbtSQLQuery (ilog `E.LeftOuterJoin` ihealth) = do
+      EL.on (       ilog E.^. InterfaceLogInterface E.=?.          ihealth E.?. InterfaceHealthInterface
+              E.&&. ilog E.^. InterfaceLogSubtype   E.=~. E.joinV (ihealth E.?. InterfaceHealthSubtype)
+              E.&&. ilog E.^. InterfaceLogWrite     E.=~. E.joinV (ihealth E.?. InterfaceHealthWrite  )
+            )
+      let matchUIH crits = E.or
+           [ E.and $ catMaybes
+             [  ilog E.^. InterfaceLogInterface E.==.    E.val  (sanitize     ifce) & Just
+             , (ilog E.^. InterfaceLogSubtype   E.==.) . E.val . sanitize <$> subt
+             , (ilog E.^. InterfaceLogWrite     E.==.) . E.val            <$> writ
+             ]
+           | (UniqueInterfaceHealth ifce subt writ) <- crits
+           ]
+          matchUIHnot crits = E.and
+           [ E.or $ catMaybes
+             [  ilog E.^. InterfaceLogInterface E.!=.    E.val  (sanitize     ifce) & Just
+             , (ilog E.^. InterfaceLogSubtype   E.!=.) . E.val . sanitize <$> subt
+             , (ilog E.^. InterfaceLogWrite     E.!=.) . E.val            <$> writ
+             ]
+           | (UniqueInterfaceHealth ifce subt writ) <- crits
+           ]
+      unless (null reqIfs) $ E.where_ $ matchUIH    reqIfs
+      unless (null banIfs) $ E.where_ $ matchUIHnot banIfs
+      -- unless (null banIfs) $ E.where_ $ E.not_ $ matchUIH banIfs -- !!! DOES NOT WORK !!! Yields strange results, see #155
+      -- unless (null banIfs) $ E.where_ $ E.not_ $ E.parens $ matchUIH banIfs -- WORKS OKAY
+      -- E.where_ $ E.not_ (ilog E.^. InterfaceLogInterface E.==. E.val "LMS" E.&&.  ilog E.^. InterfaceLogSubtype E.==. E.val (sanitize "F")) -- BAD  All missing, except for "Printer" "F"
+      -- E.where_ $ E.not_ $ E.parens (ilog E.^. InterfaceLogInterface E.==. E.val "LMS" E.&&.  ilog E.^. InterfaceLogSubtype E.==. E.val (sanitize "F")) -- WORKS OKAY
+      -- E.where_ $         ilog E.^. InterfaceLogInterface E.!=. E.val "LMS" E.||.  ilog E.^. InterfaceLogSubtype E.!=. E.val (sanitize "F")  -- WORKS OKAY
+      let ihour = E.coalesceDefault [ihealth E.?. InterfaceHealthHours] (E.val $ 3 * 24)  -- if no default time is set, use 3 days instead
+      return (ilog, ihour)
+
+    queryILog     :: (E.SqlExpr (Entity InterfaceLog) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity InterfaceHealth))) -> E.SqlExpr (Entity InterfaceLog)
+    queryILog     = $(E.sqlLOJproj 2 1)
+    resultILog    :: Lens' (DBRow (Entity InterfaceLog, E.Value Int)) InterfaceLog
+    resultILog    = _dbrOutput . _1 . _entityVal
+    resultHours   :: Lens' (DBRow (Entity InterfaceLog, E.Value Int)) Int
+    resultHours   = _dbrOutput . _2 . E._unValue
+
+    dbtRowKey     = queryILog >>> (E.^.InterfaceLogId)
+    colonnade now = mconcat
+        [ sortable Nothing (i18nCell MsgInterfaceStatus) $ \row -> -- do
+            let hours   = row ^. resultHours
+                -- defmsg  = row ^? resultErrMsg
+                logtime = row ^. resultILog . _interfaceLogTime
+                success = row ^. resultILog . _interfaceLogSuccess
+                iface   = row ^. resultILog . _interfaceLogInterface
+                status  = success && now <= addHours hours logtime
+            in tellCell [(iface,status)] $
+                wgtCell $ flagError status
+        , sortable (Just "interface") (i18nCell MsgInterfaceName      ) $ \(view (resultILog . _interfaceLogInterface) -> n) -> textCell n
+        , sortable (Just "subtype")   (i18nCell MsgInterfaceSubtype   ) $ textCell . view (resultILog . _interfaceLogSubtype)
+        , sortable (Just "write")     (i18nCell MsgInterfaceWrite     ) $ (`ifIconCell` IconEdit) . view (resultILog . _interfaceLogWrite)
+        , sortable (Just "time")      (i18nCell MsgInterfaceLastSynch ) $ dateTimeCell . view (resultILog . _interfaceLogTime)
+        , sortable Nothing            (i18nCell MsgInterfaceFreshness ) $ numCell . view resultHours
+        , sortable (Just "rows")      (i18nCell MsgTableRows          ) $ cellMaybe numCell . view (resultILog . _interfaceLogRows)
+        , sortable (Just "success")   (i18nCell MsgInterfaceSuccess   ) $ \(view (resultILog . _interfaceLogSuccess) -> s) -> iconBoolCell s
+        , sortable Nothing            (i18nCell MsgInterfaceInfo      ) $ \(view resultILog -> ilt) -> case ilt of
+            InterfaceLog "AVS" "Synch" True _ _ i _ -> anchorCell ProblemAvsErrorR  $ toWgt $ bool i "AVS-Log" $ null i
+            InterfaceLog "LPR" _       _    _ _ i _ -> anchorCell PrintLogR         $ toWgt $ bool i "LPR-Log" $ null i
+            InterfaceLog _     _       _    _ _ i _ -> textCell i
+        ]
+
+    dbtSorting    = mconcat
+        [ singletonMap "interface" $ SortColumn $ queryILog >>> (E.^. InterfaceLogInterface)
+        , singletonMap "subtype"   $ SortColumn $ queryILog >>> (E.^. InterfaceLogSubtype)
+        , singletonMap "write"     $ SortColumn $ queryILog >>> (E.^. InterfaceLogWrite)
+        , singletonMap "time"      $ SortColumn $ queryILog >>> (E.^. InterfaceLogTime)
+        , singletonMap "rows"      $ SortColumn $ queryILog >>> (E.^. InterfaceLogRows)
+        , singletonMap "success"   $ SortColumn $ queryILog >>> (E.^. InterfaceLogSuccess)
+        ]
+    ilvalidator   = def & defaultSorting [SortAscBy "interface", SortAscBy "subtype", SortAscBy "write"]
+    dbtFilter     = mempty
+    dbtFilterUI   = mempty
+    dbtStyle      = def
+    dbtParams     = def
+    dbtCsvEncode  = noCsvEncode
+    dbtCsvDecode  = Nothing
+    dbtExtraReps  = []
+
+
+-- | runs additional checks and logs results within InterfaceLogTable; assumed to executable within a handler call
+runInterfaceChecks :: ReqBanInterfaceHealth -> DB ()
+runInterfaceChecks interfs = do
+  avsInterfaceCheck interfs
+  lprAckCheck interfs
+
+maybeRunCheck :: ReqBanInterfaceHealth -> Unique InterfaceHealth -> (UTCTime -> DB ()) -> DB ()
+maybeRunCheck (reqIfs,banIfs) uih act
+  | null reqIfs ||      any (matchesUniqueInterfaceHealth uih) reqIfs
+  , null banIfs || not (any (matchesUniqueInterfaceHealth uih) banIfs) = do
+      mih <- getBy uih
+      whenIsJust mih $ \eih -> do
+        now <- liftIO getCurrentTime
+        act $ addHours (negate $ interfaceHealthHours $ entityVal eih) now
+  | otherwise = return ()
+
+
+lprAckCheck :: ReqBanInterfaceHealth -> DB ()
+lprAckCheck interfs = maybeRunCheck interfs (UniqueInterfaceHealth "Printer" (Just "Acknowledge") (Just True)) $ \cutOffOldTime -> do
+    unproc <- selectList [PrintAcknowledgeTimestamp <. cutOffOldTime, PrintAcknowledgeProcessed ==. False] []
+    if notNull unproc
+      then mkLog False (Just $ length unproc) "Long unprocessed APC-Idents exist"
+      else do
+        oks <- E.deleteWhereCount [PrintAcknowledgeTimestamp <. cutOffOldTime, PrintAcknowledgeProcessed ==. True]
+        if oks > 0
+          then mkLog True (Just $ fromIntegral oks) "Long processed APC-Idents removed"
+          else mkLog True Nothing mempty
+  where
+    mkLog = logInterface' "Printer" "Acknowledge" True
+
+
+avsInterfaceCheck :: ReqBanInterfaceHealth -> DB ()
+avsInterfaceCheck interfs = maybeRunCheck interfs (UniqueInterfaceHealth "AVS" (Just "Synch") (Just True)) $ \cutOffOldTime -> do
+  avsSynchStats <- E.select $ do
+    uavs <- E.from $ E.table @UserAvs
+    E.where_ $ uavs E.^. UserAvsLastSynch E.>. E.val cutOffOldTime
+    let isOk = E.isNothing (uavs E.^. UserAvsLastSynchError)
+    E.groupBy isOk
+    E.orderBy [E.descNullsLast isOk]
+    return (isOk, E.countRows, E.max_ $ uavs E.^. UserAvsLastSynch)
+  let
+    mkBadInfo badRows (fromMaybe cutOffOldTime -> badTime) | badRows > 0 = do
+      fmtCut <- formatTime SelFormatDate cutOffOldTime
+      fmtBad <- formatTime SelFormatDateTime badTime
+      return $ tshow badRows <> " Fehler seit " <> fmtCut <> ", zuletzt um " <> fmtBad
+    mkBadInfo _ _ = return mempty
+    writeAvsSynchStats okRows badInfo =
+      logInterface' "AVS" "Synch" True (null badInfo) okRows badInfo
+  --case $(unValueN 3) <$> avsSynchStats of
+  case avsSynchStats of
+    ((E.Value True , E.Value okRows, E.Value _okTime):(E.Value False, E.Value badRows, E.Value badTime):_) ->
+      writeAvsSynchStats (Just okRows) =<< mkBadInfo badRows badTime
+    ((E.Value True , E.Value okRows, E.Value _okTime):_)    ->
+      writeAvsSynchStats (Just okRows) mempty
+    ((E.Value False, E.Value badRows, E.Value badTime):_) ->
+      -- lastOk <- userAvsLastSynch . entityVal <<$>> selectFirst [UserAvsLastSynchError ==. Nothing] [Desc UserAvsLastSynch]
+      writeAvsSynchStats Nothing =<< mkBadInfo badRows badTime
+    _ -> return ()
--- a/src/Handler/Info.hs
+++ b/src/Handler/Info.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-2023 Felix Hamann <felix.hamann@campus.lmu.de>, Gregor Kleen <gregor@kleen.consulting>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>, Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-2024 Felix Hamann <felix.hamann@campus.lmu.de>, Gregor Kleen <gregor@kleen.consulting>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>, Winnie Ros <winnie.ros@campus.lmu.de>, Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -13,12 +13,12 @@ import Data.Map ((!))
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Set as Set

-import qualified Database.Esqueleto.Legacy as E
-import qualified Database.Esqueleto.Utils as E
+-- import qualified Database.Esqueleto.Legacy as E
+-- import qualified Database.Esqueleto.Utils as E

 import Development.GitRev

-import Auth.LDAP (ADError(..), ADInvalidCredentials(..), CampusMessage(..))
+-- import Auth.LDAP (ADError(..), ADInvalidCredentials(..), CampusMessage(..))

 import Yesod.Auth.Message(AuthMessage(..)) 

@ -175,6 +175,7 @@ showFAQ :: ( MonadAP m
           , MonadThrow m
           )
        => Route UniWorX -> FAQItem -> m Bool
+showFAQ _ FAQLoginExpired = return True
 showFAQ _ FAQNoCampusAccount = is _Nothing <$> maybeAuthId
 showFAQ (AuthR _) FAQCampusCantLogin = return True
 showFAQ _ FAQCampusCantLogin = is _Nothing <$> maybeAuthId
@ -183,38 +184,20 @@ showFAQ _ FAQForgottenPassword = is _Nothing <$> maybeAuthId
 showFAQ _ FAQNotLecturerHowToCreateCourses
  = and2M (is _Just <$> maybeAuthId)
          (not <$> hasWriteAccessTo CourseNewR)
-showFAQ (CourseR tid ssh csh _) FAQCourseCorrectorsTutors
-  = and2M (is _Just <$> maybeAuthId)
-          (or2M (hasWriteAccessTo $ CourseR tid ssh csh SheetNewR)
-                (hasWriteAccessTo $ CourseR tid ssh csh CTutorialNewR)
-          )
-showFAQ (CExamR tid ssh csh examn _) FAQExamPoints
-  = and2M (hasWriteAccessTo $ CExamR tid ssh csh examn EEditR)
-          noExamParts
-  where
-    noExamParts = liftHandler . runDB . E.selectNotExists . E.from $ \(examPart `E.InnerJoin` exam `E.InnerJoin` course) -> do
-      E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
-      E.on $ exam E.^. ExamId E.==. examPart E.^. ExamPartExam
-      E.where_ $ course E.^. CourseTerm E.==. E.val tid
-           E.&&. course E.^. CourseSchool E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-           E.&&. exam E.^. ExamName E.==. E.val examn
-showFAQ _ FAQInvalidCredentialsAdAccountDisabled = maybeT (return False) $ do
-  guardM $ is _Nothing <$> maybeAuthId
-  sessionError <- MaybeT $ lookupSessionJson SessionError
-  guard $ sessionError == PermissionDenied (toPathPiece $ ADInvalidCredentials ADAccountDisabled)
-  return True
-showFAQ _ _ = return False
+-- showFAQ (CourseR tid ssh csh _) FAQCourseCorrectorsTutors
+--   = and2M (is _Just <$> maybeAuthId)
+--           (or2M (hasWriteAccessTo $ CourseR tid ssh csh SheetNewR)
+--                 (hasWriteAccessTo $ CourseR tid ssh csh CTutorialNewR)
+--           )
+-- showFAQ _ _ = return False

 prioFAQ :: Monad m
        => Route UniWorX -> FAQItem -> m Rational
+prioFAQ _ FAQLoginExpired = return 2
 prioFAQ _ FAQNoCampusAccount = return 1
 prioFAQ _ FAQCampusCantLogin = return 1
 prioFAQ _ FAQForgottenPassword = return 1
 prioFAQ _ FAQNotLecturerHowToCreateCourses = return 1
-prioFAQ _ FAQCourseCorrectorsTutors = return 1
-prioFAQ _ FAQExamPoints = return 2
-prioFAQ _ FAQInvalidCredentialsAdAccountDisabled = return 3  


 getInfoLecturerR :: Handler Html
--- a/src/Handler/LMS/Learners.hs
+++ b/src/Handler/LMS/Learners.hs
@ -213,6 +213,6 @@ getLmsLearnersDirectR sid qsh = do
  $logInfoS "LMS" msg
  addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
  csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered
-    <* runDB (logInterface "LMS" (ciOriginal qsh) (Just nr) "")
+    <* runDB (logInterface "LMS" (ciOriginal qsh) True (Just nr) "")
 -- direct Download see:
 -- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod
--- a/src/Handler/LMS/Report.hs
+++ b/src/Handler/LMS/Report.hs
@ -294,8 +294,7 @@ postLmsReportUploadR sid qsh = do
        setTitleI MsgMenuLmsUpload
        [whamlet|$newline never
          <form method=post enctype=#{enctype}>
-            ^{widget}
-            <p>
+            ^{widget}            
            <input type=submit>
        |]

@ -315,12 +314,13 @@ postLmsReportDirectR sid qsh = do
        case enr of
          Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error
            $logWarnS "LMS" $ "Report upload failed parsing: " <> tshow e
+            logInterface "LMS" (ciOriginal qsh) False Nothing ""
            return (badRequest400, "Exception: " <> tshow e)
          Right nr -> do
            let msg = "Success. LMS Report upload file " <> fileName file <> " containing " <> tshow nr <> " rows for " <> fhead <> ".  "
            $logInfoS "LMS" msg
            when (nr > 0) $ queueDBJob $ JobLmsReports qid
-            logInterface "LMS" (ciOriginal qsh) (Just nr) ""
+            logInterface "LMS" (ciOriginal qsh) True (Just nr) ""
            return (ok200, msg)
    []     -> do
      let msg = "Report upload file missing."
--- a/src/Handler/PrintCenter.hs
+++ b/src/Handler/PrintCenter.hs
@ -7,10 +7,11 @@

 module Handler.PrintCenter
  ( getPrintDownloadR
-  , getPrintCenterR, postPrintCenterR  
+  , getPrintCenterR, postPrintCenterR
  , getPrintSendR  , postPrintSendR
  , getPrintAckR   , postPrintAckR
-  , postPrintAckDirectR  
+  , getPrintAckDirectR, postPrintAckDirectR
+  , getPrintLogR
  ) where

 import Import
@ -26,7 +27,7 @@ import Database.Esqueleto.Utils.TH

 import Utils.Print

-- import Data.Aeson (encode)
+import qualified Data.Aeson  as Aeson
 -- import qualified Data.Text as Text
 -- import qualified Data.Set  as Set

@ -43,11 +44,11 @@ single :: (k,a) -> Map k a
 single = uncurry Map.singleton


-data LRQF = LRQF 
-    { lrqfLetter    :: Text 
+data LRQF = LRQF
+    { lrqfLetter    :: Text
    , lrqfUser      :: Either UserEmail UserId
    , lrqfSuper     :: Maybe (Either UserEmail UserId)
-    , lrqfQuali     :: Entity Qualification 
+    , lrqfQuali     :: Entity Qualification
    , lrqfIdent     :: LmsIdent
    , lrqfPin       :: Text
    , lrqfExpiry    :: Maybe Day
@ -62,12 +63,12 @@ makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRe
    <*> areq (userField False Nothing)  (fslI MsgLmsUser)                      (lrqfUser      <$> tmpl)
    <*> aopt (userField False Nothing)  (fslI MsgTableSupervisor)              (lrqfSuper     <$> tmpl)
    <*> areq qualificationFieldEnt      (fslI MsgQualificationName)            (lrqfQuali     <$> tmpl)
-    <*> areq lmsField                   (fslI MsgTableLmsIdent)                (lrqfIdent     <$> tmpl) 
+    <*> areq lmsField                   (fslI MsgTableLmsIdent)                (lrqfIdent     <$> tmpl)
    <*> areq textField                  (fslI MsgTableLmsPin)                  (lrqfPin       <$> tmpl)
    <*> aopt dayField                   (fslI MsgLmsQualificationValidUntil)   (lrqfExpiry    <$> tmpl)
-    <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) 
+    <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant)
                                        (fslI MsgLmsRenewalReminder)           (lrqfReminder  <$> tmpl)
-  where 
+  where
    lmsField = convertField LmsIdent getLmsIdent textField

 validateLetterRenewQualificationF :: FormValidator LRQF Handler ()
@ -76,12 +77,12 @@ validateLetterRenewQualificationF = -- do
  return ()

 lrqf2letter :: LRQF -> DB (Entity User, SomeLetter)
-lrqf2letter LRQF{..} 
-  | lrqfLetter == "r" = do 
+lrqf2letter LRQF{..}
+  | lrqfLetter == "r" = do
    usr   <-      getUser lrqfUser
    rcvr  <- mapM getUser lrqfSuper
    now   <- liftIO getCurrentTime
-    let letter = LetterRenewQualificationF 
+    let letter = LetterRenewQualificationF
          { lmsLogin      = lrqfIdent
          , lmsPin        = lrqfPin
          , qualHolderID  = usr ^. _entityKey
@ -96,13 +97,13 @@ lrqf2letter LRQF{..}
          , isReminder    = lrqfReminder
          }
    return (fromMaybe usr rcvr, SomeLetter letter)
-  | lrqfLetter == "e" || lrqfLetter == "E" = do 
+  | lrqfLetter == "e" || lrqfLetter == "E" = do
    rcvr    <- mapM getUser lrqfSuper
    usr     <-      getUser lrqfUser
    usrShrt <- encrypt $ entityKey usr
    usrUuid <- encrypt $ entityKey usr
    urender <- liftHandler getUrlRender
-    let letter = LetterExpireQualification 
+    let letter = LetterExpireQualification
          { leqHolderCFN   = usrShrt
          , leqHolderID    = usr ^. _entityKey
          , leqHolderDN    = usr ^. _userDisplayName
@ -111,15 +112,15 @@ lrqf2letter LRQF{..}
          , leqId          = lrqfQuali ^. _entityKey
          , leqName        = lrqfQuali ^. _qualificationName      . _CI
          , leqShort       = lrqfQuali ^. _qualificationShorthand . _CI
-          , leqSchool      = lrqfQuali ^. _qualificationSchool          
+          , leqSchool      = lrqfQuali ^. _qualificationSchool
          , leqUrl         = pure . urender $ ForProfileDataR usrUuid
          }
    return (fromMaybe usr rcvr, SomeLetter letter)
  | otherwise = error "Unknown Letter Type encountered. Use 'e' or 'r' only."
-  where 
+  where
    getUser :: Either UserEmail UserId -> DB (Entity User)
    getUser (Right uid) = getEntity404 uid
-    getUser (Left mail) = getBy404 $ UniqueEmail mail 
+    getUser (Left mail) = getBy404 $ UniqueEmail mail


 data PJTableAction = PJActAcknowledge | PJActReprint
@ -190,7 +191,7 @@ pjTableQuery (printJob `E.LeftOuterJoin` recipient
  return (printJob, recipient, sender, course, quali)

 mkPJTable :: DB (FormResult (PJTableActionData, Set PrintJobId), Widget)
-mkPJTable = do  
+mkPJTable = do
  let
    dbtSQLQuery = pjTableQuery
    dbtRowKey = queryPrintJob >>> (E.^. PrintJobId)
@ -225,7 +226,7 @@ mkPJTable = do
    dbtFilter = mconcat
      [ single ("name"         , FilterColumn . E.mkContainsFilterWithCommaPlus id                $ views (to queryPrintJob)      (E.^. PrintJobName))
      , single ("apcid"        , FilterColumn . E.mkContainsFilterWithComma     id                $ views (to queryPrintJob)      (E.^. PrintJobApcIdent))
-      , single ("filename"     , FilterColumn . E.mkContainsFilter                                $ views (to queryPrintJob)      (E.^. PrintJobFilename))      
+      , single ("filename"     , FilterColumn . E.mkContainsFilter                                $ views (to queryPrintJob)      (E.^. PrintJobFilename))
      , single ("created"      , FilterColumn . E.mkDayFilter                                     $ views (to queryPrintJob)      (E.^. PrintJobCreated))
      --, single ("created"      , FilterColumn . E.mkDayBetweenFilter                            $ views (to queryPrintJob)      (E.^. PrintJobCreated))
      , single ("recipient"    , FilterColumn . E.mkContainsFilterWithCommaPlus Just              $ views (to queryRecipient)     (E.?. UserDisplayName))
@ -233,7 +234,7 @@ mkPJTable = do
      , single ("course"       , FilterColumn . E.mkContainsFilterWith          (Just . CI.mk)    $ views (to queryCourse)        (E.?. CourseName))
      , single ("qualification", FilterColumn . E.mkContainsFilterWith          (Just . CI.mk)    $ views (to queryQualification) (E.?. QualificationName))
      , single ("lmsid"        , FilterColumn . E.mkContainsFilterWithCommaPlus (Just . LmsIdent) $ views (to queryPrintJob)      (E.^. PrintJobLmsUser))
-      
+
      , single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
      ]
    dbtFilterUI mPrev = mconcat
@ -288,7 +289,7 @@ mkPJTable = do

 getPrintCenterR,  postPrintCenterR :: Handler Html
 getPrintCenterR = postPrintCenterR
-postPrintCenterR = do  
+postPrintCenterR = do
  (pjRes, pjTable) <- runDB mkPJTable

  formResult pjRes $ \case
@ -298,21 +299,21 @@ postPrintCenterR = do
      addMessageI Success $ MsgPrintJobAcknowledge num
      reloadKeepGetParams PrintCenterR
    (PJActReprintData{ignoreReroute}, Set.toList -> pjIds) -> do
-      let countOk = either (const $ Sum 0) (const $ Sum 1)          
+      let countOk = either (const $ Sum 0) (const $ Sum 1)
      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  
+  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!          
+              Mail-reroute-to ist gesetzt, somit werden alle lpr Kommandos unterdrückt!
        |]
  siteLayoutMsg MsgMenuApc $ do
    setTitleI MsgMenuApc
@ -322,7 +323,7 @@ postPrintCenterR = do
 getPrintSendR, postPrintSendR :: Handler Html
 getPrintSendR = postPrintSendR
 postPrintSendR = do
-  usr  <- requireAuth -- to determine language and recipient for test   
+  usr  <- requireAuth -- to determine language and recipient for test
  mbQual <- runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand]
  now <- liftIO getCurrentTime
  let nowaday = utctDay now
@ -340,7 +341,7 @@ postPrintSendR = do
      def_lrqf = mkLetter <$> mbQual

  ((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
-  let procFormSend lrqf = case lrqfLetter lrqf of 
+  let procFormSend lrqf = case lrqfLetter lrqf of
        "E" -> (runDB (lrqf2letter lrqf) >>= printHtml (Just uid)) >>= \case
            Right html -> sendResponse $ toTypedContent html
            Left err -> do
@ -348,7 +349,7 @@ postPrintSendR = do
              $logErrorS "LPR" msg
              addMessage Error $ toHtml msg
              pure ()
-        _ -> do 
+        _ -> do
            ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case
              Left err -> do
                let msg = "PDF printing failed with error: " <> err
@ -399,26 +400,26 @@ postPrintAckR ackDay numAck chksm = do
        , formSubmit   = FormNoSubmit
        }
  formResult ackRes $ \BtnConfirm -> do
-    numNew <- runDB $ do 
-      pjs <- Ex.select $ do 
+    numNew <- runDB $ do
+      pjs <- Ex.select $ do
        pj <- Ex.from $ Ex.table @PrintJob
-        let pjDay = E.day $ pj Ex.^. PrintJobCreated 
+        let pjDay = E.day $ pj Ex.^. PrintJobCreated
        Ex.where_ $  Ex.isNothing (pj Ex.^. PrintJobAcknowledged)
-              Ex.&&. (pjDay Ex.==. Ex.val ackDay)      
+              Ex.&&. (pjDay Ex.==. Ex.val ackDay)
        return $ pj Ex.^. PrintJobId
      let changed = numAck /= length pjs || chksm /= hash (Set.fromList (Ex.unValue <$> pjs))
      if changed
        then return (-1)
-        else do 
+        else do
          now <- liftIO getCurrentTime
          E.updateCount $ \pj -> do
-            let pjDay = E.day $ pj E.^. PrintJobCreated 
+            let pjDay = E.day $ pj E.^. PrintJobCreated
            E.set pj [ PrintJobAcknowledged E.=. E.justVal now ]
            E.where_ $ E.isNothing (pj E.^. PrintJobAcknowledged)
                  E.&&. (pjDay E.==. E.val ackDay)
          --  Ex.updateCount $ do
            --  pj <- Ex.from $ Ex.table @PrintJob
-            --  let pjDay = E.day $ pj Ex.^. PrintJobCreated 
+            --  let pjDay = E.day $ pj Ex.^. PrintJobCreated
            --  Ex.set pj [ PrintJobAcknowledged Ex.=. Ex.just (Ex.val now) ]
            --  Ex.where_ $ Ex.isNothing (pj Ex.^. PrintJobAcknowledged)
                  -- Ex.&&. (pjDay Ex.==. Ex.val ackDay)
@ -427,29 +428,44 @@ postPrintAckR ackDay numAck chksm = do
      else addMessageI Error     MsgPrintJobAcknowledgeFailed
    redirect PrintCenterR
  ackDayText <- formatTime SelFormatDate ackDay
-  siteLayoutMsg 
-    (MsgPrintJobAcknowledgeQuestion numAck ackDayText) 
+  siteLayoutMsg
+    (MsgPrintJobAcknowledgeQuestion numAck ackDayText)
    ackForm

 -- no header csv, containing a single column of lms identifiers (logins)
 -- instance Csv.FromRecord LmsIdent -- default suffices
-- instance Csv.FromRecord Text where 
--   parseRecord v 
+-- instance Csv.FromRecord Text where
+--   parseRecord v
 --     | length v >= 1 = v Csv..! 0
 --     | otherwise     = pure "ERROR"

 saveApcident :: UTCTime -> Natural -> Text -> JobDB Natural
 saveApcident t i apci = insert_ (PrintAcknowledge apci t False) >> return (succ i)

+
+makeAckUploadForm :: Form FileInfo
+makeAckUploadForm = renderAForm FormStandard $ fileAFormReq "Acknowledge APC-Ident CSV"
+
+getPrintAckDirectR :: Handler Html
+getPrintAckDirectR = do
+  (widget, enctype) <- generateFormPost makeAckUploadForm
+  siteLayoutMsg MsgMenuPrintAck $ do
+    setTitleI MsgMenuPrintAck
+    [whamlet|$newline never
+      <form method=post enctype=#{enctype}>
+        ^{widget}
+        <input type=submit>
+    |]
+
 postPrintAckDirectR :: Handler Html
 postPrintAckDirectR = do
  now <- liftIO getCurrentTime
  (_params, files) <- runRequestBody
  (status, msg) <- case files of
-    [(_fhead,file)] -> do      
-      runDBJobs $ do        
+    [(_fhead,file)] -> do
+      runDBJobs $ do
        enr <- try $ runConduit $ fileSource file
-                -- .| decodeCsvPositional Csv.NoHeader -- decode by separator position                
+                -- .| decodeCsvPositional Csv.NoHeader -- decode by separator position
                .| decodeUtf8C      -- no CSV, just convert each line to a single text
                .| linesUnboundedC
                .| foldMC (saveApcident now) 0
@ -461,7 +477,7 @@ postPrintAckDirectR = do
            let msg = "Success: received " <> tshow nr <> " APC identifiers to be processed later."
            $logInfoS "LMS" msg
            when (nr > 0) $ queueDBJob JobPrintAck
-            return (ok200, msg)      
+            return (ok200, msg)
    []     -> do
      let msg = "Error: No file received. A file of lms identifiers must be supplied for print job acknowledging."
      $logWarnS "APC" msg
@ -471,3 +487,55 @@ postPrintAckDirectR = do
      $logErrorS "APC" msg
      return (badRequest400, msg)
  sendResponseStatus status msg -- must be outside of runDB; otherwise transaction is rolled back
+
+
+getPrintLogR :: Handler Html
+getPrintLogR = do
+  let
+    logDBTable = DBTable{..}
+      where
+        resultLog :: Lens' (DBRow (TransactionLog, Aeson.Result Transaction)) TransactionLog
+        resultLog = _dbrOutput . _1
+
+        resultTrans :: Lens' (DBRow (TransactionLog, Aeson.Result Transaction)) (Aeson.Result Transaction)
+        resultTrans = _dbrOutput . _2
+
+        tCell' err c dbr = case view resultTrans dbr of
+          (Aeson.Error msg) -> err msg -- should not happen, due to query filter
+          (Aeson.Success t) -> c t
+        tCellErr = tCell' stringCell
+        tCell    = tCell' $ const mempty
+
+        dbtIdent = "lpr-log" :: Text
+        dbtSQLQuery l = do
+          E.where_ $ E.val "LPR" E.==. l E.^. TransactionLogInfo E.->>. "interface-name"
+            -- E.&&. E.val "interface" E.==. l E.^. TransactionLogInfo E.->>. "transaction" -- not necessary
+          return l
+        dbtRowKey = (E.^. TransactionLogId)
+        dbtProj = dbtProjSimple $ \(Entity _ l) -> do
+          return (l, Aeson.fromJSON $ transactionLogInfo l)
+        dbtColonnade = dbColonnade $ mconcat
+          [ sortable (Just "time")    (i18nCell MsgSystemMessageTimestamp) $ \(view $ resultLog . to transactionLogTime -> t) -> dateTimeCell t
+          , sortable (Just "status")  (textCell "Status")                $ tCell    (cellMaybe iconBoolCell . transactionInterfaceSuccess)
+          , sortable (Just "subtype") (i18nCell MsgInterfaceSubtype)     $ tCell    (              textCell . transactionInterfaceSubtype)
+          , sortable (Just "info")    (i18nCell MsgSystemMessageContent) $ tCellErr (              textCell . transactionInterfaceInfo)
+          ]
+        dbtSorting = mconcat
+          [ singletonMap "time"     $ SortColumn (E.^. TransactionLogTime)
+          , singletonMap "status"   $ SortColumn (\r -> r E.^. TransactionLogTime E.->>. "interface-success")
+          , singletonMap "subtype"  $ SortColumn (\r -> r E.^. TransactionLogTime E.->>. "interface-subtype")
+          , singletonMap "info"     $ SortColumn (\r -> r E.^. TransactionLogTime E.->>. "interface-info"   )
+          ]
+        dbtFilter   = mempty
+        dbtFilterUI = mempty
+
+        dbtStyle  = def
+        dbtParams = def
+        dbtCsvEncode = noCsvEncode
+        dbtCsvDecode = Nothing
+        dbtExtraReps = []
+    validator = def & defaultSorting [ SortDescBy "time" ]
+  tbl <- runDB $ dbTableDB' validator logDBTable
+  siteLayoutMsg MsgMenuPrintLog $ do
+    setTitleI MsgMenuPrintLog
+    [whamlet|^{tbl}|]
--- a/src/Handler/SAP.hs
+++ b/src/Handler/SAP.hs
@ -150,7 +150,7 @@ getQualificationSAPDirectR = do
      msg = "Qualification download file " <> csvSheetName <> " containing " <> tshow nr <> " rows"
      quals = Text.intercalate ", " $ nubOrd $ mapMaybe (view (_2 . E._unValue)) qualUsers
  $logInfoS "SAP" msg
-  let logInt = runDB $ logInterface "SAP" quals (Just nr) ""
+  let logInt = runDB $ logInterface "SAP" quals True (Just nr) ""
  addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
  csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered <* logInt
  
--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@ -35,6 +35,8 @@ import Handler.Utils.Qualification as Handler.Utils

 import Handler.Utils.Term as Handler.Utils

+-- import Handler.Utils.Concurrent as Handler.Utils -- only imported when needed
+
 import Control.Monad.Logger


--- a/src/Handler/Utils/Concurrent.hs
+++ b/src/Handler/Utils/Concurrent.hs
@ -0,0 +1,38 @@
+-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
+--
+-- SPDX-License-Identifier: AGPL-3.0-or-later
+
+module Handler.Utils.Concurrent
+  ( module Handler.Utils.Concurrent  
+  ) where
+
+-- NOTE: use `retrySTM` and `checkSTM` instead of `retry` or `check`
+
+import Import
+import UnliftIO.Concurrent as Handler.Utils.Concurrent hiding (yield)
+
+
+
+-- | Run a handler action until it finishes or if it exceeds a given number of microseconds via `registerDelay`
+timeoutHandler :: Int -> HandlerFor site a -> HandlerFor site (Maybe a)
+timeoutHandler maxWait act = do
+    innerAct <- handlerToIO
+    (hresult, tid) <- liftIO $ do
+      hresult <- newTVarIO Nothing
+      tid <- forkIO $ do
+        res <- innerAct act
+        atomically $ writeTVar hresult $ Just res
+      return (hresult, tid)
+    res <- liftIO $ do
+      flag <- registerDelay maxWait
+      atomically $ do
+        out <- readTVar flag
+        res <- readTVar hresult
+        checkSTM $ out || isJust res
+        return res
+    case res of
+      Nothing -> liftIO $ do
+        killThread tid
+        readTVarIO hresult     -- read once more after kill to ensure that any result is noticed
+      _ -> return res
+
--- a/src/Handler/Utils/DateTime.hs
+++ b/src/Handler/Utils/DateTime.hs
@ -93,8 +93,8 @@ toMorning = toTimeOfDay 6 0 0
 toTimeOfDay :: Int -> Int -> Pico -> Day -> UTCTime
 toTimeOfDay todHour todMin todSec d = localTimeToUTCTZ appTZ $ LocalTime d TimeOfDay{..}

-addHours :: Integer -> UTCTime -> UTCTime
-addHours = addUTCTime . secondsToNominalDiffTime . fromInteger . (* 3600)
+addHours :: Integral n => n -> UTCTime -> UTCTime
+addHours = addUTCTime . secondsToNominalDiffTime . fromIntegral . (* 3600)

 instance HasLocalTime UTCTime where
  toLocalTime = utcToLocalTime
--- a/src/Handler/Utils/LMS.hs
+++ b/src/Handler/Utils/LMS.hs
@ -115,7 +115,7 @@ csvFilenameLmsReport = makeLmsFilename "report"
 makeLmsFilename :: MonadHandler m => Text -> QualificationShorthand ->  m Text
 makeLmsFilename ftag (citext2lower -> qsh) = do
  ymth <- getYMTH
-  return $ "fradrive_" <> qsh <> "_" <> ftag <> "_" <> ymth <> ".csv"
+  return $ "fradrive_" <> "test" <> "_" <> qsh <> "_" <> ftag <> "_" <> ymth <> ".csv"

 -- | Return current datetime in YYYYMMDDHH format
 getYMTH :: MonadHandler m => m Text
@ -203,8 +203,8 @@ randomText extra n = fmap pack . evalRandTIO . replicateM n $ uniform range
 --     eopt = Elo.genOptions -- { genCapitals = False, genSpecials = False, genDigitis = True }

 randomLMSIdent :: MonadIO m => Maybe Char -> m LmsIdent
-randomLMSIdent Nothing  = LmsIdent . Text.cons 'j'  <$> randomText [] (pred lengthIdent) -- idents must not contain '_' nor '-'
-randomLMSIdent (Just c) = LmsIdent . Text.cons  c   <$> randomText [] (pred lengthIdent)
+randomLMSIdent Nothing  = LmsIdent . Text.cons 't' . Text.cons 'j'  <$> randomText [] (pred $ pred lengthIdent) -- idents must not contain '_' nor '-'
+randomLMSIdent (Just c) = LmsIdent . Text.cons 't' . Text.cons  c   <$> randomText [] (pred $ pred lengthIdent)

 randomLMSIdentBut :: MonadIO m => Maybe Char -> Set LmsIdent -> m (Maybe LmsIdent)
 randomLMSIdentBut prefix banList = untilJustMaxM maxLmsUserIdentRetries getIdentOk
--- a/src/Handler/Utils/Users.hs
+++ b/src/Handler/Utils/Users.hs
@ -185,7 +185,7 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)

    containsAsSet x y = E.and . map (\y' -> x `E.hasInfix` E.val y') $ asWords y

-    toSql user pl = bool id E.not_ (is _PLNegated pl) $ case pl ^. _plVar of
+    toSql user pl = bool id E.not__ (is _PLNegated pl) $ case pl ^. _plVar of
      GuessUserMatrikelnummer         userMatriculation' -> user E.^. UserMatrikelnummer  E.==.          E.val (Just userMatriculation')
      GuessUserDisplayName            userDisplayName'   -> user E.^. UserDisplayName    `containsAsSet` userDisplayName'
      GuessUserSurname                userSurname'       -> user E.^. UserSurname        `containsAsSet` userSurname'
--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@ -47,7 +47,7 @@ import qualified Control.Monad.Catch as Exc

 import Data.Time.Zones

-import Control.Concurrent.STM (stateTVar, retry)
+import Control.Concurrent.STM (stateTVar)
 import Control.Concurrent.STM.Delay

 import UnliftIO.Concurrent (forkIO, myThreadId, threadDelay)
@ -260,7 +260,7 @@ manageJobPool foundation@UniWorX{..} unmask = shutdownOnException $ \routeExc ->
                  (nextVal, newQueue) <- MaybeT . lift . fmap jqDequeue $ readTVar chan
                  lift . lift $ writeTVar chan newQueue
                  jobWorkers' <- lift . lift $ jobWorkers <$> readTMVar appJobState
-                  receiver <- maybe (lift $ lift retry) return =<< uniformMay jobWorkers'
+                  receiver <- maybe (lift $ lift retrySTM) return =<< uniformMay jobWorkers'
                  return (nextVal, receiver)
                whenIsJust next $ \(nextVal, receiver) -> do
                  atomically $ readTVar receiver >>= jqInsert nextVal >>= (writeTVar receiver $!)
@ -373,8 +373,8 @@ execCrontab = do
    State.modify . HashMap.filterWithKey $ \k _ -> HashMap.member k crontab
    prevExec <- State.get
    case earliestJob settings prevExec crontab refT of
-      Nothing -> liftBase retry
-      Just (_, MatchNone) -> liftBase retry
+      Nothing -> liftBase retrySTM
+      Just (_, MatchNone) -> liftBase retrySTM
      Just x -> return (crontab, x, prevExec)

  do
--- a/src/Jobs/Handler/LMS.hs
+++ b/src/Jobs/Handler/LMS.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-23 Steffen Jost <s.jost@fraport.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Steffen Jost <s.jost@fraport.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -117,7 +117,7 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
                              NotificationQualificationExpiry { nQualification = qid, nExpiry = uex }
                         }
          forM_ renewalUsers (queueDBJob . usr_job)
-          logInterface "LMS" (qshort <> "-enq") (Just $ length renewalUsers) ""
+          logInterface "LMS" (qshort <> "-enq") True (Just $ length renewalUsers) ""

 dispatchJobLmsEnqueueUser :: QualificationId -> UserId -> JobHandler UniWorX
 dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
@ -202,7 +202,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
              -- E.&&.  luser E.?. LmsUserQualification        E.?=. E.val qid
              -- E.&&.  E.isNothing (luser E.^. LmsUserStatus)
              -- E.&&.  E.isNothing (luser E.^. LmsUserEnded)
-              E.&&.  E.not_ (validQualification now quser)
+              E.&&.  E.not__ (validQualification now quser)
          pure (luser E.?. LmsUserId, quser E.^. QualificationUserUser)
      nrBlocked <- qualificationUserBlocking qid (E.unValue . snd <$> expiredUsers) False (Just now) (Right QualificationBlockExpired) True -- essential that blocks occur only once
      let expiredLearners = [ luid | (E.Value (Just luid), _) <- expiredUsers ]
@ -223,7 +223,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
              `E.on` (\(quser :& qblock) -> qblock E.?. QualificationUserBlockQualificationUser E.?=. quser E.^. QualificationUserId
                        E.&&. qblock `isLatestBlockBefore` E.val now
                     )
-            E.where_ $ -- E.not_ (validQualification now quser)                   -- currently invalid
+            E.where_ $ -- E.not__ (validQualification now quser)                   -- currently invalid
                    quser E.^. QualificationUserQualification E.==. E.val qid  -- correct qualification
              E.&&. quserToNotify now quser qblock                            -- recently became invalid or blocked
            pure (quser E.^. QualificationUserUser)
@ -259,7 +259,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
            deleteWhere [LmsUserQualification     ==. qid, LmsUserIdent     <-. delusers]
            -- deleteWhere [LmsAuditQualification    ==. qid, LmsAuditIdent    <-. delusers]
          deleteWhere [LmsReportLogQualification ==. qid, LmsReportLogTimestamp <. auditCutoff ]
-      logInterface "LMS" (qshort <> "-deq") (Just nrBlocked) (tshow nrExpired <> " expired")
+      logInterface "LMS" (qshort <> "-deq") True (Just nrBlocked) (tshow nrExpired <> " expired")


 dispatchJobLmsReports :: QualificationId -> JobHandler UniWorX
@ -313,7 +313,8 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
                        E.&&.  lreport E.^. LmsReportLock           E.==. E.true
                  )
        -- B) notify all newly reported users that lms is available
-        let luserFltrNew luser = E.isNothing $ luser E.^. LmsUserReceived  -- not seen before, just starting
+        let luserFltrNew luser =  E.isNothing (luser E.^. LmsUserReceived)  -- not seen before, just starting
+                            E.||. E.isNothing (luser E.^. LmsUserNotified)  -- a previous notification has failed
            notifyNewLearner (E.Value uid) = queueDBJob JobUserNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = False } }
          in luserQry luserFltrNew (const $ const E.true) >>= mapM_ notifyNewLearner
        -- C) block qualifications for failed learners by calling qualificationUserBlocking [uids] (includes audit), notified during expiry
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@ -375,6 +375,8 @@ jobNoQueueSame = \case
 notifyNoQueueSame :: Notification -> Maybe JobNoQueueSame
 notifyNoQueueSame = \case 
  NotificationQualificationRenewal{} -> Just JobNoQueueSame -- send one at once; safe, since the job is rescheduled if sending was not acknowledged
+  NotificationQualificationExpiry{}  -> Just JobNoQueueSame -- do not send multiple expiry messages to the same person at once
+  NotificationQualificationExpired{} -> Just JobNoQueueSame 
  _                                  -> Nothing

 jobMovable :: JobCtl -> Bool
--- a/src/Model/Migration/Definitions.hs
+++ b/src/Model/Migration/Definitions.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -49,6 +49,7 @@ import qualified Data.Time.Zones as TZ
 data ManualMigration
  = Migration20230524QualificationUserBlock
  | Migration20230703LmsUserStatus
+  | Migration20240212InitInterfaceHealth        -- create table interface_health and fill with default values
  | Migration20240312OAuth2
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite)
@ -178,6 +179,25 @@ customMigrations = mapF $ \case
        ;  
      |]

+  Migration20240212InitInterfaceHealth ->
+    unlessM (tableExists "interface_health") $ do -- fill health table with some defaults
+      [executeQQ|
+        CREATE TABLE "interface_health"
+          ( id BIGSERIAL NOT NULL 
+          , interface CHARACTER VARYING NOT NULL 
+          , subtype   CHARACTER VARYING 
+          , write     BOOLEAN 
+          , hours     BIGINT NOT NULL 
+          , PRIMARY KEY(id) 
+          , CONSTRAINT unique_interface_health UNIQUE(interface, subtype, write) 
+          ); 
+        INSERT INTO "interface_health" ("interface", "subtype", "write", "hours") 
+        VALUES 
+            ('Printer', 'Acknowledge', True, 168) 
+          , ('AVS'    , 'Synch'      , True , 96) 
+        ON CONFLICT DO NOTHING; 
+      |]
+
  Migration20240312OAuth2 -> whenM (andM [ columnNotExists "user" "password_hash", columnExists "user" "authentication", columnExists "user" "last_ldap_synchronisation", columnNotExists "user" "last_sync", columnExists "user" "ldap_primary_key" ]) $ do
    [executeQQ|
      ALTER TABLE "user" ADD COLUMN "password_hash" VARCHAR NULL;
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -23,7 +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.Char as Char
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text

@ -319,9 +319,16 @@ citext2string = Text.unpack . CI.original
 string2citext :: String -> CI Text
 string2citext = CI.mk . Text.pack

+text2AlphaNumPlus :: [Char] -> Text -> Text
+text2AlphaNumPlus = 
+  let alphaNum = Set.fromAscList $ ['0'..'9'] <> ['A'..'Z'] <> ['a'..'z']
+  in \oks -> 
+    let aNumPlus = Set.fromList oks <> alphaNum
+    in  Text.filter (`Set.member` aNumPlus)
+
 -- | Convert or remove all non-ascii  characters, e.g. for filenames 
 text2asciiAlphaNum :: Text -> Text
-text2asciiAlphaNum = Text.filter (\c -> Char.isAlphaNum c && Char.isAscii c)
+text2asciiAlphaNum = text2AlphaNumPlus ['-','_']
  . Text.replace "ä" "ae"
  . Text.replace "Ä" "Ae"
  . Text.replace "Æ" "ae"
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@ -382,6 +382,8 @@ identifyForm = identifyForm' id
 -- Buttons (new version ) --
 ----------------------------

+-- Bemerke: Back Button Widget implementierbar durch <button onclick="history.back()">_{MsgGenericBack}
+
 data family ButtonClass site :: Type

 class (PathPiece a, PathPiece (ButtonClass site), RenderMessage site ButtonMessage) => Button site a where
@ -391,7 +393,7 @@ class (PathPiece a, PathPiece (ButtonClass site), RenderMessage site ButtonMessa
  btnLabel = toWidget <=< ap getMessageRender . return

  btnValidate :: forall p. p site -> a -> Bool
-  btnValidate _ _ = True
+  btnValidate _ _ = True                          -- False will attach html attribute "formnovalidate", so that browsers do not validate the form data

  btnClasses :: a -> [ButtonClass site]
  btnClasses _ = []
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@ -308,6 +308,7 @@ makeLenses_ ''AuthorshipStatementDefinition
 makeLenses_ ''PrintJob

 makeLenses_ ''InterfaceLog
+-- makeLenses_ ''InterfaceLog -- not needed

 --------------------------
 -- Fields for `UniWorX` --
--- a/src/Utils/Print.hs
+++ b/src/Utils/Print.hs
@ -269,13 +269,17 @@ printLetter' pji pdf = do
      -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf   -- for PrintJobFile :: FileContentReference use this code
      printJobFile = LBS.toStrict pdf
      printJobAcknowledged = Nothing
+  qshort <- ifMaybeM printJobQualification "-" $ fmap (maybe "_" $ CI.original . qualificationShorthand ) . get
+  let logInter = flip (logInterface "Printer" qshort) (Just 1)
  lprPDF printJobFilename pdf >>= \case
    Left err -> do
+      logInter False err
      return $ Left err
    Right ok -> do
      printJobCreated <- liftIO getCurrentTime
      -- updateWhere [PrintJobLmsUser ==. printJobLmsUser] [PrintJobLmsUser =. Nothing] -- only one printJob per LmsUser is allowed, since otherwise the qualification table contains double rows
-      insert_ PrintJob {..}
+      insert_ PrintJob{..}
+      logInter True ok
      return $ Right (ok, printJobFilename)

 reprintPDF :: Bool -> PrintJobId -> DB (Either Text Text)
@ -283,13 +287,19 @@ reprintPDF ignoreReroute pjid = maybeM (return $ Left "Print job id is unknown."
  where 
    reprint :: PrintJob -> DB (Either Text Text)
    reprint pj@PrintJob{..} = do 
+      qshort <- ifMaybeM printJobQualification "-" $ fmap (maybe "_" $ CI.original . qualificationShorthand ) . get  
+      let logInter = flip (logInterface "Printer" qshort) (Just 1)
      result <- lprPDF' ignoreReroute printJobFilename $ LBS.fromStrict printJobFile
-      whenIsRight result $ const $ do 
-        now <- liftIO getCurrentTime        
-        insert_ pj{ printJobAcknowledged  = Nothing
-                  , printJobCreated       = now
-                  -- , printJobApcIdent      = ??? cannot be modified here, since it is included inside the PDF
-                  }
+      case result of
+        Left err -> 
+          logInter False err
+        Right m -> do
+          logInter True m
+          now <- liftIO getCurrentTime        
+          insert_ pj{ printJobAcknowledged  = Nothing
+                    , printJobCreated       = now
+                    -- , printJobApcIdent      = ??? cannot be modified here, since it is included inside the PDF
+                    }
      return result

 {-
--- a/templates/admin-problems.hamlet
+++ b/templates/admin-problems.hamlet
@ -56,8 +56,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
  <h2>
    _{MsgMenuInterfaces}  
  <div>
-    <p>
-      _{MsgProblemsInterfaceSince} ^{formatTimeW SelFormatDate cutOffOldTime}
+    <p> 
+      $if interfacesBadNr > 0
+        _{MsgInterfacesFail interfacesBadNr}
+      $else
+        _{MsgInterfacesOk}
    ^{interfaceTable}

 <!-- section h2 {MsgProblemsHeadingMisc} -->
--- a/templates/i18n/faq/campus-cant-login.de-de-formal.hamlet
+++ b/templates/i18n/faq/campus-cant-login.de-de-formal.hamlet
@ -8,19 +8,27 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 <p>
  Können sie sich mit <i>exakt identischen</i> (idealerweise #
  copy&paste) Daten #
-  im <a href="https://www.portal.uni-muenchen.de">Campus-Portal</a> #
+  im <a href="https://myapps.microsoft.com/">myapps.microsoft.com</a> #
  anmelden?

+  <br>
+  Falls sie die Fehlermeldung „Passwort abgelaufen“ oder "password-expired"  erhalten, #
+  dann befolgen Sie bitte #
+  <a href=^{faqLink FAQLoginExpired}>
+    diese Anleitung zum erneuern Ihres Passworts.
+
  <br>

  Falls nicht („_{InvalidLogin}“), ist davon auszugehen, dass Sie #
  Ihre Anmeldedaten falsch eingeben oder #
-  <a href=^{faqLink FAQNoCampusAccount}>keine LMU-Benutzerkennung #
-  (ehem. Campus-Kennung) besitzen</a>.
+  <a href=^{faqLink FAQNoCampusAccount}>keine gültige Fraport AG #
+  Benutzerkennung besitzen</a>. #
+  Rufen Sie in diesem Fall den allgemeinen Fraport IT-Helpdesk #
+  an unter <a href="tel:+49-69-690127">+49-69-690127</a>

 <p>
-  Beachten Sie dabei auch, dass Uni2work Leerzeichen sowohl im #
-  Passwort als auch bei der Kennung berücksichtigt.
+  Beachten Sie, dass Leerzeichen sowohl im #
+  Passwort als auch bei der Kennung berücksichtigt werden.

  <br>

@ -33,34 +41,27 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
  aktiviertem JavaScript), dass Sie Ihr Passwort korrekt eingeben.

 <p>
-  Uni2work bietet zwei Login-Formulare.
+  Uni2work bietet mehrere Login-Formulare.

  <br>

-  Für die Anmeldung mit der LMU-Benutzerkennung (ehem. Campus-Kennung) #
+  Für die Anmeldung mit Ihren Fraport AG Konto #
  müssen Sie das Formular „_{MsgLDAPLoginTitle}“ verwenden.

  <br>

-  Geben Sie unter „_{MsgCampusIdent}“ ihre vollständige #
-  LMU-Benutzerkennung an. #
-
-  Diese ist identisch mit ihrer <code>@campus.lmu.de</code> E-Mail #
-  Adresse.
-
+  
 <p>
-  Falls Sie seit Ihrem letzten Login in Uni2work ihr Passwort geändert #
+  Falls Sie Ihr Passwort kürzlich geändert #
  haben, kann es sein, dass die Änderung des Passworts (noch) nicht #
-  korrekt propagiert wurde.
+  korrekt propagiert wurde. Warten Sie einfach ein paar Minuten oder #
+  versuchen Sie, Ihr altes Passwort zu verwenden.

-  <br>
-
-  In diesem Fall können Sie versuchen Ihr Passwort erneut zu ändern.

 <p>
  Sobald Sie die obigen Hinweise befolgt haben, wenden Sie sich bitte #
  (erneut) über das <a href=@{HelpR}>Hilfe-Formular</a>, oben rechts #
-  auf jeder Seite, an die Uni2work-Administration.
+  auf jeder Seite, an die FRADrive-Administration.

  <br>

--- a/templates/i18n/faq/campus-cant-login.en-eu.hamlet
+++ b/templates/i18n/faq/campus-cant-login.en-eu.hamlet
@ -7,18 +7,29 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

 <p>
  Can you log in to #
-  the <a href="https://www.portal.uni-muenchen.de">Campus-Portal</a> #
+  the <a href="https://myapps.microsoft.com/">myapps.microsoft.com</a> #
  using the <i>exact same</i> (ideally copied & pasted) login data?

+  <br>
+  If you received the error message „Passwort abgelaufen“ or "password-expired" #
+  then please follow #
+  <a href=^{faqLink FAQLoginExpired}>
+    these instructions for password renewal.
+
  <br>

  If you cannot (“_{InvalidLogin}”), this means that you are #
  entering your login data wrong or that you #
-  <a href=^{faqLink FAQNoCampusAccount}>do not have a LMU user ID #
-  (formerly Campus-ID)</a>.
+  <a href=^{faqLink FAQNoCampusAccount}>
+    do not have a valid Fraport AG credentials.
+
+  <br>
+
+  In this case please call the general Fraport IT-Servicedesk 
+  at <a href="tel:+49-69-690127">+49-69-690127</a>

 <p>
-  Please consider that for Uni2work both your user ID and password are #
+  Please consider that for FRADrive both your user ID and password are #
  sensitive to whitespace characters.

  <br>
@ -37,31 +48,22 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
  password manager instead of typing it manually.

 <p>
-  Uni2work offers two login forms.
+ Furthermore, FRADrive offers several login forms. 

  <br>

-  To log in using your LMU user ID (formerly Campus-ID) you need to #
+  To log in using your Fraport AG credentials you need to #
  use the form titled “_{MsgLDAPLoginTitle}”.

-  <br>
-
-  Under “_{MsgCampusIdent}” please enter your entire LMU user ID, #
-  which is identical to your <code>@campus.lmu.de</code> email #
-  address.
-
 <p>
  If you have changed your password since last you logged into #
-  Uni2work, it may be the case that your password change was not #
-  propagated properly.
-
-  <br>
-
-  If so, please try changing your password again.
+  FRADrive, it may be the case that your password change was not #
+  propagated properly. Please wait a few minutes and try again, 
+  or try changing your password again.

 <p>
  Once you have followed the suggestions above, please contact a #
-  Uni2work-administrator using the <a href=@{HelpR}>Support form</a> #
+  FRADrive-administrator using the <a href=@{HelpR}>Support form</a> #
  (at the top right of every page).

  <br>
@ -73,4 +75,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

  Never disclose your password to third parties! #

-  Not even to an Uni2work-administrator or the IT-Servicedesk!
+  Not even to a FRADrive-administrator or the IT-Servicedesk!
--- a/templates/i18n/faq/course-correctors-tutors.de-de-formal.hamlet
+++ b/templates/i18n/faq/course-correctors-tutors.de-de-formal.hamlet
@ -1,10 +0,0 @@
-$newline never
-
-$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
-$#
-$# SPDX-License-Identifier: AGPL-3.0-or-later
-
-<p>
-  Ausbilder:innen und Korrektor:innen werden beim Anlegen oder Editieren des #
-  jeweiligen Kurses bzw. Übungsblattes angegeben.
-
--- a/templates/i18n/faq/course-correctors-tutors.en-eu.hamlet
+++ b/templates/i18n/faq/course-correctors-tutors.en-eu.hamlet
@ -1,9 +0,0 @@
-$newline never
-
-$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
-$#
-$# SPDX-License-Identifier: AGPL-3.0-or-later
-
-<p>
-  Instructors and correctors are assigned when creating or editing the #
-  respective course or exercise sheet.
--- a/templates/i18n/faq/exam-points.de-de-formal.hamlet
+++ b/templates/i18n/faq/exam-points.de-de-formal.hamlet
@ -1,14 +0,0 @@
-$newline never
-
-$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
-$#
-$# SPDX-License-Identifier: AGPL-3.0-or-later
-
-
-<p>
-  Klausurpunkte werden in Uni2work pro Teilaufgabe verwaltet.
-
-<p>
-  Um Klausurleistungen als Punkte anzugeben (und optional automatisch #
-  eine Note daraus zu berechnen), müssen Sie mindestens eine #
-  Teilprüfung/Aufgabe anlegen.
--- a/templates/i18n/faq/exam-points.en-eu.hamlet
+++ b/templates/i18n/faq/exam-points.en-eu.hamlet
@ -1,14 +0,0 @@
-$newline never
-
-$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
-$#
-$# SPDX-License-Identifier: AGPL-3.0-or-later
-
-
-<p>
-  Exam points are managed in Uni2work on a per-exam-part basis.
-
-<p>
-  To store exam achievements in the form of points (and optionally #
-  automatically compute grades), you need to create at least one #
-  exam part/question.
--- a/templates/i18n/faq/forgotten-password.de-de-formal.hamlet
+++ b/templates/i18n/faq/forgotten-password.de-de-formal.hamlet
@ -1,27 +1,16 @@
 $newline never

-$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+$# SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later


 <p>
-  Wenn Sie sich gewöhnlicherweise mit Ihrer LMU-Benutzerkennug #
-  (ehem. Campus-Kennung) anmelden, wenden Sie sich bitte an #
-  den <a href="https://www.it-servicedesk.uni-muenchen.de/faq/index.html#campuskennung-passwort-vergessen">IT-Servicedesk</a> #
-  um Ihr Passwort zurücksetzen zu lassen.
+  Wenn Sie Ihr Passwort vergessen haben, wenden Sie sich bitte an #
+  den allgemeinen Fraport IT-Helpdesk unter 
+  <a href="tel:+49-69-690127">
+    +49-69-690127

-<p>
-  Wenn Sie sich mit einer Uni2work-internen Kennung anmelden wenden #
-  Sie sich dafür bitte über das <a href=@{HelpR}>Hilfe-Formular</a> #
-  (oben rechts auf jeder Seite) an die Uni2work-Administration.
  <br>
-  Tragen sie dabei unter „Antworten an“ die Adresse ein, an die #
-  Uni2work gewöhnlicherweise Mitteilungen verschickt.
-  <br>
-  Bitte geben Sie zusätzlich mind. eine nicht-öffentliche #
-  personenbezogene Information an, um den Administrator:innen zu helfen #
-  die Anfrage zu authorisieren. #
-  
-  Geeignet ist z.B. die Matrikelnummer oder der ungefähre Zeitpunkt #
-  des letzten Logins.
+  Die FRADrive Administratoren können bei Login Problemen leider #
+  nicht helfen, da diese keinen Zugriff auf Ihren Fraport AG Account haben.
--- a/templates/i18n/faq/forgotten-password.en-eu.hamlet
+++ b/templates/i18n/faq/forgotten-password.en-eu.hamlet
@ -1,26 +1,17 @@
 $newline never

-$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
+$# SPDX-FileCopyrightText: 2024 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later


 <p>
-  If you usually log in using your LMU user ID (formerly Campus-ID) #
-  please contact #
-  the <a href="https://www.it-servicedesk.uni-muenchen.de/faq/index.html#campuskennung-passwort-vergessen">IT #
-  servicedesk (german)</a> to reset your password.
+  If you have forgotten your password #
+  please contact the general Fraport IT-servicedesk at #
+  <a href="tel:+49-69-690127">
+    +49-69-690127
+  to reset your password.

-<p>
-  If you log in using a Uni2work-internal account please use #
-  the <a href=@{HelpR}>Support form</a> (at the top right of every #
-  page) to contact a Uni2work-administrator.
  <br>
-  Specify the email to which Uni2work usually sends notifications #
-  under “Send answers to”.
-  <br>
-
-  Please also include at least one non-public piece of information to #
-  help authorise your request. #
-  We suggest your Matriculation number or the approximate time of your #
-  last successful login.
+  FRADrive administrators have no access to your Frapot AG account #
+  and thus cannot help you with this problem.
--- a/templates/i18n/faq/invalid-credentials-ad-account-disabled.de-de-formal.hamlet
+++ b/templates/i18n/faq/invalid-credentials-ad-account-disabled.de-de-formal.hamlet
@ -1,22 +0,0 @@
-$newline never
-
-$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
-$#
-$# SPDX-License-Identifier: AGPL-3.0-or-later
-
-
-<p>
-  Gewöhnlicherweise wird Ihr Benutzereintrag gesperrt, wenn sie #
-  exmatrikuliert werden bzw. Ihr Beschäftigungsverhältnis endet. #
-
-  Es kommt gelegentlich vor, dass Ihr Benutzereintrag nicht korrekt #
-  entsperrt wird, wenn Sie wieder immatrikuliert bzw. eingestellt #
-  werden.
-  
-<p>
-  Falls Sie aktuell immatrikuliert bzw. eingestellt sind, oder Sie #
-  einen anderen triftigen Grund vorweisen können, warum Sie Zugang zu #
-  Uni2work brauchen, wenden Sie sich bitte über #
-  das <a href=@{HelpR}>Hilfe-Formular</a>, oben rechts auf jeder #
-  Seite, an die Uni2work-Administration und schildern Sie Ihre #
-  Situation.
--- a/templates/i18n/faq/invalid-credentials-ad-account-disabled.en-eu.hamlet
+++ b/templates/i18n/faq/invalid-credentials-ad-account-disabled.en-eu.hamlet
@ -1,19 +0,0 @@
-$newline never
-
-$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
-$#
-$# SPDX-License-Identifier: AGPL-3.0-or-later
-
-
-<p>
-  Usually your account is disabled once you are no longer matriculated #
-  (i.e. registered as a student) or employed. #
-
-  Occasionally accounts are not correctly re-enabled once you are #
-  matriculated or employed, again.
-
-<p>
-  If you are currently matriculated, employed, or have another good #
-  reason why you should have access to Uni2work, please contact a #
-  Uni2work-Administrator using the <a href=@{HelpR}>Support form</a> #
-  (at the top right of every page) and describe your situation.
--- a/templates/i18n/faq/login-expired.de-de-formal.hamlet
+++ b/templates/i18n/faq/login-expired.de-de-formal.hamlet
@ -0,0 +1,47 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+
+<p>
+  Der Zugang zu FRADrive erfolgt über Ihren Fraport AG Login. #
+  Das Passwort für Ihren Fraport AG Login muss alle 90 Tage geändert werden. #
+  Tun Sie dies nicht, so können Sie sich nicht mehr einloggen. #
+  Dies besagen die Richtlininen der Fraport AG IT Abteilung.
+
+<p>
+  Bevor oder auch nachdem Ihr Passwort abgelaufen ist, #
+  können Sie das Passwort ganze leicht selbst mit einer #
+  der folgenden Methoden ändern: #
+
+  <ol>
+    <li>
+      Über #
+      <a href="https://account.activedirectory.windowsazure.com/ChangePassword.aspx">
+        das Azure Portal
+      .
+    <li>
+      Über Ihre #
+      <a href="https://myaccount.microsoft.com/?ref=MeControl">
+        Microsoft Kontoseite
+      . Verwenden Sie dort die Funktion "Kennwort ändern".
+    <li>
+      Über Ihre Profil-Einstellungen "Konto-Anzeigen" auf #
+      <a href="https://myapps.microsoft.com/">
+        Ihre Microsoft My-Apps Seite
+      .
+
+<p>
+  <b>
+    Hinweis: #
+
+  Wenden Sie sich bei Problemen mit dem Passwortwechsel #
+  bitte direkt an den allgemeinen Fraport IT-Helpdesk unter #
+  <a href="tel:+49-69-690127">
+    +49-69-690127
+
+  <br>
+  Die FRADrive Administratoren können bei diesem Login Problem leider #
+  nicht helfen, da diese keinen Zugriff auf Ihren Fraport AG Account haben.
--- a/templates/i18n/faq/login-expired.en-eu.hamlet
+++ b/templates/i18n/faq/login-expired.en-eu.hamlet
@ -0,0 +1,46 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+
+<p>
+  Using FRADrive required a Fraport AG account. #
+  The password for your Fraport AG account must be changed every 90 days. #
+  Following the general IT safety guidelines of Fraport AG, #
+  your login will be temporarily disabled otherwise.
+
+<p>
+  Regardless of whether your password has already expired or not, #
+  you may easily change your password with any one of the following methods: #
+
+  <ol>
+    <li>
+      Via #
+      <a href="https://account.activedirectory.windowsazure.com/ChangePassword.aspx">
+        the azure portal
+      .
+    <li>
+      Using you #
+      <a href="https://myaccount.microsoft.com/?ref=MeControl">
+        Microsoft account page
+      , then using the function "change password" there.
+    <li>
+      By accessing your profile settings on #
+      <a href="https://myapps.microsoft.com/">
+        your Microsoft My-Apps page
+      .
+
+<p>
+  <b>
+    Please note: #
+
+  If you have any problem changing your password #
+  please call the general Fraport IT-servicedesk at #
+  <a href="tel:+49-69-690127">
+    +49-69-690127
+
+  <br>
+  FRADrive administrators have no access to your Frapot AG account #
+  and thus cannot help you with this problem.
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@ -684,9 +684,22 @@ fillDb = do
              ++ take 444 [ UserSupervisor fhamann uid True  | Entity uid _ <-          matUsers, uid /= jost]
              ++ take 123 [ UserSupervisor gkleen  uid True  | Entity uid _ <- drop 369 matUsers ]
              ++ take  11 [ UserSupervisor jost    uid False | Entity uid _ <- drop 501 matUsers ]
-  upsertManyWhere supvs [] [] [] 
-  -- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok  
-  -- insertMany_ supvs              -- NOTE: multiple calls like this throw an error!
+  upsertManyWhere supvs [] [] []   
+  -- insertMany_ supvs              -- NOTE: multiple calls like this throw a runtime error!
+  -- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok
+  -- upsertManyWhere (supvs ++ take  5 (drop 12 [ UserSupervisor jost    uid False | Entity uid _ <- drop 501 matUsers ])) -- no duplicates within first argument allowed! (runtime error: ON CONFLICT DO UPDATE command cannot affect row a second time)
+  --                       [copyField UserSupervisorRerouteNotifications] [UserSupervisorRerouteNotifications =. True] [UserSupervisorSupervisor ==. jost, UserSupervisorUser <-. [uid | Entity uid _ <- take 3 $ drop 504 matUsers ]] -- does not work!
+  -- let changeSome usr@(UserSupervisor s u _) 
+  --       | s == jost, u `elem` take 14 [ uid | Entity uid _ <- drop 501 matUsers ] = UserSupervisor s u True
+  --       | otherwise = usr
+  -- upsertManyWhere (changeSome <$> (supvs ++ take  5 (drop 12 [ UserSupervisor jost    uid False | Entity uid _ <- drop 501 matUsers ]))) -- no duplicates within first argument allowed! (runtime error: ON CONFLICT DO UPDATE command cannot affect row a second time)
+  --                      [copyField UserSupervisorRerouteNotifications] [] [UserSupervisorSupervisor ==. jost, UserSupervisorUser <-. [uid | Entity uid _ <- take 3 $ drop 504 matUsers ]] -- probably does the same as the above
+  -- OBSERVATIONS: 
+  --   - use the 2. argument with `copyField` to overwrite an existing field with the new record value provided in the 1. argument in case of an update
+  --   - use the 3. argument to update a field indepently from the provided records or for computations involving previous values, eg. +=.
+  --   - use the 4. argument to filter both the application of the 2. and 3. argument
+
+  

  ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional (Just ifiAuthorshipStatement) True SchoolAuthorshipStatementModeRequired (Just ifiAuthorshipStatement) False
  mi  <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True