diff --git a/models/avs.model b/models/avs.model index be0eb89db..cc303d8a9 100644 --- a/models/avs.model +++ b/models/avs.model @@ -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 \ No newline at end of file diff --git a/src/Jobs/Handler/SynchroniseAvs.hs b/src/Jobs/Handler/SynchroniseAvs.hs index 9bb3cd687..b35a07641 100644 --- a/src/Jobs/Handler/SynchroniseAvs.hs +++ b/src/Jobs/Handler/SynchroniseAvs.hs @@ -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 + ) \ No newline at end of file