Merge branch 'master' into fradrive/cr3

2024-02-13 10:16:40 +01:00 · 2024-02-13 10:16:40 +01:00 · ce4869f155
commit ce4869f155
parent 64797536e3 192c733749
36 changed files with 646 additions and 198 deletions
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -2,6 +2,23 @@

 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.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/uniworx/categories/admin/de-de-formal.msg
+++ b/messages/uniworx/categories/admin/de-de-formal.msg
@ -121,6 +121,13 @@ 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
+InterfaceWrite: Schreibend
+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,6 +121,13 @@ 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
+InterfaceWrite: Write
+InterfaceSuccess: Returned
+InterfaceInfo: Message
+InterfaceFreshness: Check hours
--- 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
 MenuProfile: Anpassen
 MenuLogin !ident-ok: Login
@ -145,6 +146,8 @@ MenuLdap: LDAP Schnittstelle
 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
 MenuProfile: Settings
 MenuLogin: Login
@ -145,6 +146,8 @@ MenuLdap: LDAP Interface
 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

--- a/nix/docker/version.json
+++ b/nix/docker/version.json
@ -1,3 +1,3 @@
 {
-  "version": "27.4.56"
+  "version": "27.4.58"
 }
--- a/package-lock.json
+++ b/package-lock.json
@ -1,6 +1,6 @@
 {
  "name": "uni2work",
-  "version": "27.4.56",
+  "version": "27.4.58",
  "lockfileVersion": 1,
  "requires": true,
  "dependencies": {
--- a/package.json
+++ b/package.json
@ -1,6 +1,6 @@
 {
  "name": "uni2work",
-  "version": "27.4.56",
+  "version": "27.4.58",
  "description": "",
  "keywords": [],
  "author": "",
--- a/package.yaml
+++ b/package.yaml
@ -1,5 +1,5 @@
 name: uniworx
-version: 27.4.56
+version: 27.4.58
 dependencies:
  - base
  - yesod
--- a/32
+++ b/32
@ -79,24 +79,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
@ -145,6 +145,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 is correct here, since we want to repalce the it
-  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 -- deleteBy & insert would be justified here, leading to a new Row-ID, since the two rows are not truly connected.
+  -- 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
@ -127,13 +127,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
@ -164,9 +165,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
@ -191,7 +193,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
@ -292,7 +294,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
@ -1333,6 +1335,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
@ -2367,7 +2380,7 @@ pageActions (LmsR sid qsh) = return
        [ defNavLink MsgMenuLmsUpload       $ LmsReportUploadR sid qsh
        , defNavLink MsgMenuLmsDirectUpload $ LmsReportDirectR sid qsh
        ]
-    }  
+    }
  , NavPageActionSecondary {
      navLink = defNavLink MsgMenuLmsEdit $ LmsEditR sid qsh
    }
@ -2392,7 +2405,7 @@ pageActions (FirmUsersR fsh) = return
  [ NavPageActionPrimary
    { navLink = defNavLink MsgTableCompanyNrSupers $ FirmSupersR fsh
    , navChildren = []
-    }  
+    }
  ]
 pageActions (FirmSupersR fsh) = return
  [ NavPageActionPrimary
@ -2435,10 +2448,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/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/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
@ -141,7 +141,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/Users.hs
+++ b/src/Handler/Utils/Users.hs
@ -189,7 +189,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')
      GuessUserEduPersonPrincipalName userEPPN'          -> user E.^. UserLdapPrimaryKey  E.==.          E.val (Just userEPPN')
      GuessUserDisplayName            userDisplayName'   -> user E.^. UserDisplayName    `containsAsSet` userDisplayName'
--- 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
@ -201,7 +201,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 ]
@ -222,7 +222,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)
@ -258,7 +258,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
@ -312,7 +312,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
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -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

@ -48,8 +48,9 @@ import qualified Data.Time.Zones as TZ

 data ManualMigration
  = Migration20230524QualificationUserBlock
-  | Migration20230703LmsUserStatus  
-  | Migration20240124UniquenessCompanyAvsNr
+  | Migration20230703LmsUserStatus    
+  | Migration20240212InitInterfaceHealth        -- create table interface_health and fill with default values
+  | Migration20240224UniquenessCompanyAvsNr  
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite)

@ -178,7 +179,26 @@ customMigrations = mapF $ \case
        ;  
      |]

-  Migration20240124UniquenessCompanyAvsNr ->
+  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; 
+      |]    
+
+  Migration20240224UniquenessCompanyAvsNr ->
    whenM (tableExists "company" `and2M` notM (indexExists "unique_company_avs_id")) $ do -- companies with avs_id == 0 can be deleted; company users are deleted automatically by cascade
      [executeQQ|
        DELETE FROM "company" WHERE avs_id = 0;
@ -186,7 +206,6 @@ customMigrations = mapF $ \case
      |]


-
 tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool
 tableExists table = do
  haveTable <- [sqlQQ| SELECT to_regclass(#{table}); |]
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -324,9 +324,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/Lens.hs
+++ b/src/Utils/Lens.hs
@ -312,6 +312,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} -->