diff --git a/messages/uniworx/categories/admin/de-de-formal.msg b/messages/uniworx/categories/admin/de-de-formal.msg index 0a02c699e..3de34f94f 100644 --- a/messages/uniworx/categories/admin/de-de-formal.msg +++ b/messages/uniworx/categories/admin/de-de-formal.msg @@ -112,4 +112,5 @@ ProblemsUnreachableBody: Benutzer ohne E-Mail oder Postadresse, welche z.B. bei 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 +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: +ProblemsAvsSynchHeading: Synchronisation AVS Fahrberechtigungen diff --git a/messages/uniworx/categories/admin/en-eu.msg b/messages/uniworx/categories/admin/en-eu.msg index 1f346e598..37cca0d0f 100644 --- a/messages/uniworx/categories/admin/en-eu.msg +++ b/messages/uniworx/categories/admin/en-eu.msg @@ -112,4 +112,5 @@ ProblemsUnreachableBody: Users without Email nor postal address, who thus cannot 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 +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: +ProblemsAvsSynchHeading: Synchronisation AVS Driving Licences diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg index 10e6d43cc..eed6dc367 100644 --- a/messages/uniworx/categories/avs/de-de-formal.msg +++ b/messages/uniworx/categories/avs/de-de-formal.msg @@ -15,4 +15,8 @@ AvsLicence: Fahrberechtigung AvsPersonNoNotId: AVS Personennummer dient zur menschlichen Kommunikation mit der Ausweisstelle und darf nicht verwechselt werden mit der maschinell verwendeten AVS Personen Id AvsTitleLicenceSynch: Abgleich Fahrberechtigungen zwischen AVS und FRADrive BtnRevokeAvsLicences: Fahrberechtigungen im AVS sofort entziehen -BtnImportUnknownAvsIds: Daten unbekannter Personen importieren \ No newline at end of file +BtnImportUnknownAvsIds: Daten unbekannter Personen importieren +AvsImportIDs n@Int m@Int: AVS Persondendaten importiert: #{show n}/#{show m} +RevokeUnknownLicencesOk: AVS Fahrberechtigungen unbekannter Fahrer wurden gesperrt +RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer konnten entzogen werden, siehe Log für Details +AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler. \ No newline at end of file diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg index a7c3fa30f..7b8d76d99 100644 --- a/messages/uniworx/categories/avs/en-eu.msg +++ b/messages/uniworx/categories/avs/en-eu.msg @@ -15,4 +15,8 @@ AvsLicence: Driving Licence AvsPersonNoNotId: AVS person number is used in human communication only and must not be mistaken for the AVS personen id used in machine communications AvsTitleLicenceSynch: Synchronisation driving licences between AVS and FRADrive BtnRevokeAvsLicences: Revoke AVS driving licences immediately -BtnImportUnknownAvsIds: Import unknown person data \ No newline at end of file +BtnImportUnknownAvsIds: Import unknown person data +AvsImportIDs n m: AVS person daten importet: #{show n}/#{show m} +RevokeUnknownLicencesOk: AVS driving licences of unknown drivers revoked +RevokeUnknownLicencesFail: Not all AVS driving licences of unknown drivers could be revoked, see log for details +AvsCommunicationError: AVS interface returned an unexpected error. \ No newline at end of file diff --git a/routes b/routes index d95ee57ef..259feb9a7 100644 --- a/routes +++ b/routes @@ -67,10 +67,12 @@ /admin/tokens AdminTokensR GET POST /admin/crontab AdminCrontabR GET /admin/avs AdminAvsR GET POST -/admin/ldap AdminLdapR GET POST +/admin/ldap AdminLdapR GET POST +/admin/problems AdminProblemsR GET /admin/problems/no-contact ProblemUnreachableR GET /admin/problems/no-avs-id ProblemWithoutAvsId GET /admin/problems/r-without-f ProblemFbutNoR GET +/admin/problems/avs ProblemAvsSynchR GET POST /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 583273cd2..898c3833d 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -114,9 +114,11 @@ breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just 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 AdminProblemsR = i18nCrumb MsgProblemsHeading $ Just AdminR +breadcrumb ProblemUnreachableR = i18nCrumb MsgProblemsUnreachableHeading $ Just AdminProblemsR +breadcrumb ProblemWithoutAvsId = i18nCrumb MsgProblemsNoAvsIdHeading $ Just AdminProblemsR +breadcrumb ProblemFbutNoR = i18nCrumb MsgProblemsRWithoutFHeading $ Just AdminProblemsR +breadcrumb ProblemAvsSynchR = i18nCrumb MsgProblemsAvsSynchHeading $ Just AdminProblemsR breadcrumb PrintCenterR = i18nCrumb MsgMenuApc Nothing breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 4fe634943..94d6e2e29 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -33,7 +33,10 @@ import Handler.Admin.Ldap as Handler.Admin getAdminR :: Handler Html -getAdminR = do +getAdminR = redirect AdminProblemsR + +getAdminProblemsR :: Handler Html +getAdminProblemsR = do now <- liftIO getCurrentTime let nowaday = utctDay now cutOffPrintDays = 7 diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 0075a3652..0cc52111d 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -5,9 +5,8 @@ {-# LANGUAGE TypeApplications #-} module Handler.Admin.Avs - ( getAdminAvsR - , postAdminAvsR - , getQualificationSynchR, postQualificationSynchR + ( getAdminAvsR, postAdminAvsR + , getProblemAvsSynchR, postProblemAvsSynchR ) where import Import @@ -256,7 +255,7 @@ type SynchDBRow = (E.Value AvsPersonId, E.Value AvsLicence, Entity Qualification -} -data ButtonAvsSynch = BtnRevokeAvsLicences | BtnImportUnknownAvsIds +data ButtonAvsSynch = BtnImportUnknownAvsIds | BtnRevokeAvsLicences deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) instance Universe ButtonAvsSynch instance Finite ButtonAvsSynch @@ -269,14 +268,19 @@ instance Button UniWorX ButtonAvsSynch where btnClasses BtnRevokeAvsLicences = [BCIsButton, BCDanger] -postQualificationSynchR, getQualificationSynchR :: Handler Html -postQualificationSynchR = getQualificationSynchR -getQualificationSynchR = do +postProblemAvsSynchR, getProblemAvsSynchR :: Handler Html +postProblemAvsSynchR = getProblemAvsSynchR +getProblemAvsSynchR = do -- TODO: just for Testing - now <- liftIO getCurrentTime - let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now) - setTo0 = Set.fromList [AvsPersonId hours, AvsPersonId minutes] - -- (setTo0, _setTo1, _setTo2) <- retrieveDifferingLicences + -- now <- liftIO getCurrentTime + -- let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now) + -- setTo0 = Set.fromList [AvsPersonId hours, AvsPersonId minutes] + + (setTo0, _setTo1, _setTo2) <- try retrieveDifferingLicences >>= \case + Right res -> return res + Left err -> do addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) + redirect AdminR + unknownLicenceOwners' <- whenNonEmpty setTo0 $ \neZeros -> runDB $ E.select $ do (toZero :& usrAvs) <- X.from $ @@ -286,18 +290,25 @@ getQualificationSynchR = do pure toZero let unknownLicenceOwners = E.unValue <$> unknownLicenceOwners' numUnknownLicenceOwners = length unknownLicenceOwners - (btnUnknownWgt, btnUnknownRes) <- runButtonFormHash (hash unknownLicenceOwners) FIDAbsUnknownLicences + (btnUnknownWgt, btnUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDAbsUnknownLicences case btnUnknownRes of - (Just BtnImportUnknownAvsIds) -> addMessage Info "UnknownAvsIds pressed." - -- do - -- let procAid = (Sum . (maybe 0 (const 1))) <$> upsertAvsUserById - -- oks <- getSum <$> foldMapM procAid unknownLicenceOwners - -- let ms = if oks == numUnkownLicenceOwners then Info else Warning - -- addMessageI ms $ MsgAvsImportIDs oks - - - (Just BtnRevokeAvsLicences) -> addMessage Info "Revoke Avs Licences pressed." Nothing -> return () + (Just BtnImportUnknownAvsIds) -> do + let procAid = fmap (Sum . maybe 0 (const 1)) <$> upsertAvsUserById + res <- try (getSum <$> foldMapM procAid unknownLicenceOwners) + case res of + Right oks -> do + let ms = if oks == numUnknownLicenceOwners then Info else Warning + addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners + redirect ProblemAvsSynchR + Left err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) + (Just BtnRevokeAvsLicences) -> + try (setLicencesAvs $ Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners) + >>= \case + Right True -> addMessageI Info MsgRevokeUnknownLicencesOk + Right False -> addMessageI Error MsgRevokeUnknownLicencesFail + Left err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) + >> redirect ProblemAvsSynchR -- move elsewhere? -- let dbtIdent = "drivingLicenceSynch" :: Text diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 4aef3c423..cf05d5ec1 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -565,11 +565,11 @@ runButtonForm' btns fid = do -- | like runButtonForm, but may include a hash value enclosed in a hidden field to ensure -- that the button press still applies to the correct situation -runButtonFormHash ::(PathPiece ident, Eq ident, RenderAFormSite site +runButtonFormHash ::( Hashable h, PathPiece ident, Eq ident, RenderAFormSite site , RenderMessage site (ValueRequired site) , Button site ButtonSubmit, Button site a, Finite a) - => Int -> ident -> HandlerT site IO (WidgetT site IO (), Maybe a) -runButtonFormHash hVal fid = do + => h -> ident -> HandlerT site IO (WidgetT site IO (), Maybe a) +runButtonFormHash (hash -> hVal) fid = do currentRoute <- getCurrentRoute let bForm = disambiguateButtons $ combinedButtonFieldF "" hForm = areq hiddenField "" $ Just hVal @@ -580,8 +580,10 @@ runButtonFormHash hVal fid = do , formSubmit = FormNoSubmit } res <- formResultMaybe btnResult $ \case - (_, rVal) | rVal /= hVal -> addMessageI Error MsgBtnFormOutdated - >> return Nothing + (_, rVal) | rVal /= hVal -> do + addMessageI Error MsgBtnFormOutdated + whenIsJust currentRoute redirect -- redirect needed to reset hidden-field + return Nothing (btn, _ ) -> return $ Just btn return (btnForm, res) diff --git a/templates/admin-problems.hamlet b/templates/admin-problems.hamlet index 8a5a5337d..4f16c1042 100644 --- a/templates/admin-problems.hamlet +++ b/templates/admin-problems.hamlet @@ -19,13 +19,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later $of Right (ok0,ok1,ok2)
^{flagNonZero ok2} -
_{MsgProblemsDriverSynch2} +
^{simpleLinkI MsgProblemsDriverSynch2 ProblemAvsSynchR}
^{flagNonZero ok1} -
_{MsgProblemsDriverSynch1} +
^{simpleLinkI MsgProblemsDriverSynch1 ProblemAvsSynchR}
^{flagNonZero ok0} -
_{MsgProblemsDriverSynch0} +
^{simpleLinkI MsgProblemsDriverSynch0 ProblemAvsSynchR}
^{flagWarning rDriversHaveFs}
^{simpleLinkI MsgProblemsRDriversHaveFs ProblemFbutNoR} diff --git a/templates/i18n/avs-synchronisation/de-de-formal.hamlet b/templates/i18n/avs-synchronisation/de-de-formal.hamlet index e511d2c83..7e8ead8be 100644 --- a/templates/i18n/avs-synchronisation/de-de-formal.hamlet +++ b/templates/i18n/avs-synchronisation/de-de-formal.hamlet @@ -7,21 +7,27 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

- AVS Fahrberechtigte, welche FRADrive unbekannt sind + AVS Fahrberechtigte, welche FRADrive unbekannt sind + $if numUnknownLicenceOwners > 0

- Es wurden #{length unknownLicenceOwners} - Personen mit einer Fahrberechtigung im AVS gefunden, + Es wurden #{length unknownLicenceOwners} Personen mit + einer Fahrberechtigung im AVS gefunden, welche FRADrive unbekannt sind. + ^{btnUnknownWgt} + +

Option 1: Personendaten aus dem AVS importeren, Fahrberechtigungen in AVS und FRADrive bleiben dabei erst einmal unverändert, d.h. der Konflikt muss danach noch im nächsten Abschnitt aufgelöst werden. +

Option 2: Fahrberechtigungen all dieser Personen im AVS entziehen. + $else

Die Personendaten aller Fahrberechtigten im AVS sind FRADrive derzeit bekannt. diff --git a/templates/i18n/avs-synchronisation/en-eu.hamlet b/templates/i18n/avs-synchronisation/en-eu.hamlet index 6ded32437..1daaba579 100644 --- a/templates/i18n/avs-synchronisation/en-eu.hamlet +++ b/templates/i18n/avs-synchronisation/en-eu.hamlet @@ -4,15 +4,14 @@ $# SPDX-FileCopyrightText: 2022 Steffen Jost $# $# SPDX-License-Identifier: AGPL-3.0-or-later - -$# SPDX-FileCopyrightText: 2022 Steffen Jost -$# -$# SPDX-License-Identifier: AGPL-3.0-or-later - +

+

+ Please use GERMAN translation of this page for now. Below is outdated. TODO.

- AVS Fahrberechtigte, welche FRADrive unbekannt sind + AVS Fahrberechtigte, welche FRADrive unbekannt sind + $if numUnknownLicenceOwners > 0

Es wurden #{length unknownLicenceOwners} @@ -21,14 +20,17 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later ^{btnUnknownWgt} +

Option 1: Personendaten aus dem AVS importeren, Fahrberechtigungen in AVS und FRADrive bleiben dabei erst einmal unverändert, d.h. der Konflikt muss danach noch im nächsten Abschnitt aufgelöst werden. +

Option 2: Fahrberechtigungen all dieser Personen im AVS entziehen. + $else

Die Personendaten aller Fahrberechtigten im AVS sind FRADrive derzeit bekannt.