chore(avs): add safety catch for revoke unknown avs licences
This commit is contained in:
Steffen Jost
parent
86d947f7e8
commit
06f283be7e
@ -14,8 +14,9 @@ AvsQueryStatusInvalid t@Text: Nur numerische IDs eingeben, durch Komma getrennt!
|
||||
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
|
||||
BtnAvsRevokeUnknown: Fahrberechtigungen im AVS sofort entziehen
|
||||
BtnAvsImportUnknown: AVS Daten unbekannter Personen importieren
|
||||
AvsRevokeFor n@Int: Sind Sie absolut sicher, dass Sie #{n} #{pluralDE n "unbekanntem Fahrer" "unbekannten Fahrern"} jegliche Fahrlizenz im AVS sofort entziehen wollen?
|
||||
AvsImportIDs n@Int m@Int: AVS Persondendaten importiert: #{show n}/#{show m}
|
||||
AvsImportAmbiguous n@Int: Import für #{show n} uneindeutige AVS IDs fehlgeschlagen
|
||||
AvsImportUnknowns n@Int: Import für #{show n} unbekannte AVS IDs fehlgeschlagen
|
||||
|
||||
@ -14,8 +14,9 @@ AvsQueryStatusInvalid t: Numeric IDs only, comma seperated! #{show t}
|
||||
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
|
||||
BtnAvsRevokeUnknown: Revoke AVS driving licences for unknown persons immediately
|
||||
BtnAvsImportUnknown: Import AVS data for unknown persons
|
||||
AvsRevokeFor n@Int: Are you sure to immediately revoke all apron driving licences for #{n} unknown #{pluralENs n "driver"}?
|
||||
AvsImportIDs n m: AVS person data imported: #{show n}/#{show m}
|
||||
AvsImportAmbiguous n@Int: Import failed for #{show n} ambiguous AVS Ids
|
||||
AvsImportUnknowns n@Int: Import failed for #{show n} unknown AVS Ids
|
||||
|
||||
@ -39,7 +39,7 @@ single :: (k,a) -> Map k a
|
||||
single = uncurry Map.singleton
|
||||
|
||||
|
||||
-- Button needed only here
|
||||
-- Button only needed in AVS TEST; further buttons see below
|
||||
data ButtonAvsTest = BtnCheckLicences | BtnSynchLicences
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonAvsTest
|
||||
@ -277,18 +277,24 @@ type SynchTableExpr = ( E.SqlExpr (E.Value AvsPersonId)
|
||||
type SynchDBRow = (E.Value AvsPersonId, E.Value AvsLicence, Entity Qualification, Entity QualificationUser, Entity User)
|
||||
-}
|
||||
|
||||
|
||||
data ButtonAvsSynch = BtnImportUnknownAvsIds | BtnRevokeAvsLicences
|
||||
-- Buttons only needed for AVS Synching
|
||||
data ButtonAvsImportUnknown = BtnAvsImportUnknown
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonAvsSynch
|
||||
instance Finite ButtonAvsSynch
|
||||
instance Universe ButtonAvsImportUnknown
|
||||
instance Finite ButtonAvsImportUnknown
|
||||
nullaryPathPiece ''ButtonAvsImportUnknown camelToPathPiece
|
||||
embedRenderMessage ''UniWorX ''ButtonAvsImportUnknown id
|
||||
instance Button UniWorX ButtonAvsImportUnknown where
|
||||
btnClasses BtnAvsImportUnknown = [BCIsButton, BCPrimary]
|
||||
|
||||
nullaryPathPiece ''ButtonAvsSynch camelToPathPiece
|
||||
embedRenderMessage ''UniWorX ''ButtonAvsSynch id
|
||||
|
||||
instance Button UniWorX ButtonAvsSynch where
|
||||
btnClasses BtnImportUnknownAvsIds = [BCIsButton, BCPrimary]
|
||||
btnClasses BtnRevokeAvsLicences = [BCIsButton, BCDanger]
|
||||
data ButtonAvsRevokeUnknown = BtnAvsRevokeUnknown
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonAvsRevokeUnknown
|
||||
instance Finite ButtonAvsRevokeUnknown
|
||||
nullaryPathPiece ''ButtonAvsRevokeUnknown camelToPathPiece
|
||||
embedRenderMessage ''UniWorX ''ButtonAvsRevokeUnknown id
|
||||
instance Button UniWorX ButtonAvsRevokeUnknown where
|
||||
btnClasses BtnAvsRevokeUnknown = [BCIsButton, BCDanger]
|
||||
|
||||
|
||||
data LicenceTableAction = LicenceTableChangeAvs
|
||||
@ -310,7 +316,7 @@ data LicenceTableActionData = LicenceTableChangeAvsData
|
||||
|
||||
postProblemAvsSynchR, getProblemAvsSynchR :: Handler Html
|
||||
postProblemAvsSynchR = getProblemAvsSynchR
|
||||
getProblemAvsSynchR = do
|
||||
getProblemAvsSynchR = do
|
||||
let catchAllAvs' r = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect r)
|
||||
catchAllAvs = catchAllAvs' ProblemAvsSynchR -- == current route; use only in conditions that are not repeated upon reload
|
||||
AvsLicenceDifferences{..} <- catchAllAvs' AdminR retrieveDifferingLicences
|
||||
@ -325,32 +331,47 @@ getProblemAvsSynchR = do
|
||||
pure toZero
|
||||
let unknownLicenceOwners = E.unValue <$> unknownLicenceOwners'
|
||||
numUnknownLicenceOwners = length unknownLicenceOwners
|
||||
(btnUnknownWgt, btnUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDAbsUnknownLicences
|
||||
case btnUnknownRes of
|
||||
Nothing -> return ()
|
||||
(Just BtnImportUnknownAvsIds) -> catchAllAvs $ do
|
||||
res <- forM (take 500 unknownLicenceOwners) $ try . upsertAvsUserById -- TODO: turn this into a background job
|
||||
let procRes (Right _) = (Sum 1, mempty :: Set.Set AvsPersonId, mempty :: Set.Set AvsPersonId, mempty)
|
||||
--TODO: continue here!
|
||||
--procRes (Left (AvsUserAmbiguous api)) = (Sum 0, Set.singleton api, mempty, mempty)
|
||||
--procRes (Left (AvsUserUnknownByAvs api)) = (Sum 0, mempty, Set.singleton api, mempty)
|
||||
procRes (Left (err :: SomeException)) = (Sum 0, mempty, mempty, Set.singleton $ tshow err)
|
||||
(Sum oks, ambis, unkns, errs) = foldMap procRes res
|
||||
ms = if oks == numUnknownLicenceOwners then Success else Warning
|
||||
unless (null ambis) $ addMessageModal Error (i18n $ MsgAvsImportAmbiguous $ length ambis) (Right (text2widget $ tshow ambis))
|
||||
unless (null unkns) $ addMessageModal Error (i18n $ MsgAvsImportUnknowns $ length unkns) (Right (text2widget $ tshow unkns))
|
||||
unless (null errs) $ addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow errs ))
|
||||
addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners
|
||||
redirect ProblemAvsSynchR
|
||||
|
||||
(Just BtnRevokeAvsLicences) -> catchAllAvs $ do
|
||||
let revokes = Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners
|
||||
no_revokes = Set.size revokes
|
||||
oks <- setLicencesAvs revokes
|
||||
if oks < no_revokes
|
||||
then addMessageI Error MsgRevokeUnknownLicencesFail
|
||||
else addMessageI Info MsgRevokeUnknownLicencesOk
|
||||
redirect ProblemAvsSynchR
|
||||
(btnImportUnknownWgt, btnImportUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDBtnAvsImportUnknown
|
||||
ifMaybeM btnImportUnknownRes () $ \BtnAvsImportUnknown -> catchAllAvs $ do
|
||||
res <- forM (take 500 unknownLicenceOwners) $ try . upsertAvsUserById -- TODO: turn this into a background job
|
||||
let procRes (Right _) = (Sum 1, mempty :: Set.Set AvsPersonId, mempty :: Set.Set AvsPersonId, mempty)
|
||||
--TODO: continue here!
|
||||
--procRes (Left (AvsUserAmbiguous api)) = (Sum 0, Set.singleton api, mempty, mempty)
|
||||
--procRes (Left (AvsUserUnknownByAvs api)) = (Sum 0, mempty, Set.singleton api, mempty)
|
||||
procRes (Left (err :: SomeException)) = (Sum 0, mempty, mempty, Set.singleton $ tshow err)
|
||||
(Sum oks, ambis, unkns, errs) = foldMap procRes res
|
||||
ms = if oks == numUnknownLicenceOwners then Success else Warning
|
||||
unless (null ambis) $ addMessageModal Error (i18n $ MsgAvsImportAmbiguous $ length ambis) (Right (text2widget $ tshow ambis))
|
||||
unless (null unkns) $ addMessageModal Error (i18n $ MsgAvsImportUnknowns $ length unkns) (Right (text2widget $ tshow unkns))
|
||||
unless (null errs) $ addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow errs ))
|
||||
addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners
|
||||
redirect ProblemAvsSynchR
|
||||
|
||||
(btnRevokeUnknownWgt, btnRevokeUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDBtnAvsRevokeUnknown
|
||||
let revokeUnknownExecWgt = btnRevokeUnknownWgt
|
||||
revokeUnknownSafetyWgt = [whamlet|
|
||||
<div .form-group >
|
||||
<div .form-group__input>
|
||||
<div .buttongroup>
|
||||
^{modalBtn}
|
||||
|]
|
||||
modalBtn = btnModal MsgBtnAvsRevokeUnknown (btnClasses BtnAvsRevokeUnknown) (Right youSureWgt)
|
||||
youSureWgt = [whamlet|
|
||||
<h1>
|
||||
_{MsgAvsRevokeFor (length unknownLicenceOwners)}
|
||||
<p>
|
||||
^{revokeUnknownExecWgt}
|
||||
|]
|
||||
|
||||
ifMaybeM btnRevokeUnknownRes () $ \BtnAvsRevokeUnknown -> catchAllAvs $ do
|
||||
let revokes = Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners
|
||||
no_revokes = Set.size revokes
|
||||
oks <- setLicencesAvs revokes
|
||||
if oks < no_revokes
|
||||
then addMessageI Error MsgRevokeUnknownLicencesFail
|
||||
else addMessageI Info MsgRevokeUnknownLicencesOk
|
||||
redirect ProblemAvsSynchR
|
||||
|
||||
-- licence differences
|
||||
((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
|
||||
|
||||
@ -297,15 +297,15 @@ data FormIdentifier
|
||||
| FIDLanguage
|
||||
| FIDExamAutoOccurrenceCalculate | FIDExamAutoOccurrenceConfirm | FIDExamAutoOccurrenceNudge UUID | FIDExamAutoOccurrenceIgnoreRoom UUID
|
||||
| FIDTestDownload
|
||||
| FIDLmsLetter
|
||||
| FIDAvsQueryPerson
|
||||
| FIDAvsQueryStatus
|
||||
| FIDAvsCreateUser
|
||||
| FIDAvsQueryLicenceDiffs
|
||||
| FIDAvsQueryLicence
|
||||
| FIDAvsSetLicence
|
||||
| FIDAvsRemoveLicences
|
||||
| FIDLmsLetter
|
||||
| FIDAbsUnknownLicences
|
||||
| FIDBtnAvsImportUnknown
|
||||
| FIDBtnAvsRevokeUnknown
|
||||
deriving (Eq, Ord, Read, Show)
|
||||
|
||||
instance PathPiece FormIdentifier where
|
||||
|
||||
@ -49,15 +49,15 @@ modal modalTrigger' modalContent = customModal Modal{..}
|
||||
modalTrigger mRoute triggerId = $(widgetFile "widgets/modal/trigger")
|
||||
|
||||
-- | Variant of `modal` that looks like a button
|
||||
btnModal :: (PathPiece (ButtonClass site))
|
||||
=> Text -- ^ Button Text
|
||||
btnModal :: (RenderMessage site a, PathPiece (ButtonClass site))
|
||||
=> a -- ^ Button Text
|
||||
-> [ButtonClass site] -- ^ Button class
|
||||
-> Either (SomeRoute site) (WidgetFor site ()) -- ^ Modal contant: either dynamic link or static widget
|
||||
-> WidgetFor site () -- ^ result widget
|
||||
btnModal btl bcs = modal fakeBtn
|
||||
where
|
||||
fakeBtn = [whamlet|<button :not (onull bcs):class=#{unwords $ map toPathPiece bcs}>
|
||||
#{btl}
|
||||
_{btl}
|
||||
|]
|
||||
|
||||
-- | Variant of `modal` for use in messages (uses a different id generator to avoid collisions)
|
||||
|
||||
@ -73,7 +73,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
Modal as button
|
||||
<ul>
|
||||
<li>^{modal btnModalText (Right "Noch ein Test-Inhalt für ein Button Modal")}
|
||||
<li>^{btnModal "Another Button" [BCIsButton, BCDanger] (Right "anderer Text")}
|
||||
<li>^{btnModal (text2message "Anderer Modal Knopf") [BCIsButton, BCDanger] (Right "anderer Text")}
|
||||
<li>
|
||||
Some icons: ^{isVisible False} ^{hasComment True}
|
||||
|
||||
|
||||
@ -67,8 +67,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
Modals:
|
||||
<ul>
|
||||
<li>^{modal "Click me for ajax test" (Left $ SomeRoute UsersR)}
|
||||
<li>^{modal "Click me for content test" (Right "Test Inhalt für Modal")}
|
||||
<li>^{modal "Click me for content test" (Right "Test message for this modal message")}
|
||||
<li>^{modal "Email-Test" (Right emailWidget')}
|
||||
<li>
|
||||
Modal as button
|
||||
<ul>
|
||||
<li>^{modal btnModalText (Right "Just another test message for a button bodal")}
|
||||
<li>^{btnModal (text2message "Yet another button") [BCIsButton, BCDanger] (Right "Yet another text")}
|
||||
<li>
|
||||
Some icons: ^{isVisible False} ^{hasComment True}
|
||||
|
||||
|
||||
@ -22,7 +22,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
Es gibt zwei Möglichkeiten zum Auflösen dieses Problems: #
|
||||
<p>
|
||||
^{btnUnknownWgt}
|
||||
^{btnImportUnknownWgt}^{revokeUnknownSafetyWgt}
|
||||
|
||||
$else
|
||||
<p>
|
||||
|
||||
@ -15,7 +15,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
There are two solutions to this problem: #
|
||||
<p>
|
||||
^{btnUnknownWgt}
|
||||
^{btnImportUnknownWgt}
|
||||
^{revokeUnknownSafetyWgt}
|
||||
|
||||
$else
|
||||
<p>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user