chore(avs): fix #21
This commit is contained in:
Steffen Jost
parent
b97c28413b
commit
71c141a08d
@ -17,6 +17,8 @@ AvsTitleLicenceSynch: Abgleich Fahrberechtigungen zwischen AVS und FRADrive
|
||||
BtnRevokeAvsLicences: Fahrberechtigungen im AVS sofort entziehen
|
||||
BtnImportUnknownAvsIds: Daten unbekannter Personen importieren
|
||||
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
|
||||
AvsSetLicences alic@AvsLicence n@Int m@Int: _{alic} im AVS gesetzt: #{show n}/#{show m}
|
||||
RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} in FRADrive zum Vortag beendet für #{show n} Fahrer
|
||||
RevokeUnknownLicencesOk: AVS Fahrberechtigungen unbekannter Fahrer wurden gesperrt
|
||||
|
||||
@ -17,6 +17,8 @@ AvsTitleLicenceSynch: Synchronisation driving licences between AVS and FRADrive
|
||||
BtnRevokeAvsLicences: Revoke AVS driving licences immediately
|
||||
BtnImportUnknownAvsIds: Import unknown person data
|
||||
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
|
||||
AvsSetLicences alic n m: _{alic} set in AVS: #{show n}/#{show m}
|
||||
RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} now ended yesterday in FRADrive for #{show n} drivers
|
||||
RevokeUnknownLicencesOk: AVS driving licences of unknown drivers revoked
|
||||
|
||||
@ -308,18 +308,18 @@ postProblemAvsSynchR = getProblemAvsSynchR
|
||||
getProblemAvsSynchR = do
|
||||
now <- liftIO getCurrentTime
|
||||
let nowaday = utctDay now
|
||||
|
||||
catchAllAvs = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect ProblemAvsSynchR)
|
||||
-- TODO: just for Testing
|
||||
-- let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now)
|
||||
-- avsLicenceDiffRevokeAll = Set.fromList [AvsPersonId hours, AvsPersonId minutes]
|
||||
-- avsLicenceDiffGrantVorfeld = Set.fromList [AvsPersonId minutes]
|
||||
-- avsLicenceDiffRevokeRollfeld = Set.fromList [AvsPersonId hours, AvsPersonId 12345678]
|
||||
-- avsLicenceDiffGrantRollfeld = Set.fromList [AvsPersonId hours]
|
||||
let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now)
|
||||
avsLicenceDiffRevokeAll = Set.fromList [AvsPersonId hours, AvsPersonId minutes]
|
||||
avsLicenceDiffGrantVorfeld = Set.fromList [AvsPersonId minutes]
|
||||
avsLicenceDiffRevokeRollfeld = Set.fromList [AvsPersonId hours, AvsPersonId 12345678]
|
||||
avsLicenceDiffGrantRollfeld = Set.fromList [AvsPersonId hours]
|
||||
|
||||
AvsLicenceDifferences{..} <- try retrieveDifferingLicences >>= \case
|
||||
Right res -> return res
|
||||
Left err -> do addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
|
||||
redirect AdminR
|
||||
-- AvsLicenceDifferences{..} <- try retrieveDifferingLicences >>= \case
|
||||
-- Right res -> return res
|
||||
-- Left err -> do addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
|
||||
-- redirect AdminR
|
||||
-- unknowns
|
||||
unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros ->
|
||||
runDB $ E.select $ do
|
||||
@ -333,23 +333,29 @@ getProblemAvsSynchR = do
|
||||
(btnUnknownWgt, btnUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDAbsUnknownLicences
|
||||
case btnUnknownRes of
|
||||
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) -> do
|
||||
(Just BtnImportUnknownAvsIds) -> catchAllAvs $ do
|
||||
res <- forM unknownLicenceOwners $ try . upsertAvsUserById
|
||||
let procRes (Right _) = (Sum 1, mempty, mempty, mempty)
|
||||
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) = (Sum 0, mempty, mempty, Set.singleton 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
|
||||
try (setLicencesAvs revokes) >>= \case
|
||||
Right no_ok | no_ok < no_revokes -> addMessageI Error MsgRevokeUnknownLicencesFail
|
||||
| otherwise -> addMessageI Info MsgRevokeUnknownLicencesOk
|
||||
Left err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
|
||||
>> redirect ProblemAvsSynchR
|
||||
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 $ (,,,)
|
||||
<$> mkLicenceTable "avsLicDiffRevokeVorfeld" AvsNoLicence avsLicenceDiffRevokeAll (Just LicenceTableChangeAvs)
|
||||
@ -357,12 +363,11 @@ getProblemAvsSynchR = do
|
||||
<*> mkLicenceTable "avsLicDiffRevokeRollfeld" AvsNoLicence avsLicenceDiffRevokeRollfeld (Just LicenceTableChangeAvs)
|
||||
<*> mkLicenceTable "avsLicDiffGrantRollfeld" AvsLicenceRollfeld avsLicenceDiffGrantRollfeld (Just LicenceTableChangeAvs)
|
||||
let procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler ()
|
||||
procRes aLic (LicenceTableChangeAvsData , apids) = do
|
||||
try (setLicencesAvs $ Set.map (AvsPersonLicence aLic) apids) >>= \case
|
||||
(Right no_ok) -> let no_req = Set.size apids
|
||||
mkind = if no_ok < no_req then Warning else Success
|
||||
in addMessageI mkind $ MsgAvsSetLicences aLic no_ok no_req
|
||||
(Left err) -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
|
||||
procRes aLic (LicenceTableChangeAvsData , apids) = catchAllAvs $ do
|
||||
oks <- setLicencesAvs $ Set.map (AvsPersonLicence aLic) apids
|
||||
let no_req = Set.size apids
|
||||
mkind = if oks < no_req then Warning else Success
|
||||
addMessageI mkind $ MsgAvsSetLicences aLic oks no_req
|
||||
redirect ProblemAvsSynchR -- reload to update all tables
|
||||
procRes alic (LicenceTableRevokeFDriveData, apids) = do
|
||||
runDB $ do
|
||||
|
||||
@ -51,11 +51,11 @@ data AvsException
|
||||
= AvsInterfaceUnavailable -- Interface to AVS was not configured at startup or does not respond
|
||||
| AvsUserUnassociated UserId -- Manipulating AVS Data for a user that is not linked to AVS yet
|
||||
| AvsUserUnknownByAvs AvsPersonId -- AvsPersonId not (or no longer) found in AVS DB
|
||||
| AvsUserAmbiguous -- Multiple matching existing users found in our DB
|
||||
| AvsUserAmbiguous AvsPersonId -- Multiple matching existing users found in our DB
|
||||
| AvsPersonSearchEmpty -- AvsPersonSearch returned empty result
|
||||
| AvsPersonSearchAmbiguous -- AvsPersonSearch returned more than one result
|
||||
| AvsSetLicencesFailed Text -- AvsSetLicence total failure
|
||||
deriving (Show, Generic, Typeable)
|
||||
deriving (Show, Eq, Ord, Generic, Typeable)
|
||||
instance Exception AvsException
|
||||
|
||||
{-
|
||||
@ -322,7 +322,7 @@ upsertAvsUserById api = do
|
||||
candidates <- selectKeysList [UserCompanyPersonalNumber ==. Just persNo] []
|
||||
case candidates of
|
||||
[uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo)
|
||||
(_:_) -> throwM AvsUserAmbiguous
|
||||
(_:_) -> throwM $ AvsUserAmbiguous api
|
||||
[] -> do
|
||||
upsRes :: Either CampusUserConversionException (Entity User)
|
||||
<- try $ ldapLookupAndUpsert persNo
|
||||
|
||||
Loading…
Reference in New Issue
Block a user