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

chore(avs): add failure notices after contact update

Browse Source
This commit is contained in:
Steffen Jost 2024-01-12 18:13:23 +01:00
parent cb807fce98
commit 45c3f11a83
2 changed files with 36 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -588,40 +588,46 @@ mkUpdate usr npi opi (CheckAvsUpdate up la)
mkUpdate _ _ _ _ = Nothing mkUpdate _ _ _ _ = Nothing
updateAvsUserByIds :: Set AvsPersonId -> Handler (Set UserId) updateAvsUserByIds :: Set AvsPersonId -> Handler (Set (AvsPersonId, UserId))
updateAvsUserByIds apids = do updateAvsUserByIds apids = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
AvsResponseContact adcs <- throwLeftM . avsQueryContact $ AvsQueryContact $ Set.mapMonotonic AvsObjPersonId apids AvsResponseContact adcs <- throwLeftM . avsQueryContact $ AvsQueryContact $ Set.mapMonotonic AvsObjPersonId apids
foldMapM procResp adcs res <- foldMapM procResp adcs
let missing = Set.toList $ Set.difference apids $ Set.map fst res
unless (null missing) $ runDB $ do
now <- liftIO getCurrentTime
updateWhere [UserAvsPersonId <-. missing] [UserAvsLastSynch =. now, UserAvsLastSynchError =. Just "Contact unknown for AvsPersonId"]
return res
where where
procResp (AvsDataContact apid avsPersonInfo _avsFirmInfo) procResp (AvsDataContact apid avsPersonInfo avsFirmInfo)
| apid `Set.notMember` apids = return mempty -- should not occur, neither should one apid occur multiple times withtin the response (if so, all responses processed here in random order) | apid `Set.notMember` apids = return mempty -- should not occur, neither should one apid occur multiple times withtin the response (if so, all responses processed here in random order)
| otherwise = fmap maybeMonoid . runDB . runMaybeT $ do | otherwise = fmap maybeMonoid . runDB . runMaybeT $ do
(Entity _ usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid (Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid
oldAvsPersonInfo <- hoistMaybe $ userAvsLastPersonInfo usravs oldAvsPersonInfo <- hoistMaybe $ userAvsLastPersonInfo usravs -- TODO this hoist maybe should not abort the entire synch!!!
-- oldAvsFirmInfo <- hoistMaybe $ userAvsLastFirmInfo usravs -- TODO this hoist maybe should not abort the entire synch!!!
let usrId = userAvsUser usravs let usrId = userAvsUser usravs
usr <- MaybeT $ get usrId usr <- MaybeT $ get usrId
let ups = mapMaybe (mkUpdate usr avsPersonInfo oldAvsPersonInfo) now <- liftIO getCurrentTime
[ CheckAvsUpdate UserFirstName _avsInfoFirstName let usr_ups = mapMaybe (mkUpdate usr avsPersonInfo oldAvsPersonInfo)
, CheckAvsUpdate UserSurname _avsInfoLastName [ CheckAvsUpdate UserFirstName _avsInfoFirstName
, CheckAvsUpdate UserDisplayName _avsInfoDisplayName , CheckAvsUpdate UserSurname _avsInfoLastName
, CheckAvsUpdate UserBirthday _avsInfoDateOfBirth , CheckAvsUpdate UserDisplayName _avsInfoDisplayName
, CheckAvsUpdate UserMobile _avsInfoPersonMobilePhoneNo , CheckAvsUpdate UserBirthday _avsInfoDateOfBirth
, CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just` , CheckAvsUpdate UserMobile _avsInfoPersonMobilePhoneNo
, CheckAvsUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI -- Maybe nicht im User, aber im AvsInfo , CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
, CheckAvsUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo , CheckAvsUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI -- Maybe nicht im User, aber im AvsInfo
] , CheckAvsUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo
lift $ update usrId ups ]
return $ Set.singleton usrId -- frm_ups = mapMaybe (mkUpdate usr avsFirmInfo oldAvsFirmInfo)
-- [ CheckAvsUpdate
-- ]
updateAvsUserById :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX ) avs_ups = [ UserAvsNoPerson =. api | Just api <- [readMay $ avsInfoPersonNo avsPersonInfo]]
=> AvsPersonId -> m (Maybe UserId) <> [ UserAvsLastSynch =. now
updateAvsUserById apid = do , UserAvsLastSynchError =. Nothing
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery , UserAvsLastPersonInfo =. Just avsPersonInfo
AvsResponseContact adcs <- throwLeftM . avsQueryContact $ AvsQueryContact $ Set.singleton $ AvsObjPersonId apid , UserAvsLastFirmInfo =. Just avsFirmInfo
case Set.elems $ Set.filter ((== apid) . avsContactPersonID) adcs of ]
[] -> throwM AvsPersonSearchEmpty lift $ update usrId usr_ups
(_:_:_) -> throwM AvsPersonSearchAmbiguous lift $ update uaId avs_ups
[AvsDataContact _apid _avsPersonInfo _avsFirmInfo] -> do return $ Set.singleton (apid, usrId)
return Nothing -- TODO

5
src/Jobs/Handler/SynchroniseAvs.hs
View File

@ -93,9 +93,8 @@ dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
void $ queueJob JobSynchroniseAvsNext void $ queueJob JobSynchroniseAvsNext
catch (void $ upsertAvsUserById apid) -- already updates UserAvsLastSynch catch (void $ upsertAvsUserById apid) -- already updates UserAvsLastSynch
(\exc -> do (\exc -> do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let excMsg = tshow exc <> " at " <> tshow now runDB (update avsKey [UserAvsLastSynchError =. Just (tshow exc), UserAvsLastSynch =. now])
runDB (update avsKey [UserAvsLastSynchError =. Just excMsg, UserAvsLastSynch =. now])
case exc of case exc of
AvsInterfaceUnavailable -> return () -- ignore and retry later AvsInterfaceUnavailable -> return () -- ignore and retry later
AvsUserUnknownByAvs _ -> return () -- ignore for users no longer listed in AVS AvsUserUnknownByAvs _ -> return () -- ignore for users no longer listed in AVS