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

chore(avs): ignore multiple feedback for single id in setLicenceAvs

Browse Source
This commit is contained in:
Steffen Jost 2022-12-05 11:39:56 +01:00
parent 49593d6fef
commit 63865f86eb
2 changed files with 28 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -112,29 +112,35 @@ setLicenceAvs apid lic = do
let req = Set.singleton $ AvsPersonLicence { avsLicenceRampLicence = lic, avsLicencePersonID = apid }
setLicencesAvs req
--setLicencesAvs :: Set AvsPersonLicence -> Handler Bool
setLicencesAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) =>
Set AvsPersonLicence -> m Bool
setLicencesAvs pls = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
let (batch1, batch2) = Set.splitAt avsMaxSetLicenceAtOnce pls
response <- throwLeftM $ avsQuerySetLicences $ AvsQuerySetLicences batch1
case response of
AvsResponseSetLicencesError{..} -> do
let msg = "Set AVS licences failed utterly: " <> avsResponseSetLicencesStatus <> ". Details: " <> cropText avsResponseSetLicencesMessage
$logErrorS "AVS" msg
throwM $ AvsSetLicencesFailed avsResponseSetLicencesStatus
setLicencesAvs persLics = do
AvsQuery{avsQuerySetLicences=aqsl} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
aux aqsl True persLics
where
aux aqsl batch0_ok pls
| Set.null pls = return batch0_ok
| otherwise = do
let (batch1, batch2) = Set.splitAt avsMaxSetLicenceAtOnce pls
response <- throwLeftM $ aqsl $ AvsQuerySetLicences batch1
case response of
AvsResponseSetLicencesError{..} -> do
let msg = "Set AVS licences failed utterly: " <> avsResponseSetLicencesStatus <> ". Details: " <> cropText avsResponseSetLicencesMessage
$logErrorS "AVS" msg
throwM $ AvsSetLicencesFailed avsResponseSetLicencesStatus
AvsResponseSetLicences msgs -> do
let (ok,bad') = Set.partition (sloppyBool . avsResponseSuccess) msgs
ok_ids = Set.map avsResponsePersonID ok
bad = Map.withoutKeys (setToMap avsResponsePersonID bad') ok_ids -- it is possible to receive an id multiple times, with only one success, but this is sufficient
batch1_ok = length ok == length batch1
forM_ bad $ \AvsLicenceResponse { avsResponsePersonID=api, avsResponseMessage=msg} ->
$logErrorS "AVS" $ "Set AVS Licence failed for " <> tshow api <> " due to " <> cropText msg
-- TODO: Admin Error page
aux aqsl (batch0_ok && batch1_ok) batch2 -- yay for tail recursion (TODO: maybe refactor?)
AvsResponseSetLicences msgs -> do
let (ok,bad) = Set.partition (sloppyBool . avsResponseSuccess) msgs
batch1_ok = length ok == length batch1
forM_ bad $ \AvsLicenceResponse { avsResponsePersonID=api, avsResponseMessage=msg} ->
$logErrorS "AVS" $ "Set AVS Licence failed for " <> tshow api <> " due to " <> cropText msg
-- TODO: Admin Error page
if Set.null batch2
then return batch1_ok
else (batch1_ok &&) <$> setLicencesAvs batch2 -- yay for recursion (TODO: refactor)
-- | Retrieve all currently valid driving licences and check against our database
-- Only react to changes as compared to last seen status in avs.model

3
src/Utils.hs
View File

@ -788,6 +788,9 @@ partitionKeysEither = over _2 (Map.mapKeysMonotonic . view $ singular _Right) .
mapFromSetM :: Applicative m => (k -> m v) -> Set k -> m (Map k v)
mapFromSetM = (sequenceA .) . Map.fromSet
setToMap :: (Ord k) => (v -> k) -> Set v -> Map k v
setToMap mkKey = Map.fromList . fmap (\x -> (mkKey x, x)) . Set.toList
mapFM :: (Applicative m, Ord k, Finite k) => (k -> m v) -> m (Map k v)
mapFM = sequenceA . mapF