chore(avs): attempt to reduce sync jobs

This commit is contained in:
Steffen Jost 2023-06-28 15:58:45 +00:00
parent 3e5f271cac
commit aaa2d679fd
2 changed files with 57 additions and 22 deletions

View File

@ -33,3 +33,10 @@ UserAvsCard
lastSynch UTCTime
-- UniqueAvsCard cardNo -- Note: cardNo is not unique; invalid cardNo may be reissued to different persons
deriving Generic
AvsSync
personId AvsPersonId
creationTime UTCTime
pause Day Maybe
UniqueAvsSyncId personId
deriving Generic

View File

@ -10,6 +10,10 @@ module Jobs.Handler.SynchroniseAvs
import Import
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Utils as E
import qualified Data.Conduit.List as C
import Jobs.Queue
@ -34,29 +38,53 @@ dispatchJobSynchroniseAvs numIterations epoch iteration pause
return $ JobSynchroniseAvsUser userId pause
workJobSynchroniseAvs :: Either AvsPersonId UserId -> Maybe Day -> JobHandler UniWorX
workJobSynchroniseAvs eauid pause = JobHandlerAtomic $ do
either (return . Just) getAId eauid >>= \case ->
Nothing -> return ()
Just avsid -> do
now <- liftIO getCurrentTime
E.upsert
AvsSync { avsSyncPersonId = avsid
, avsSyncCreationTime = now
, avsSyncPause = pause
}
[ \oldSync -> AvsSyncPause E.=. E.least (E.val pause) (oldSync E.^. AvsSyncPause) ]
where
getAId uid = userAvsPersonId <<$>> getBy (UniqueUserAvsUser uid)
workJobSynchroniseAvs :: Either AvsPersonId UserId -> Maybe UTCTime -> JobHandler UniWorX
workJobSynchroniseAvs eauid pause = JobHandlerException $ do
let uniqKey = either UniqueUserAvsId UniqueUserAvsUser eauid
runDB (getBy uniqKey) >>= \case
Nothing -> return () -- do not create new newers in this background job, only update existing
Just Entity{entityKey=avsKey, entityVal=UserAvs{..} }
| maybe False (userAvsLastSynch >=) pause -> return () -- we just updated this one within the given limit
| otherwise -> catch (void $ upsertAvsUserById userAvsPersonId) -- already updates UserAvsLastSynch
(\exc -> do
now <- liftIO getCurrentTime
let excMsg = tshow exc <> " at " <> tshow now
runDB (update avsKey [UserAvsLastSynchError =. Just excMsg])
case exc of
AvsInterfaceUnavailable -> return () -- ignore and retry later
AvsUserUnknownByAvs _ -> return () -- ignore for users no longer listed in AVS
otherExc -> throwM otherExc
)
dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe UTCTime -> JobHandler UniWorX
dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe Day -> JobHandler UniWorX
dispatchJobSynchroniseAvsId = workJobSynchroniseAvs . Left
dispatchJobSynchroniseAvsUser :: UserId -> Maybe UTCTime -> JobHandler UniWorX
dispatchJobSynchroniseAvsUser :: UserId -> Maybe Day -> JobHandler UniWorX
dispatchJobSynchroniseAvsUser = workJobSynchroniseAvs . Right
dispatchJobSynchroniseAvsNext :: JobHandler UniWorX
dispatchJobSynchroniseAvsNext = JobHandlerException $ do
liftIO $ yield >> threadDelay 100000
queueJob' JobSynchroniseAvs
dispatchJobSynchroniseAvs :: JobHandler UniWorX
dispatchJobSynchroniseAvs = JobHandlerException $ do
syncJob <- runDB $
selectFirst [] [Asc AvsSyncCreationTime] >>= \case
Nothing -> return Nothing -- nothing more to do
Just Entity{entityKey=asid, entityVal=AvsSync{..}} -> do
res <- getBy (UniqueUserAvsId avsSyncPersonId) >>= \case
Just Entity{entityKey=avsKey, entityVal=UserAvs{..} }
| maybe True (utctDay userAvsLastSynch <) avsSyncPause -> return $ Just avsSyncPersonId
_other -> return Nothing -- we just updated this one within the given limit or the entity does not exist
queueDBJob JobSynchroniseAvsNext
delete asid
return res
ifMaybeM syncJob () $ \avsSyncPersonId -> do
catch (void $ upsertAvsUserById avsSyncPersonId) -- already updates UserAvsLastSynch
(\exc -> do
now <- liftIO getCurrentTime
let excMsg = tshow exc <> " at " <> tshow now
runDB (update avsKey [UserAvsLastSynchError =. Just excMsg, UserAvsLastSynch =. now])
case exc of
AvsInterfaceUnavailable -> return () -- ignore and retry later
AvsUserUnknownByAvs _ -> return () -- ignore for users no longer listed in AVS
otherExc -> throwM otherExc
)