chore(avs): fix #39 by queueing avs synch for known avs users

src/Handler/Admin.hs

@@ -8,6 +8,7 @@ module Handler.Admin
 
 import Import
 
+import Jobs
 -- import Data.Either
 import qualified Data.Set as Set
 -- import qualified Data.Text.Lazy.Encoding as LBS
@@ -42,21 +43,26 @@ getAdminProblemsR = do
   now <- liftIO getCurrentTime
   let nowaday = utctDay now
       cutOffPrintDays = 7
-      cutOffPrintJob  = addLocalDays (-cutOffPrintDays) now
+      cutOffPrintJob  = addLocalDays  (-cutOffPrintDays) now
+      cutOffAvsSynch  = Just $ addUTCTime (-nominalHour) now -- update at most once per hour
+
   (usersAreReachable, driversHaveAvsIds, rDriversHaveFs, noStalePrintJobs) <- runDB $ (,,,) 
       <$> areAllUsersReachable 
       <*> allDriversHaveAvsId nowaday
       <*> allRDriversHaveFs nowaday
       <*> (not <$> exists [PrintJobAcknowledged ==. Nothing, PrintJobCreated  <=. cutOffPrintJob])      
-  diffLics <- try retrieveDifferingLicences <&> \case
+  diffLics <- try retrieveDifferingLicences >>= \case
     -- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received"
-    (Left e) -> Left $ text2widget $ tshow (e :: SomeException)
+    (Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException)
-    (Right AvsLicenceDifferences{..}) -> Right
+    (Right AvsLicenceDifferences{..}) -> do
-      ( Set.size avsLicenceDiffRevokeAll
+      let problemIds = avsLicenceDiffRevokeAll <> avsLicenceDiffGrantVorfeld <> avsLicenceDiffRevokeRollfeld <> avsLicenceDiffGrantRollfeld
-      , Set.size avsLicenceDiffGrantVorfeld
+      mapM_  (queueJob' . flip JobSynchroniseAvsId cutOffAvsSynch) problemIds
-      , Set.size avsLicenceDiffRevokeRollfeld
+      return $ Right
-      , Set.size avsLicenceDiffGrantRollfeld
+        ( Set.size avsLicenceDiffRevokeAll
-      )
+        , Set.size avsLicenceDiffGrantVorfeld
+        , Set.size avsLicenceDiffRevokeRollfeld
+        , Set.size avsLicenceDiffGrantRollfeld
+        )
   -- Attempt to format results in a nicer way failed, since rendering Html within a modal destroyed the page layout itself
   -- let procDiffLics (to0, to1, to2) = Right (Set.size to0, Set.size to1, Set.size to2)
   -- diffLics <- (procDiffLics <$> retrieveDifferingLicences) `catches`

src/Jobs/Handler/SynchroniseAvs.hs

@@ -34,11 +34,17 @@ dispatchJobSynchroniseLdap numIterations epoch iteration
 -}
 
 
-dispatchJobSynchroniseAvsId :: AvsPersonId -> JobHandler UniWorX
+dispatchJobSynchroniseAvs :: Either AvsPersonId UserId -> Maybe UTCTime -> JobHandler UniWorX
-dispatchJobSynchroniseAvsId = JobHandlerException . void . upsertAvsUserById  -- updates UserAvsLAstSynch
+dispatchJobSynchroniseAvs 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{entityVal=UserAvs{..}}
+      | maybe False (userAvsLastSynch >=) pause -> return ()  -- we just updated this one within the given limit
+      | otherwise -> void $ upsertAvsUserById userAvsPersonId -- updates UserAvsLAstSynch
 
-dispatchJobSynchroniseAvsUser :: UserId -> JobHandler UniWorX
+dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe UTCTime -> JobHandler UniWorX
-dispatchJobSynchroniseAvsUser jUser = JobHandlerException $ do
+dispatchJobSynchroniseAvsId = dispatchJobSynchroniseAvs . Left
-  runDB (getBy $ UniqueUserAvsUser jUser) >>= \case
+
-    Nothing         -> return () -- no attempt to associate an AVS user is done here
+dispatchJobSynchroniseAvsUser :: UserId -> Maybe UTCTime -> JobHandler UniWorX
-    Just usrAvsEnt  -> void $ upsertAvsUserById $ usrAvsEnt ^. _entityVal . _userAvsPersonId -- updates UserAvsLAstSynch
+dispatchJobSynchroniseAvsUser = dispatchJobSynchroniseAvs . Right

src/Jobs/Types.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -89,8 +89,12 @@ data Job
                               , jIteration :: Natural
                               }
   | JobSynchroniseLdapUser    { jUser :: UserId }
-  | JobSynchroniseAvsUser     { jUser :: UserId }
+  | JobSynchroniseAvsUser     { jUser :: UserId
-  | JobSynchroniseAvsId       { jAvsId:: AvsPersonId }
+                              , jSynchAfter :: Maybe UTCTime
+                              }
+  | JobSynchroniseAvsId       { jAvsId:: AvsPersonId
+                              , jSynchAfter :: Maybe UTCTime 
+                              }
   | JobChangeUserDisplayEmail { jUser :: UserId
                               , jDisplayEmail :: UserEmail
                               }