chore(avs): attempt to reduce sync jobs
This commit is contained in:
parent
3e5f271cac
commit
aaa2d679fd
@ -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
|
||||
@ -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
|
||||
)
|
||||
Loading…
Reference in New Issue
Block a user