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

chore(avs): fix #21

Browse Source
This commit is contained in:
Steffen Jost 2022-12-22 17:13:29 +01:00
parent b97c28413b
commit 71c141a08d
4 changed files with 43 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -17,6 +17,8 @@ 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} 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} 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 RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} in FRADrive zum Vortag beendet für #{show n} Fahrer
RevokeUnknownLicencesOk: AVS Fahrberechtigungen unbekannter Fahrer wurden gesperrt RevokeUnknownLicencesOk: AVS Fahrberechtigungen unbekannter Fahrer wurden gesperrt

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

@ -17,6 +17,8 @@ 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 data imported: #{show n}/#{show m} 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} 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 RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} now ended yesterday in FRADrive for #{show n} drivers
RevokeUnknownLicencesOk: AVS driving licences of unknown drivers revoked RevokeUnknownLicencesOk: AVS driving licences of unknown drivers revoked

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

@ -308,18 +308,18 @@ postProblemAvsSynchR = getProblemAvsSynchR
getProblemAvsSynchR = do getProblemAvsSynchR = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let nowaday = utctDay now let nowaday = utctDay now
catchAllAvs = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect ProblemAvsSynchR)
-- TODO: just for Testing -- TODO: just for Testing
-- let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now) let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now)
-- avsLicenceDiffRevokeAll = Set.fromList [AvsPersonId hours, AvsPersonId minutes] avsLicenceDiffRevokeAll = Set.fromList [AvsPersonId hours, AvsPersonId minutes]
-- avsLicenceDiffGrantVorfeld = Set.fromList [AvsPersonId minutes] avsLicenceDiffGrantVorfeld = Set.fromList [AvsPersonId minutes]
-- avsLicenceDiffRevokeRollfeld = Set.fromList [AvsPersonId hours, AvsPersonId 12345678] avsLicenceDiffRevokeRollfeld = Set.fromList [AvsPersonId hours, AvsPersonId 12345678]
-- avsLicenceDiffGrantRollfeld = Set.fromList [AvsPersonId hours] avsLicenceDiffGrantRollfeld = Set.fromList [AvsPersonId hours]
AvsLicenceDifferences{..} <- try retrieveDifferingLicences >>= \case -- AvsLicenceDifferences{..} <- try retrieveDifferingLicences >>= \case
Right res -> return res -- Right res -> return res
Left err -> do addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) -- Left err -> do addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
redirect AdminR -- redirect AdminR
-- unknowns -- unknowns
unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros -> unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros ->
runDB $ E.select $ do runDB $ E.select $ do
@ -333,23 +333,29 @@ getProblemAvsSynchR = do
(btnUnknownWgt, btnUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDAbsUnknownLicences (btnUnknownWgt, btnUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDAbsUnknownLicences
case btnUnknownRes of case btnUnknownRes of
Nothing -> return () Nothing -> return ()
(Just BtnImportUnknownAvsIds) -> do (Just BtnImportUnknownAvsIds) -> catchAllAvs $ do
let procAid = fmap (Sum . maybe 0 (const 1)) <$> upsertAvsUserById res <- forM unknownLicenceOwners $ try . upsertAvsUserById
res <- try (getSum <$> foldMapM procAid unknownLicenceOwners) let procRes (Right _) = (Sum 1, mempty, mempty, mempty)
case res of procRes (Left (AvsUserAmbiguous api)) = (Sum 0, Set.singleton api, mempty, mempty)
Right oks -> do procRes (Left (AvsUserUnknownByAvs api)) = (Sum 0, mempty, Set.singleton api, mempty)
let ms = if oks == numUnknownLicenceOwners then Info else Warning procRes (Left err) = (Sum 0, mempty, mempty, Set.singleton err)
addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners (Sum oks, ambis, unkns, errs) = foldMap procRes res
redirect ProblemAvsSynchR ms = if oks == numUnknownLicenceOwners then Success else Warning
Left err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) unless (null ambis) $ addMessageModal Error (i18n $ MsgAvsImportAmbiguous $ length ambis) (Right (text2widget $ tshow ambis))
(Just BtnRevokeAvsLicences) -> do 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 let revokes = Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners
no_revokes = Set.size revokes no_revokes = Set.size revokes
try (setLicencesAvs revokes) >>= \case oks <- setLicencesAvs revokes
Right no_ok | no_ok < no_revokes -> addMessageI Error MsgRevokeUnknownLicencesFail if oks < no_revokes
| otherwise -> addMessageI Info MsgRevokeUnknownLicencesOk then addMessageI Error MsgRevokeUnknownLicencesFail
Left err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) else addMessageI Info MsgRevokeUnknownLicencesOk
>> redirect ProblemAvsSynchR redirect ProblemAvsSynchR
-- licence differences -- licence differences
((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,) ((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
<$> mkLicenceTable "avsLicDiffRevokeVorfeld" AvsNoLicence avsLicenceDiffRevokeAll (Just LicenceTableChangeAvs) <$> mkLicenceTable "avsLicDiffRevokeVorfeld" AvsNoLicence avsLicenceDiffRevokeAll (Just LicenceTableChangeAvs)
@ -357,12 +363,11 @@ getProblemAvsSynchR = do
<*> mkLicenceTable "avsLicDiffRevokeRollfeld" AvsNoLicence avsLicenceDiffRevokeRollfeld (Just LicenceTableChangeAvs) <*> mkLicenceTable "avsLicDiffRevokeRollfeld" AvsNoLicence avsLicenceDiffRevokeRollfeld (Just LicenceTableChangeAvs)
<*> mkLicenceTable "avsLicDiffGrantRollfeld" AvsLicenceRollfeld avsLicenceDiffGrantRollfeld (Just LicenceTableChangeAvs) <*> mkLicenceTable "avsLicDiffGrantRollfeld" AvsLicenceRollfeld avsLicenceDiffGrantRollfeld (Just LicenceTableChangeAvs)
let procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler () let procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler ()
procRes aLic (LicenceTableChangeAvsData , apids) = do procRes aLic (LicenceTableChangeAvsData , apids) = catchAllAvs $ do
try (setLicencesAvs $ Set.map (AvsPersonLicence aLic) apids) >>= \case oks <- setLicencesAvs $ Set.map (AvsPersonLicence aLic) apids
(Right no_ok) -> let no_req = Set.size apids let no_req = Set.size apids
mkind = if no_ok < no_req then Warning else Success mkind = if oks < no_req then Warning else Success
in addMessageI mkind $ MsgAvsSetLicences aLic no_ok no_req addMessageI mkind $ MsgAvsSetLicences aLic oks no_req
(Left err) -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
redirect ProblemAvsSynchR -- reload to update all tables redirect ProblemAvsSynchR -- reload to update all tables
procRes alic (LicenceTableRevokeFDriveData, apids) = do procRes alic (LicenceTableRevokeFDriveData, apids) = do
runDB $ do runDB $ do

6
src/Handler/Utils/Avs.hs
View File

@ -51,11 +51,11 @@ data AvsException
= AvsInterfaceUnavailable -- Interface to AVS was not configured at startup or does not respond = 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 | 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 | 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 | AvsPersonSearchEmpty -- AvsPersonSearch returned empty result
| AvsPersonSearchAmbiguous -- AvsPersonSearch returned more than one result | AvsPersonSearchAmbiguous -- AvsPersonSearch returned more than one result
| AvsSetLicencesFailed Text -- AvsSetLicence total failure | AvsSetLicencesFailed Text -- AvsSetLicence total failure
deriving (Show, Generic, Typeable) deriving (Show, Eq, Ord, Generic, Typeable)
instance Exception AvsException instance Exception AvsException
{- {-
@ -322,7 +322,7 @@ upsertAvsUserById api = do
candidates <- selectKeysList [UserCompanyPersonalNumber ==. Just persNo] [] candidates <- selectKeysList [UserCompanyPersonalNumber ==. Just persNo] []
case candidates of case candidates of
[uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo) [uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo)
(_:_) -> throwM AvsUserAmbiguous (_:_) -> throwM $ AvsUserAmbiguous api
[] -> do [] -> do
upsRes :: Either CampusUserConversionException (Entity User) upsRes :: Either CampusUserConversionException (Entity User)
<- try $ ldapLookupAndUpsert persNo <- try $ ldapLookupAndUpsert persNo