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

fix(acs): fix overzealous avs error catching resulting in unnecessary error messages

Browse Source
This commit is contained in:
Steffen Jost 2023-03-22 16:26:36 +00:00
parent ee9481ebd8
commit fa5fd98619
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -325,7 +325,7 @@ postProblemAvsSynchR, getProblemAvsSynchR :: Handler Html
postProblemAvsSynchR = getProblemAvsSynchR postProblemAvsSynchR = getProblemAvsSynchR
getProblemAvsSynchR = do getProblemAvsSynchR = do
let catchAllAvs' r = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect r) 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 catchAllAvs = catchAllAvs' ProblemAvsSynchR -- == current route; use only in conditions that are not repeated upon reload; do not call redirect within catchAllAvs actions!
AvsLicenceDifferences{..} <- catchAllAvs' AdminR retrieveDifferingLicences AvsLicenceDifferences{..} <- catchAllAvs' AdminR retrieveDifferingLicences
-- --
@ -340,8 +340,8 @@ getProblemAvsSynchR = do
numUnknownLicenceOwners = length unknownLicenceOwners numUnknownLicenceOwners = length unknownLicenceOwners
(btnImportUnknownWgt, btnImportUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDBtnAvsImportUnknown (btnImportUnknownWgt, btnImportUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDBtnAvsImportUnknown
ifMaybeM btnImportUnknownRes () $ \BtnAvsImportUnknown -> catchAllAvs $ do ifMaybeM btnImportUnknownRes () $ \BtnAvsImportUnknown -> do
res <- forM (take 500 unknownLicenceOwners) $ try . upsertAvsUserById -- TODO: turn this into a background job res <- catchAllAvs $ 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) let procRes (Right _) = (Sum 1, mempty :: Set.Set AvsPersonId, mempty :: Set.Set AvsPersonId, mempty)
--TODO: continue here! --TODO: continue here!
--procRes (Left (AvsUserAmbiguous api)) = (Sum 0, Set.singleton api, mempty, mempty) --procRes (Left (AvsUserAmbiguous api)) = (Sum 0, Set.singleton api, mempty, mempty)
@ -371,10 +371,10 @@ getProblemAvsSynchR = do
^{revokeUnknownExecWgt} ^{revokeUnknownExecWgt}
|] |]
ifMaybeM btnRevokeUnknownRes () $ \BtnAvsRevokeUnknown -> catchAllAvs $ do ifMaybeM btnRevokeUnknownRes () $ \BtnAvsRevokeUnknown -> 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
oks <- setLicencesAvs revokes oks <- catchAllAvs $ setLicencesAvs revokes
if oks < no_revokes if oks < no_revokes
then addMessageI Error MsgRevokeUnknownLicencesFail then addMessageI Error MsgRevokeUnknownLicencesFail
else addMessageI Info MsgRevokeUnknownLicencesOk else addMessageI Info MsgRevokeUnknownLicencesOk
@ -390,8 +390,8 @@ getProblemAvsSynchR = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let nowaday = utctDay now let nowaday = utctDay now
procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler () procRes :: AvsLicence -> (LicenceTableActionData, Set AvsPersonId) -> Handler ()
procRes aLic (LicenceTableChangeAvsData , apids) = catchAllAvs $ do procRes aLic (LicenceTableChangeAvsData , apids) = do
oks <- setLicencesAvs $ Set.map (AvsPersonLicence aLic) apids -- catch here oks <- catchAllAvs $ setLicencesAvs $ Set.map (AvsPersonLicence aLic) apids
let no_req = Set.size apids let no_req = Set.size apids
mkind = if oks < no_req then Warning else Success mkind = if oks < no_req then Warning else Success
addMessageI mkind $ MsgAvsSetLicences aLic oks no_req addMessageI mkind $ MsgAvsSetLicences aLic oks no_req