chore(avs): attempt to reduce sync jobs

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

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
+dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe Day -> 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 = 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
+            )