diff --git a/messages/uniworx/categories/admin/de-de-formal.msg b/messages/uniworx/categories/admin/de-de-formal.msg index 18693317d..1a6353160 100644 --- a/messages/uniworx/categories/admin/de-de-formal.msg +++ b/messages/uniworx/categories/admin/de-de-formal.msg @@ -95,8 +95,10 @@ TestDownloadDirect: Direkte Generierung TestDownloadInTransaction: Generierung während Datenbank-Transaktion TestDownloadFromDatabase: Generierung während Download aus Datenbank -ProblemsHeadingDrivers: Synchronisation Fahrberechtigungen mit Ausweisverwaltung -ProblemsAvsProblem e@Text: Synchronisation mit AVS/MoBaKo komplett fehlgeschlagen: #{e} +ProblemsHeading: Overview Problems +ProblemsHeadingDrivers: Fahrberechtigungen +ProblemsAvsProblem: Synchronisation mit AVS/MoBaKo komplett fehlgeschlagen +ProblemsDriverSynch n@Int: #{tshow n} Diskrepanzen zwischen AVS und FRADrive ProblemsDriverSynch0: Alle Sperrungen von Fahrberechtigungen sind im AVS eingetragen ProblemsDriverSynch1: Alle gültigen Vorfeld-Fahrberechtigungen 'F' sind im AVS eingetragen ProblemsDriverSynch2: Alle gültigen Rollfeld-Fahrberechtigungen 'R' sind im AVS eingetragen @@ -104,4 +106,10 @@ ProblemsRDriversHaveFs: Alle Inhaber einer Rollfeld-Fahrberechtigung besitzen au ProblemsDriversHaveAvsIds: Alle Inhaber einer Fahrberechtigung konnten einer AVS Identifikationsnummer zugeordnet werden ProblemsHeadingUsers: Allgemein ProblemsUsersAreReachable: Für alle Benutzer ist eine E-Mail oder postalische Adresse bekannt -ProblemsNoStalePrintJobs n@Integer: Alle Briefversandaufträge der vergangenen #{show n} Tage wurden von der Druckerei bestätigt \ No newline at end of file +ProblemsNoStalePrintJobs n@Integer: Alle Briefversandaufträge der vergangenen #{show n} Tage wurden von der Druckerei bestätigt +ProblemsUnreachableHeading: Unerreichbare Benutzer +ProblemsUnreachableBody: Benutzer ohne E-Mail oder Postadresse, welche z.B. bei ablaufenden Berechtigungen nicht benachrichtigt werden können: +ProblemsRWithoutFHeading: Fahrer mit R ohne F +ProblemsRWithoutFBody: Diese Fahrer sind wegen einer ungültigen Vorfeld-Fahrberechtigung komplett gesperrt, obwohl eine gültige Rollfeld-Fahrberechtigung besteht: +ProblemsNoAvsIdHeading: Fahrer ohne AVS-Id +ProblemsNoAvsIdBody: Fahrer mit gültiger Fahrberechtigung in FRADrive, welche trotzdem nicht fahren dürfen, da die Fahrberechtigung aufgrund einer unbekannten AVS Id nicht an die Ausweisstelle übermittelt werden konnte: \ No newline at end of file diff --git a/messages/uniworx/categories/admin/en-eu.msg b/messages/uniworx/categories/admin/en-eu.msg index bcde387b8..9a4e5ab52 100644 --- a/messages/uniworx/categories/admin/en-eu.msg +++ b/messages/uniworx/categories/admin/en-eu.msg @@ -95,8 +95,10 @@ TestDownloadDirect: Direct generation TestDownloadInTransaction: Generate during database transaction TestDownloadFromDatabase: Generate while streaming from database -ProblemsHeadingDrivers: Synchronisation of Driving Licences with Airport ID Card Center -ProblemsAvsProblem e: Synchronisation with AVS/MoBaKo failed entirely: #{e} +ProblemsHeading: Problemübersicht +ProblemsHeadingDrivers: Driving Licences +ProblemsAvsProblem: Synchronisation with AVS/MoBaKo failed entirely +ProblemsDriverSynch n: #{tshow n} mismatches between AVS and FRADrive ProblemsDriverSynch0: All revocations of driving licences were successfully registered with AVS ProblemsDriverSynch1: All valid apron driving licences 'F' were successfully registered with AVS ProblemsDriverSynch2: All valid maneuvering area driving licences 'R' were successfully registered with AVS @@ -104,4 +106,10 @@ ProblemsRDriversHaveFs: All driving licence 'R' holders also have a valid 'F' li ProblemsDriversHaveAvsIds: All driving licence holder could be matched with their AVS id ProblemsHeadingUsers: Miscellaneous ProblemsUsersAreReachable: Either Email or postal address is known for all users -ProblemsNoStalePrintJobs n: All requests for letter mailing within the last #{show n} days were acknowledged as printed by the airport printing center \ No newline at end of file +ProblemsNoStalePrintJobs n: All requests for letter mailing within the last #{show n} days were acknowledged as printed by the airport printing center +ProblemsUnreachableHeading: Unreachable Users +ProblemsUnreachableBody: Users without Email nor postal address, who thus cannot be notified about expiring qualifications: +ProblemsRWithoutFHeading: Drivers having 'R' but not 'F' +ProblemsRWithoutFBody: Drivers without apron driving licence are prohibited from driving, even if they own a valid maneuvering driving licence: +ProblemsNoAvsIdHeading: Drivers without AVS id +ProblemsNoAvsIdBody: Drivers having a valid apron driving licence within FRADrive only, but who may not drive since a missing AVS id prevents communication of the driving licence to AVS: \ No newline at end of file diff --git a/routes b/routes index 090b2585f..d95ee57ef 100644 --- a/routes +++ b/routes @@ -68,6 +68,9 @@ /admin/crontab AdminCrontabR GET /admin/avs AdminAvsR GET POST /admin/ldap AdminLdapR GET POST +/admin/problems/no-contact ProblemUnreachableR GET +/admin/problems/no-avs-id ProblemWithoutAvsId GET +/admin/problems/r-without-f ProblemFbutNoR GET /print PrintCenterR GET POST !system-printer /print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index b17708671..c376aa598 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -106,14 +106,17 @@ breadcrumb (UserPasswordR cID) = useRunDB $ do breadcrumb AdminNewFunctionaryInviteR = i18nCrumb MsgMenuLecturerInvite $ Just UsersR breadcrumb AdminFunctionaryInviteR = i18nCrumb MsgBreadcrumbFunctionaryInvite Nothing -breadcrumb AdminR = i18nCrumb MsgAdminHeading Nothing -breadcrumb AdminTestR = i18nCrumb MsgMenuAdminTest $ Just AdminR -breadcrumb AdminTestPdfR = i18nCrumb MsgMenuAdminTest $ Just AdminTestR -breadcrumb AdminErrMsgR = i18nCrumb MsgMenuAdminErrMsg $ Just AdminR -breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just AdminR -breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR -breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR -breadcrumb AdminLdapR = i18nCrumb MsgMenuLdap $ Just AdminR +breadcrumb AdminR = i18nCrumb MsgAdminHeading Nothing +breadcrumb AdminTestR = i18nCrumb MsgMenuAdminTest $ Just AdminR +breadcrumb AdminTestPdfR = i18nCrumb MsgMenuAdminTest $ Just AdminTestR +breadcrumb AdminErrMsgR = i18nCrumb MsgMenuAdminErrMsg $ Just AdminR +breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just AdminR +breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR +breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR +breadcrumb AdminLdapR = i18nCrumb MsgMenuLdap $ Just AdminR +breadcrumb ProblemUnreachableR = i18nCrumb MsgProblemsUnreachableHeading $Just AdminR +breadcrumb ProblemWithoutAvsId = i18nCrumb MsgProblemsNoAvsIdHeading $ Just AdminR +breadcrumb ProblemFbutNoR = i18nCrumb MsgProblemsRWithoutFHeading $ Just AdminR breadcrumb PrintCenterR = i18nCrumb MsgMenuApc Nothing breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 232d7cdf6..eb5efbf9f 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -8,12 +8,21 @@ module Handler.Admin import Import +-- import Data.Either +import qualified Data.Set as Set +-- import qualified Data.Text.Lazy.Encoding as LBS + +-- import qualified Control.Monad.Catch as Catch +-- import Servant.Client (ClientError(..), ResponseF(..)) +-- import Text.Blaze.Html (preEscapedToHtml) + import Database.Esqueleto.Experimental ((:&)(..)) import qualified Database.Esqueleto.Experimental as E import qualified Database.Esqueleto.Utils as E import Handler.Utils.DateTime import Handler.Utils.Avs +import Handler.Utils.Widgets import Handler.Admin.Test as Handler.Admin import Handler.Admin.ErrorMessage as Handler.Admin @@ -35,15 +44,79 @@ getAdminR = do <*> allRDriversHaveFs nowaday <*> (not <$> exists [PrintJobAcknowledged ==. Nothing, PrintJobCreated <=. cutOffPrintJob]) diffLics <- try retrieveDifferingLicences <&> \case - (Left e) -> Left $ tshow (e :: SomeException) - (Right (to0, to1, to2)) -> Right (null to0, null to1, null to2) + -- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received" + (Left e) -> Left $ text2widget $ tshow (e :: SomeException) + (Right (to0, to1, to2)) -> Right (Set.size to0, Set.size to1, Set.size to2) + -- let procDiffLics (to0, to1, to2) = Right (Set.size to0, Set.size to1, Set.size to2) + -- diffLics <- (procDiffLics <$> retrieveDifferingLicences) `catches` + -- [ Catch.Handler (\case (UnsupportedContentType "text/html;charset=utf-8" Response{responseBody}) + -- -> return $ Left $ toWidget $ preEscapedToHtml $ fromRight "Response UTF8-decoding error" $ LBS.decodeUtf8' responseBody + -- ex -> return $ Left $ text2widget $ tshow ex) + -- , Catch.Handler (\(ex::SomeException) -> return $ Left $ text2widget $ tshow ex) + -- ] + + -- we abuse messageTooltip for colored icons here + msgSuccessTooltip <- messageI Success MsgMessageSuccess + msgWarningTooltip <- messageI Warning MsgMessageWarning + msgErrorTooltip <- messageI Error MsgMessageError - siteLayoutMsg MsgAdminHeading $ do - setTitleI MsgAdminHeading - -- TODO: use MessageStatus for colored icons; hide long AVS errormessage in modal; count avs differences instead of simple bool + let flagError = messageTooltip . bool msgErrorTooltip msgSuccessTooltip + flagWarning = messageTooltip . bool msgWarningTooltip msgSuccessTooltip + flagNonZero :: Int -> Widget + flagNonZero n | n <= 0 = flagError True + | otherwise = messageTooltip =<< handlerToWidget (messageI Error (MsgProblemsDriverSynch n)) + + siteLayoutMsg MsgProblemsHeading $ do + setTitleI MsgProblemsHeading $(widgetFile "admin-problems") +getProblemUnreachableR :: Handler Html +getProblemUnreachableR = do + unreachables <- runDB $ E.select getUnreachableUsers + siteLayoutMsg MsgProblemsUnreachableHeading $ do + setTitleI MsgProblemsUnreachableHeading + [whamlet| +
+ _{MsgProblemsUnreachableBody} +