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

fix(avs): invalidate contact cache after licence writes

Browse Source
This commit is contained in:
Steffen Jost 2024-02-19 17:28:40 +01:00
parent d578e80282
commit c382be9325
2 changed files with 67 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -583,17 +583,20 @@ class SomeAvsQuery q where
avsQuery = avsQueryNoCache avsQuery = avsQueryNoCache
-- | send query to AVS directly, never cached -- | send query to AVS directly, never cached
avsQueryNoCache :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q) avsQueryNoCache :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q)
avsQueryNoCache qry = do avsQueryNoCache = avsQueryNoCacheDefault
avsQueryNoCacheDefault :: (SomeAvsQuery q
, MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q)
avsQueryNoCacheDefault qry = do
qfun <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ preview (_appAvsQuery . _Just . to pickQuery) qfun <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ preview (_appAvsQuery . _Just . to pickQuery)
throwLeftM $ qfun qry throwLeftM $ qfun qry
avsQueryCached :: (SomeAvsQuery q, Binary q, Binary (SomeAvsResponse q), Typeable (SomeAvsResponse q), NFData (SomeAvsResponse q) avsQueryCached :: (SomeAvsQuery q, Binary q, Binary (SomeAvsResponse q), Typeable (SomeAvsResponse q), NFData (SomeAvsResponse q)
, MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q) , MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q)
avsQueryCached = avsQueryCached qry =
(getsYesod (preview $ _appAvsConf . _Just . _avsCacheExpiry) >>=) . flip (\case getsYesod (preview $ _appAvsConf . _Just . _avsCacheExpiry) >>= \case
(Just t) | t > 1 -> \qry -> memcachedBy (Just $ Right t) qry $ avsQueryNoCache qry (Just t) | t > 1 -> memcachedBy (Just $ Right t) qry $ avsQueryNoCache qry
_ -> avsQueryNoCache _ -> avsQueryNoCache qry
)
instance SomeAvsQuery AvsQueryPerson where instance SomeAvsQuery AvsQueryPerson where
type SomeAvsResponse AvsQueryPerson = AvsResponsePerson type SomeAvsResponse AvsQueryPerson = AvsResponsePerson
@ -614,6 +617,8 @@ instance SomeAvsQuery AvsQuerySetLicences where
type SomeAvsResponse AvsQuerySetLicences = AvsResponseSetLicences type SomeAvsResponse AvsQuerySetLicences = AvsResponseSetLicences
pickQuery = avsQuerySetLicences pickQuery = avsQuerySetLicences
-- NOTE: avsQuery = avsQueryCached -- should not and indeed does not compile -- NOTE: avsQuery = avsQueryCached -- should not and indeed does not compile
avsQueryNoCache qry = avsQueryNoCacheDefault qry
<* memcachedInvalidate (Proxy @AvsResponseContact) -- invalidate all AvsResponseContact which may contain RampLicence info, since keys may comprise several ids
instance SomeAvsQuery AvsQueryGetAllLicences where instance SomeAvsQuery AvsQueryGetAllLicences where
type SomeAvsResponse AvsQueryGetAllLicences = AvsResponseGetLicences type SomeAvsResponse AvsQueryGetAllLicences = AvsResponseGetLicences
@ -635,9 +640,8 @@ queryAvsCardNo crd = do
} }
-- A datatype for a specific heterogeneous list -- A datatype for a specific heterogeneous list to compute DB updates, consisting of a persistent record field and a fitting lens
-- data CheckAvsUpdate record iavs = forall typ f. (Eq typ, PersistField typ, Functor f) => CheckAvsUpdate (EntityField record typ) ((typ -> f typ) -> iavs -> f iavs) -- An Record Field and fitting Lens data CheckAvsUpdate record iavs = forall typ. (Eq typ, PersistField typ) => CheckAvsUpdate (EntityField record typ) (Getting typ iavs typ) -- A persistent record field and fitting getting
data CheckAvsUpdate record iavs = forall typ. (Eq typ, PersistField typ) => CheckAvsUpdate (EntityField record typ) ((typ -> Const typ typ) -> iavs -> Const typ iavs) -- An Record Field and fitting Lens
-- | Compute necessary updates. Given an database record, a new and an old avs response and a pair consisting of a getter from avs response to a value and and EntityField of the same value, -- | Compute necessary updates. Given an database record, a new and an old avs response and a pair consisting of a getter from avs response to a value and and EntityField of the same value,
-- an update is returned, if the current value is identical to the old avs value, which changed in the new avs query -- an update is returned, if the current value is identical to the old avs value, which changed in the new avs query
@ -652,23 +656,22 @@ mkUpdate usr newapi oldapi (CheckAvsUpdate up la)
mkUpdate _ _ _ _ = Nothing mkUpdate _ _ _ _ = Nothing
updateAvsUserByIds :: Set AvsPersonId -> Handler (Set (AvsPersonId, UserId)) -- | Update given AvsPersonId by querying AVS for each; update only, no insertion!
updateAvsUserByIds :: Set AvsPersonId -> DB (Set (AvsPersonId, UserId))
updateAvsUserByIds apids = do updateAvsUserByIds apids = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsResponseContact adcs <- avsQuery $ AvsQueryContact $ Set.mapMonotonic AvsObjPersonId apids
AvsResponseContact adcs <- throwLeftM . avsQueryContact $ AvsQueryContact $ Set.mapMonotonic AvsObjPersonId apids let requestedAnswers = Set.filter (view (_avsContactPersonID . to (`Set.member` apids))) adcs -- should not occur, neither should one apid occur multiple times within the response (if so, all responses processed here in random order)
res <- foldMapM procResp adcs res <- foldMapM procResp requestedAnswers
let missing = Set.toList $ Set.difference apids $ Set.map fst res let missing = Set.toList $ Set.difference apids $ Set.map fst res
unless (null missing) $ runDB $ do unless (null missing) $ do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
updateWhere [UserAvsPersonId <-. missing] [UserAvsLastSynch =. now, UserAvsLastSynchError =. Just "Contact unknown for AvsPersonId"] updateWhere [UserAvsPersonId <-. missing] [UserAvsLastSynch =. now, UserAvsLastSynchError =. Just "Contact unknown for AvsPersonId"]
return res return res
where where
procResp (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) procResp (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = fmap maybeMonoid . runMaybeT $ do
| 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 uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid (Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid
let oldAvsPersonInfo = userAvsLastPersonInfo usravs -- Nothing here must not abort the entire synch, hence no hoistMaybe here let oldAvsPersonInfo = userAvsLastPersonInfo usravs -- We must not abort entire synch when receiving `Nothing` here, hence no hoistMaybe here
let oldAvsFirmInfo = userAvsLastFirmInfo usravs -- Nothing here must not abort the entire synch, hence no hoistMaybe here let oldAvsFirmInfo = userAvsLastFirmInfo usravs -- We must not abort entire synch when receiving `Nothing` here, hence no hoistMaybe here
let usrId = userAvsUser usravs let usrId = userAvsUser usravs
usr <- MaybeT $ get usrId usr <- MaybeT $ get usrId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime

9
src/Utils/Avs.hs
View File

@ -64,14 +64,7 @@ data AvsQuery = AvsQuery
makeLenses_ ''AvsQuery makeLenses_ ''AvsQuery
-- AVS/VSM-Interface currently only allows to query ID 0, which means all licences -- | AVS/VSM-interface currently only allows GetLicences with query argument ID 0, which means all licences; all other queries yield an empty response
-- instance SomeAvsQuery AvsQueryGetLicences where
-- type SomeAvsResponse AvsQueryGetLicences = AvsResponseGetLicences
-- pickQuery = avsQuerySetLicences
-- type SomeAvsCachable AvsQueryGetLicences = () -- not cachable
-- cacheable _ = Nothing
-- | To query all active licences, a special constant argument must be prepared
avsQueryAllLicences :: AvsQueryGetLicences avsQueryAllLicences :: AvsQueryGetLicences
avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero avsQueryAllLicences = AvsQueryGetLicences $ AvsObjPersonId avsPersonIdZero