fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(avs): add problem resolver for unknown avs driving licences

Browse Source
This commit is contained in:
Steffen Jost 2022-12-14 14:50:35 +01:00
parent a890179d81
commit f8d20cd9c8
12 changed files with 85 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/categories/admin/de-de-formal.msg
View File

@ -112,4 +112,5 @@ ProblemsUnreachableBody: Benutzer ohne E-Mail oder Postadresse, welche z.B. bei
ProblemsRWithoutFHeading: Fahrer mit R ohne F 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: ProblemsRWithoutFBody: Diese Fahrer sind wegen einer ungültigen Vorfeld-Fahrberechtigung komplett gesperrt, obwohl eine gültige Rollfeld-Fahrberechtigung besteht:
ProblemsNoAvsIdHeading: Fahrer ohne AVS-Id 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: 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

3
messages/uniworx/categories/admin/en-eu.msg
View File

@ -112,4 +112,5 @@ ProblemsUnreachableBody: Users without Email nor postal address, who thus cannot
ProblemsRWithoutFHeading: Drivers having 'R' but not 'F' 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: ProblemsRWithoutFBody: Drivers without apron driving licence are prohibited from driving, even if they own a valid maneuvering driving licence:
ProblemsNoAvsIdHeading: Drivers without AVS id 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: 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

6
messages/uniworx/categories/avs/de-de-formal.msg
View File

@ -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 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 AvsTitleLicenceSynch: Abgleich Fahrberechtigungen zwischen AVS und FRADrive
BtnRevokeAvsLicences: Fahrberechtigungen im AVS sofort entziehen BtnRevokeAvsLicences: Fahrberechtigungen im AVS sofort entziehen
BtnImportUnknownAvsIds: Daten unbekannter Personen importieren 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.

6
messages/uniworx/categories/avs/en-eu.msg
View File

@ -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 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 AvsTitleLicenceSynch: Synchronisation driving licences between AVS and FRADrive
BtnRevokeAvsLicences: Revoke AVS driving licences immediately BtnRevokeAvsLicences: Revoke AVS driving licences immediately
BtnImportUnknownAvsIds: Import unknown person data 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.

4
routes
View File

@ -67,10 +67,12 @@
/admin/tokens AdminTokensR GET POST /admin/tokens AdminTokensR GET POST
/admin/crontab AdminCrontabR GET /admin/crontab AdminCrontabR GET
/admin/avs AdminAvsR GET POST /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-contact ProblemUnreachableR GET
/admin/problems/no-avs-id ProblemWithoutAvsId GET /admin/problems/no-avs-id ProblemWithoutAvsId GET
/admin/problems/r-without-f ProblemFbutNoR GET /admin/problems/r-without-f ProblemFbutNoR GET
/admin/problems/avs ProblemAvsSynchR GET POST
/print PrintCenterR GET POST !system-printer /print PrintCenterR GET POST !system-printer
/print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer /print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer

8
src/Foundation/Navigation.hs
View File

@ -114,9 +114,11 @@ breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just
breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR
breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR
breadcrumb AdminLdapR = i18nCrumb MsgMenuLdap $ Just AdminR breadcrumb AdminLdapR = i18nCrumb MsgMenuLdap $ Just AdminR
breadcrumb ProblemUnreachableR = i18nCrumb MsgProblemsUnreachableHeading $Just AdminR breadcrumb AdminProblemsR = i18nCrumb MsgProblemsHeading $ Just AdminR
breadcrumb ProblemWithoutAvsId = i18nCrumb MsgProblemsNoAvsIdHeading $ Just AdminR breadcrumb ProblemUnreachableR = i18nCrumb MsgProblemsUnreachableHeading $ Just AdminProblemsR
breadcrumb ProblemFbutNoR = i18nCrumb MsgProblemsRWithoutFHeading $ Just AdminR breadcrumb ProblemWithoutAvsId = i18nCrumb MsgProblemsNoAvsIdHeading $ Just AdminProblemsR
breadcrumb ProblemFbutNoR = i18nCrumb MsgProblemsRWithoutFHeading $ Just AdminProblemsR
breadcrumb ProblemAvsSynchR = i18nCrumb MsgProblemsAvsSynchHeading $ Just AdminProblemsR
breadcrumb PrintCenterR = i18nCrumb MsgMenuApc Nothing breadcrumb PrintCenterR = i18nCrumb MsgMenuApc Nothing
breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR

5
src/Handler/Admin.hs
View File

@ -33,7 +33,10 @@ import Handler.Admin.Ldap as Handler.Admin
getAdminR :: Handler Html getAdminR :: Handler Html
getAdminR = do getAdminR = redirect AdminProblemsR
getAdminProblemsR :: Handler Html
getAdminProblemsR = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let nowaday = utctDay now let nowaday = utctDay now
cutOffPrintDays = 7 cutOffPrintDays = 7

53
src/Handler/Admin/Avs.hs
View File

@ -5,9 +5,8 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Handler.Admin.Avs module Handler.Admin.Avs
( getAdminAvsR ( getAdminAvsR, postAdminAvsR
, postAdminAvsR , getProblemAvsSynchR, postProblemAvsSynchR
, getQualificationSynchR, postQualificationSynchR
) where ) where
import Import 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) deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonAvsSynch instance Universe ButtonAvsSynch
instance Finite ButtonAvsSynch instance Finite ButtonAvsSynch
@ -269,14 +268,19 @@ instance Button UniWorX ButtonAvsSynch where
btnClasses BtnRevokeAvsLicences = [BCIsButton, BCDanger] btnClasses BtnRevokeAvsLicences = [BCIsButton, BCDanger]
postQualificationSynchR, getQualificationSynchR :: Handler Html postProblemAvsSynchR, getProblemAvsSynchR :: Handler Html
postQualificationSynchR = getQualificationSynchR postProblemAvsSynchR = getProblemAvsSynchR
getQualificationSynchR = do getProblemAvsSynchR = do
-- TODO: just for Testing -- TODO: just for Testing
now <- liftIO getCurrentTime -- now <- liftIO getCurrentTime
let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now) -- let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now)
setTo0 = Set.fromList [AvsPersonId hours, AvsPersonId minutes] -- setTo0 = Set.fromList [AvsPersonId hours, AvsPersonId minutes]
-- (setTo0, _setTo1, _setTo2) <- retrieveDifferingLicences
(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 -> unknownLicenceOwners' <- whenNonEmpty setTo0 $ \neZeros ->
runDB $ E.select $ do runDB $ E.select $ do
(toZero :& usrAvs) <- X.from $ (toZero :& usrAvs) <- X.from $
@ -286,18 +290,25 @@ getQualificationSynchR = do
pure toZero pure toZero
let unknownLicenceOwners = E.unValue <$> unknownLicenceOwners' let unknownLicenceOwners = E.unValue <$> unknownLicenceOwners'
numUnknownLicenceOwners = length unknownLicenceOwners numUnknownLicenceOwners = length unknownLicenceOwners
(btnUnknownWgt, btnUnknownRes) <- runButtonFormHash (hash unknownLicenceOwners) FIDAbsUnknownLicences (btnUnknownWgt, btnUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDAbsUnknownLicences
case btnUnknownRes of 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 () 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? -- move elsewhere?
-- let dbtIdent = "drivingLicenceSynch" :: Text -- let dbtIdent = "drivingLicenceSynch" :: Text

12
src/Utils/Form.hs
View File

@ -565,11 +565,11 @@ runButtonForm' btns fid = do
-- | like runButtonForm, but may include a hash value enclosed in a hidden field to ensure -- | 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 -- 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) , RenderMessage site (ValueRequired site)
, Button site ButtonSubmit, Button site a, Finite a) , Button site ButtonSubmit, Button site a, Finite a)
=> Int -> ident -> HandlerT site IO (WidgetT site IO (), Maybe a) => h -> ident -> HandlerT site IO (WidgetT site IO (), Maybe a)
runButtonFormHash hVal fid = do runButtonFormHash (hash -> hVal) fid = do
currentRoute <- getCurrentRoute currentRoute <- getCurrentRoute
let bForm = disambiguateButtons $ combinedButtonFieldF "" let bForm = disambiguateButtons $ combinedButtonFieldF ""
hForm = areq hiddenField "" $ Just hVal hForm = areq hiddenField "" $ Just hVal
@ -580,8 +580,10 @@ runButtonFormHash hVal fid = do
, formSubmit = FormNoSubmit , formSubmit = FormNoSubmit
} }
res <- formResultMaybe btnResult $ \case res <- formResultMaybe btnResult $ \case
(_, rVal) | rVal /= hVal -> addMessageI Error MsgBtnFormOutdated (_, rVal) | rVal /= hVal -> do
>> return Nothing addMessageI Error MsgBtnFormOutdated
whenIsJust currentRoute redirect -- redirect needed to reset hidden-field
return Nothing
(btn, _ ) -> return $ Just btn (btn, _ ) -> return $ Just btn
return (btnForm, res) return (btnForm, res)

6
templates/admin-problems.hamlet
View File

@ -19,13 +19,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
$of Right (ok0,ok1,ok2) $of Right (ok0,ok1,ok2)
<dt .deflist__dt>^{flagNonZero ok2} <dt .deflist__dt>^{flagNonZero ok2}
<dd .deflist__dd>_{MsgProblemsDriverSynch2} <dd .deflist__dd>^{simpleLinkI MsgProblemsDriverSynch2 ProblemAvsSynchR}
<dt .deflist__dt>^{flagNonZero ok1} <dt .deflist__dt>^{flagNonZero ok1}
<dd .deflist__dd>_{MsgProblemsDriverSynch1} <dd .deflist__dd>^{simpleLinkI MsgProblemsDriverSynch1 ProblemAvsSynchR}
<dt .deflist__dt>^{flagNonZero ok0} <dt .deflist__dt>^{flagNonZero ok0}
<dd .deflist__dd>_{MsgProblemsDriverSynch0} <dd .deflist__dd>^{simpleLinkI MsgProblemsDriverSynch0 ProblemAvsSynchR}
<dt .deflist__dt>^{flagWarning rDriversHaveFs} <dt .deflist__dt>^{flagWarning rDriversHaveFs}
<dd .deflist__dd>^{simpleLinkI MsgProblemsRDriversHaveFs ProblemFbutNoR} <dd .deflist__dd>^{simpleLinkI MsgProblemsRDriversHaveFs ProblemFbutNoR}

12
templates/i18n/avs-synchronisation/de-de-formal.hamlet
View File

@ -7,21 +7,27 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<section> <section>
<h2> <h2>
AVS Fahrberechtigte, welche FRADrive unbekannt sind AVS Fahrberechtigte, welche FRADrive unbekannt sind
$if numUnknownLicenceOwners > 0 $if numUnknownLicenceOwners > 0
<p> <p>
Es wurden #{length unknownLicenceOwners} Es wurden #{length unknownLicenceOwners} Personen mit
Personen mit einer Fahrberechtigung im AVS gefunden, einer Fahrberechtigung im AVS gefunden,
welche FRADrive unbekannt sind. welche FRADrive unbekannt sind.
^{btnUnknownWgt}
<p>
Option 1: Option 1:
Personendaten aus dem AVS importeren, Fahrberechtigungen in AVS und FRADrive bleiben dabei erst einmal unverändert, 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. d.h. der Konflikt muss danach noch im nächsten Abschnitt aufgelöst werden.
<p>
Option 2: Option 2:
Fahrberechtigungen all dieser Personen im AVS entziehen. Fahrberechtigungen all dieser Personen im AVS entziehen.
$else $else
<p> <p>
Die Personendaten aller Fahrberechtigten im AVS sind FRADrive derzeit bekannt. Die Personendaten aller Fahrberechtigten im AVS sind FRADrive derzeit bekannt.

14
templates/i18n/avs-synchronisation/en-eu.hamlet
View File

@ -4,15 +4,14 @@ $# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
$# $#
$# SPDX-License-Identifier: AGPL-3.0-or-later $# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de> <h1>
$# Please use GERMAN translation of this page for now. Below is outdated. TODO.
$# SPDX-License-Identifier: AGPL-3.0-or-later
<section> <section>
<h2> <h2>
AVS Fahrberechtigte, welche FRADrive unbekannt sind AVS Fahrberechtigte, welche FRADrive unbekannt sind
$if numUnknownLicenceOwners > 0 $if numUnknownLicenceOwners > 0
<p> <p>
Es wurden #{length unknownLicenceOwners} Es wurden #{length unknownLicenceOwners}
@ -21,14 +20,17 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
^{btnUnknownWgt} ^{btnUnknownWgt}
<p>
Option 1: Option 1:
Personendaten aus dem AVS importeren, Fahrberechtigungen in AVS und FRADrive bleiben dabei erst einmal unverändert, 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. d.h. der Konflikt muss danach noch im nächsten Abschnitt aufgelöst werden.
<p>
Option 2: Option 2:
Fahrberechtigungen all dieser Personen im AVS entziehen. Fahrberechtigungen all dieser Personen im AVS entziehen.
$else $else
<p> <p>
Die Personendaten aller Fahrberechtigten im AVS sind FRADrive derzeit bekannt. Die Personendaten aller Fahrberechtigten im AVS sind FRADrive derzeit bekannt.