fraport/fradrive-old
Archived
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

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

@ -112,28 +112,34 @@ setLicenceAvs apid lic = do
let req = Set.singleton $ AvsPersonLicence { avsLicenceRampLicence = lic, avsLicencePersonID = apid } let req = Set.singleton $ AvsPersonLicence { avsLicenceRampLicence = lic, avsLicencePersonID = apid }
setLicencesAvs req setLicencesAvs req
--setLicencesAvs :: Set AvsPersonLicence -> Handler Bool --setLicencesAvs :: Set AvsPersonLicence -> Handler Bool
setLicencesAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) => setLicencesAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) =>
Set AvsPersonLicence -> m Bool Set AvsPersonLicence -> m Bool
setLicencesAvs pls = do setLicencesAvs persLics = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsQuery{avsQuerySetLicences=aqsl} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
let (batch1, batch2) = Set.splitAt avsMaxSetLicenceAtOnce pls aux aqsl True persLics
response <- throwLeftM $ avsQuerySetLicences $ AvsQuerySetLicences batch1 where
case response of aux aqsl batch0_ok pls
AvsResponseSetLicencesError{..} -> do | Set.null pls = return batch0_ok
let msg = "Set AVS licences failed utterly: " <> avsResponseSetLicencesStatus <> ". Details: " <> cropText avsResponseSetLicencesMessage | otherwise = do
$logErrorS "AVS" msg let (batch1, batch2) = Set.splitAt avsMaxSetLicenceAtOnce pls
throwM $ AvsSetLicencesFailed avsResponseSetLicencesStatus 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 AvsResponseSetLicences msgs -> do
let (ok,bad) = Set.partition (sloppyBool . avsResponseSuccess) msgs let (ok,bad') = Set.partition (sloppyBool . avsResponseSuccess) msgs
batch1_ok = length ok == length batch1 ok_ids = Set.map avsResponsePersonID ok
forM_ bad $ \AvsLicenceResponse { avsResponsePersonID=api, avsResponseMessage=msg} -> 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
$logErrorS "AVS" $ "Set AVS Licence failed for " <> tshow api <> " due to " <> cropText msg batch1_ok = length ok == length batch1
-- TODO: Admin Error page forM_ bad $ \AvsLicenceResponse { avsResponsePersonID=api, avsResponseMessage=msg} ->
if Set.null batch2 $logErrorS "AVS" $ "Set AVS Licence failed for " <> tshow api <> " due to " <> cropText msg
then return batch1_ok -- TODO: Admin Error page
else (batch1_ok &&) <$> setLicencesAvs batch2 -- yay for recursion (TODO: refactor) aux aqsl (batch0_ok && batch1_ok) batch2 -- yay for tail recursion (TODO: maybe refactor?)
-- | Retrieve all currently valid driving licences and check against our database -- | Retrieve all currently valid driving licences and check against our database

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 :: Applicative m => (k -> m v) -> Set k -> m (Map k v)
mapFromSetM = (sequenceA .) . Map.fromSet 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 :: (Applicative m, Ord k, Finite k) => (k -> m v) -> m (Map k v)
mapFM = sequenceA . mapF mapFM = sequenceA . mapF