fraport/fradrive
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
updateAvsUserByIds :: Set AvsPersonId -> Handler (Set UserId)
updateAvsUserByIds :: Set AvsPersonId -> Handler (Set (AvsPersonId, UserId))
updateAvsUserByIds apids = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
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
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)
| otherwise = fmap maybeMonoid . runDB . runMaybeT $ do
(Entity _ usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid
oldAvsPersonInfo <- hoistMaybe $ userAvsLastPersonInfo usravs
(Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid
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
usr <- MaybeT $ get usrId
let ups = mapMaybe (mkUpdate usr avsPersonInfo oldAvsPersonInfo)
[ CheckAvsUpdate UserFirstName _avsInfoFirstName
, CheckAvsUpdate UserSurname _avsInfoLastName
, CheckAvsUpdate UserDisplayName _avsInfoDisplayName
, CheckAvsUpdate UserBirthday _avsInfoDateOfBirth
, CheckAvsUpdate UserMobile _avsInfoPersonMobilePhoneNo
, CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
, 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
now <- liftIO getCurrentTime
let usr_ups = mapMaybe (mkUpdate usr avsPersonInfo oldAvsPersonInfo)
[ CheckAvsUpdate UserFirstName _avsInfoFirstName
, CheckAvsUpdate UserSurname _avsInfoLastName
, CheckAvsUpdate UserDisplayName _avsInfoDisplayName
, CheckAvsUpdate UserBirthday _avsInfoDateOfBirth
, CheckAvsUpdate UserMobile _avsInfoPersonMobilePhoneNo
, CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
, 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
]
-- frm_ups = mapMaybe (mkUpdate usr avsFirmInfo oldAvsFirmInfo)
-- [ CheckAvsUpdate
updateAvsUserById :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX )
=> AvsPersonId -> m (Maybe UserId)
updateAvsUserById apid = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
AvsResponseContact adcs <- throwLeftM . avsQueryContact $ AvsQueryContact $ Set.singleton $ AvsObjPersonId apid
case Set.elems $ Set.filter ((== apid) . avsContactPersonID) adcs of
[] -> throwM AvsPersonSearchEmpty
(_:_:_) -> throwM AvsPersonSearchAmbiguous
[AvsDataContact _apid _avsPersonInfo _avsFirmInfo] -> do
return Nothing -- TODO
-- ]
avs_ups = [ UserAvsNoPerson =. api | Just api <- [readMay $ avsInfoPersonNo avsPersonInfo]]
<> [ UserAvsLastSynch =. now
, UserAvsLastSynchError =. Nothing
, UserAvsLastPersonInfo =. Just avsPersonInfo
, UserAvsLastFirmInfo =. Just avsFirmInfo
]
lift $ update usrId usr_ups
lift $ update uaId avs_ups
return $ Set.singleton (apid, usrId)

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

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