diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg index 5b89691d0..b24c80818 100644 --- a/messages/uniworx/categories/avs/de-de-formal.msg +++ b/messages/uniworx/categories/avs/de-de-formal.msg @@ -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 diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg index 6d089edc1..daa54cca9 100644 --- a/messages/uniworx/categories/avs/en-eu.msg +++ b/messages/uniworx/categories/avs/en-eu.msg @@ -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 diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 0292c4732..2c7721836 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -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 diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 085b2a8a2..d4da76c77 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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