chore(avs): flag AVS R-holders about to be revoked
- flag on admin problem view - exempt from automatic avs licence synch for levels below 3
This commit is contained in:
parent
000d8100db
commit
760b102d52
@ -121,6 +121,7 @@ ProblemsNoAvsIdBody: Fahrer mit gültiger Fahrberechtigung in FRADrive, welche t
|
||||
ProblemsAvsSynchHeading: Synchronisation AVS Fahrberechtigungen
|
||||
ProblemsAvsErrorHeading: Fehlermeldungen
|
||||
ProblemsInterfaceSince: Berücksichtigt werden nur Erfolge und Fehler seit
|
||||
ProblemAvsUsrHadR: Momentan gültiges R im AVS
|
||||
|
||||
AdminProblemSolved: Erledigt
|
||||
AdminProblemSolver: Bearbeitet von
|
||||
|
||||
@ -120,7 +120,8 @@ 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:
|
||||
ProblemsAvsSynchHeading: Synchronisation AVS Driving Licences
|
||||
ProblemsAvsErrorHeading: Error Log
|
||||
ProblemsInterfaceSince: Only considering successes and errors since
|
||||
ProblemsInterfaceSince: Only considering successes and errors since
|
||||
ProblemAvsUsrHadR: Currenlt R valid in AVS
|
||||
|
||||
AdminProblemSolved: Done
|
||||
AdminProblemSolver: Solved by
|
||||
|
||||
@ -93,7 +93,7 @@ handleAdminProblems mbProblemTable = do
|
||||
diffLics <- try retrieveDifferingLicences >>= \case
|
||||
-- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received"
|
||||
(Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException)
|
||||
(Right AvsLicenceDifferences{..}) -> do
|
||||
(Right (AvsLicenceDifferences{..},_)) -> do
|
||||
let problemIds = avsLicenceDiffRevokeAll <> avsLicenceDiffGrantVorfeld <> avsLicenceDiffRevokeRollfeld <> avsLicenceDiffGrantRollfeld
|
||||
void $ runDB $ queueAvsUpdateByAID problemIds $ Just nowaday
|
||||
return $ Right
|
||||
@ -104,7 +104,7 @@ handleAdminProblems mbProblemTable = do
|
||||
)
|
||||
-- Attempt to format results in a nicer way failed, since rendering Html within a modal destroyed the page layout itself
|
||||
-- let procDiffLics (to0, to1, to2) = Right (Set.size to0, Set.size to1, Set.size to2)
|
||||
-- diffLics <- (procDiffLics <$> retrieveDifferingLicences) `catches`
|
||||
-- diffLics <- (procDiffLics . fst <$> 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)
|
||||
|
||||
@ -378,8 +378,8 @@ postProblemAvsSynchR = getProblemAvsSynchR
|
||||
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; do not call redirect within catchAllAvs actions!
|
||||
(AvsLicenceDifferences{..}, apidStatus) <- catchAllAvs' AdminR retrieveDifferingLicencesStatus
|
||||
|
||||
((AvsLicenceDifferences{..}, rsChanged), apidStatus) <- catchAllAvs' AdminR retrieveDifferingLicencesStatus
|
||||
let mkLicTbl = mkLicenceTable apidStatus rsChanged
|
||||
--
|
||||
unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros ->
|
||||
runDB $ E.select $ do
|
||||
@ -434,10 +434,10 @@ getProblemAvsSynchR = do
|
||||
|
||||
-- licence differences
|
||||
((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
|
||||
<$> mkLicenceTable apidStatus "avsLicDiffRevokeVorfeld" AvsLicenceVorfeld avsLicenceDiffRevokeAll
|
||||
<*> mkLicenceTable apidStatus "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
|
||||
<*> mkLicenceTable apidStatus "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld
|
||||
<*> mkLicenceTable apidStatus "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld
|
||||
<$> mkLicTbl "avsLicDiffRevokeVorfeld" AvsLicenceVorfeld avsLicenceDiffRevokeAll
|
||||
<*> mkLicTbl "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
|
||||
<*> mkLicTbl "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld -- downgrade to Vorfeld
|
||||
<*> mkLicTbl "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
let procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler ()
|
||||
@ -528,9 +528,11 @@ instance HasUser LicenceTableData where
|
||||
-- instance HasQualificationUser LicenceTableData where -- Not possible, since not all rows have a QualificationUser
|
||||
-- hasQualificationUser = resultQualUser . _entityVal
|
||||
|
||||
mkLicenceTable :: AvsPersonIdMapPersonCard -> Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
||||
mkLicenceTable apidStatus dbtIdent aLic apids = do
|
||||
currentRoute <- fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute
|
||||
mkLicenceTable :: AvsPersonIdMapPersonCard -> Set AvsPersonId -> Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
||||
mkLicenceTable apidStatus rsChanged dbtIdent aLic apids = do
|
||||
(currentRoute, usrHasAvsRerr) <- liftHandler $ (,)
|
||||
<$> (fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute)
|
||||
<*> (messageTooltip <$> messageI Error MsgProblemAvsUsrHadR)
|
||||
avsQualifications <- selectList [QualificationAvsLicence !=. Nothing] [Asc QualificationName]
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
@ -571,7 +573,18 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
|
||||
(\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmUsersR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
|
||||
pure $ intercalate (text2widget "; ") companies
|
||||
, sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe lmsShortCell q
|
||||
, sortable (Just "qualification") (i18nCell MsgTableQualifications) $
|
||||
if aLic /= AvsLicenceVorfeld
|
||||
then
|
||||
\(preview resultQualification -> q) -> cellMaybe lmsShortCell q
|
||||
else
|
||||
\row ->
|
||||
let q = row ^? resultQualification
|
||||
apid = row ^. resultUserAvs . _userAvsPersonId
|
||||
warnCell c = if Set.member apid rsChanged
|
||||
then c <> spacerCell <> wgtCell usrHasAvsRerr -- expected to be effectively dead code in practice, but we never know
|
||||
else c
|
||||
in warnCell $ cellMaybe lmsShortCell q
|
||||
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d
|
||||
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> cellMaybe dayCell d
|
||||
-- , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \(preview $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> cellMaybe dayCell d
|
||||
|
||||
@ -903,20 +903,20 @@ avsLicenceDifferences2personLicences AvsLicenceDifferences{..} =
|
||||
<> Set.map (AvsPersonLicence AvsLicenceRollfeld) avsLicenceDiffGrantRollfeld
|
||||
|
||||
computeDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonLicence)
|
||||
computeDifferingLicences = fmap avsLicenceDifferences2personLicences . getDifferingLicences
|
||||
computeDifferingLicences = fmap (avsLicenceDifferences2personLicences . fst) . getDifferingLicences
|
||||
|
||||
type AvsPersonIdMapPersonCard = Map AvsPersonId (Set AvsDataPersonCard)
|
||||
|
||||
avsResponseStatusMap :: AvsResponseStatus -> AvsPersonIdMapPersonCard
|
||||
avsResponseStatusMap (AvsResponseStatus status) = Map.fromDistinctAscList [(avsStatusPersonID,avsStatusPersonCardStatus) | AvsStatusPerson{..}<- Set.toAscList status]
|
||||
|
||||
retrieveDifferingLicences :: Handler AvsLicenceDifferences
|
||||
retrieveDifferingLicences :: Handler (AvsLicenceDifferences, Set AvsPersonId)
|
||||
retrieveDifferingLicences = fst <$> retrieveDifferingLicences' False
|
||||
|
||||
retrieveDifferingLicencesStatus :: Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
|
||||
retrieveDifferingLicencesStatus :: Handler ((AvsLicenceDifferences, Set AvsPersonId), AvsPersonIdMapPersonCard)
|
||||
retrieveDifferingLicencesStatus = retrieveDifferingLicences' True
|
||||
|
||||
retrieveDifferingLicences' :: Bool -> Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
|
||||
retrieveDifferingLicences' :: Bool -> Handler ((AvsLicenceDifferences, Set AvsPersonId), AvsPersonIdMapPersonCard)
|
||||
retrieveDifferingLicences' getStatus = do
|
||||
#ifdef DEVELOPMENT
|
||||
avsUsrs <- runDB $ selectList [] [LimitTo 444]
|
||||
@ -926,7 +926,9 @@ retrieveDifferingLicences' getStatus = do
|
||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 5 -- AVS:1 FD:0 (nichts)
|
||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 2 -- AVS:1 FD:0 (ungültig)
|
||||
-- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1
|
||||
] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
|
||||
] ++ [AvsPersonLicence (bool AvsLicenceRollfeld AvsLicenceVorfeld $ even $ avsPersonId avsid) avsid
|
||||
| Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs
|
||||
]
|
||||
#else
|
||||
allLicences <- avsQueryNoCache AvsQueryGetAllLicences
|
||||
#endif
|
||||
@ -942,7 +944,7 @@ retrieveDifferingLicences' getStatus = do
|
||||
] <>
|
||||
[ AvsStatusPerson avsid $ Set.singleton $ mkAdpc (even $ avsPersonId avsid) AvsCardColorGelb | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs ]
|
||||
#else
|
||||
let statQry = avsLicenceDifferences2LicenceIds lDiff
|
||||
let statQry = avsLicenceDifferences2LicenceIds $ fst lDiff
|
||||
lStat <- if getStatus && notNull statQry
|
||||
then avsQueryNoCache (AvsQueryStatus statQry)
|
||||
-- `catch` handler
|
||||
@ -954,7 +956,7 @@ retrieveDifferingLicences' getStatus = do
|
||||
return (lDiff, avsResponseStatusMap lStat)
|
||||
|
||||
|
||||
getDifferingLicences :: AvsResponseGetLicences -> Handler AvsLicenceDifferences
|
||||
getDifferingLicences :: AvsResponseGetLicences -> Handler (AvsLicenceDifferences, Set AvsPersonId)
|
||||
getDifferingLicences (AvsResponseGetLicences licences) = do
|
||||
now <- liftIO getCurrentTime
|
||||
--let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld) licences
|
||||
@ -998,12 +1000,14 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
|
||||
setTo1up = vorfGrant Set.\\ rollGrant -- grant apron driving licence
|
||||
setTo1down = rollRevoke Set.\\ vorfRevoke -- revoke maneuvering area licence, but retain apron driving licence
|
||||
setTo2 = (rollGrant Set.\\ vorfRevoke) `Set.intersection` (vorfGrant `Set.union` vorORrollfeld) -- grant maneuvering driving licence
|
||||
return AvsLicenceDifferences
|
||||
{ avsLicenceDiffRevokeAll = setTo0
|
||||
, avsLicenceDiffGrantVorfeld = setTo1up
|
||||
, avsLicenceDiffRevokeRollfeld = setTo1down
|
||||
, avsLicenceDiffGrantRollfeld = setTo2
|
||||
}
|
||||
rsChanged = rollfeld `Set.intersection` Set.unions [vorfRevoke, rollRevoke, setTo1up] -- maneuvering driving licences to downgrade in AVS
|
||||
alds = AvsLicenceDifferences
|
||||
{ avsLicenceDiffRevokeAll = setTo0
|
||||
, avsLicenceDiffGrantVorfeld = setTo1up
|
||||
, avsLicenceDiffRevokeRollfeld = setTo1down
|
||||
, avsLicenceDiffGrantRollfeld = setTo2
|
||||
}
|
||||
return (alds, rsChanged)
|
||||
{- Cases to consider (AVS_Licence,has_valid_F, has_valid_R) -> (vorfeld@(toset,unset), rollfeld@(toset,unset)) :
|
||||
A (0,0,0) -> ((_,_),(_,_)) : nop; avs_id not returned from queries, no problem
|
||||
B (0,0,1) -> ((_,_),(x,_)) : nop; do nothing -- CHECK since id is returned by roll-query
|
||||
|
||||
@ -151,9 +151,12 @@ dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel
|
||||
when (oks > 0) $ logit $ toMaybe (oks /= n) [st|Only #{tshow oks}/#{tshow n} licence changes accepted by AVS|]
|
||||
| otherwise = return ()
|
||||
|
||||
AvsLicenceDifferences{..} <- retrieveDifferingLicences
|
||||
when (synchLevel >= 4) $ procLic AvsLicenceRollfeld True avsLicenceDiffGrantRollfeld --grant Rollfeld
|
||||
when (synchLevel >= 3) $ procLic AvsLicenceVorfeld False avsLicenceDiffRevokeRollfeld --downgrade Rollfeld -> Vorfeld
|
||||
when (synchLevel >= 2) $ procLic AvsLicenceVorfeld True avsLicenceDiffGrantVorfeld --grant Vorfeld
|
||||
when (synchLevel >= 1) $ procLic AvsNoLicence False avsLicenceDiffRevokeAll --revoke Vorfeld & Rollfeld
|
||||
(AvsLicenceDifferences{..}, rsChanged) <- retrieveDifferingLicences
|
||||
let mbRemoveRs
|
||||
| synchLevel >= 3 = id
|
||||
| otherwise = flip Set.difference rsChanged
|
||||
when (synchLevel >= 1) $ procLic AvsNoLicence False $ mbRemoveRs avsLicenceDiffRevokeAll --revoke Vorfeld and maybe also Rollfeld
|
||||
when (synchLevel >= 2) $ procLic AvsLicenceVorfeld True $ mbRemoveRs avsLicenceDiffGrantVorfeld --grant Vorfeld
|
||||
when (synchLevel >= 3) $ procLic AvsLicenceVorfeld False avsLicenceDiffRevokeRollfeld --downgrade Rollfeld -> Vorfeld
|
||||
when (synchLevel >= 4) $ procLic AvsLicenceRollfeld True avsLicenceDiffGrantRollfeld --grant Rollfeld
|
||||
|
||||
|
||||
@ -35,7 +35,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<p>
|
||||
^{tb2}
|
||||
<h3>
|
||||
Fahrbrechtigung Rollfeld ungültig in FRADrive, aber im AVS vorhanden
|
||||
Fahrbrechtigung Rollfeld ungültig in FRADrive, aber im AVS vorhanden und Fahrberechtigung Vorfeld gültig in FRADrive
|
||||
<p>
|
||||
^{tb1down}
|
||||
<h3>
|
||||
@ -43,7 +43,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<p>
|
||||
^{tb1up}
|
||||
<h3>
|
||||
Keine gültige Fahrberechtigung in FRADrive, aber im AVS vorhanden
|
||||
Keine gültige Fahrberechtigung in FRADrive, aber im AVS vorhanden (Roll- oder Vorfeld)
|
||||
<p>
|
||||
^{tb0}
|
||||
|
||||
@ -35,7 +35,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<p>
|
||||
^{tb2}
|
||||
<h3>
|
||||
Maneuvering area driving licence 'R' invalid in FRADrive, but valid in AVS
|
||||
Maneuvering area driving licence 'R' invalid in FRADrive, but valid in AVS and having a valid 'F' in FRADrive
|
||||
<p>
|
||||
^{tb1down}
|
||||
<h3>
|
||||
@ -43,6 +43,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<p>
|
||||
^{tb1up}
|
||||
<h3>
|
||||
No valid driving licence in FRADrive, but having a driving licence in AVS
|
||||
No valid driving licence in FRADrive, but having any driving licence in AVS (maneuvering or apron)
|
||||
<p>
|
||||
^{tb0}
|
||||
|
||||
Reference in New Issue
Block a user