From 9d715cd20ce99cc8ef4f75c11e316460eaf9117a Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 16 May 2023 15:55:15 +0000 Subject: [PATCH] chore(avs): fix #39 by queueing avs synch for known avs users --- src/Handler/Admin.hs | 24 +++++++++++++++--------- src/Jobs/Handler/SynchroniseAvs.hs | 20 +++++++++++++------- src/Jobs/Types.hs | 10 +++++++--- 3 files changed, 35 insertions(+), 19 deletions(-) diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 25c26d110..983a083d3 100644 --- a/src/Handler/Admin.hs +++ b/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) - (Right AvsLicenceDifferences{..}) -> Right - ( Set.size avsLicenceDiffRevokeAll - , Set.size avsLicenceDiffGrantVorfeld - , Set.size avsLicenceDiffRevokeRollfeld - , Set.size avsLicenceDiffGrantRollfeld - ) + (Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException) + (Right AvsLicenceDifferences{..}) -> do + let problemIds = avsLicenceDiffRevokeAll <> avsLicenceDiffGrantVorfeld <> avsLicenceDiffRevokeRollfeld <> avsLicenceDiffGrantRollfeld + mapM_ (queueJob' . flip JobSynchroniseAvsId cutOffAvsSynch) problemIds + return $ Right + ( 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` diff --git a/src/Jobs/Handler/SynchroniseAvs.hs b/src/Jobs/Handler/SynchroniseAvs.hs index 3d49b5ce6..119d9ef0a 100644 --- a/src/Jobs/Handler/SynchroniseAvs.hs +++ b/src/Jobs/Handler/SynchroniseAvs.hs @@ -34,11 +34,17 @@ dispatchJobSynchroniseLdap numIterations epoch iteration -} -dispatchJobSynchroniseAvsId :: AvsPersonId -> JobHandler UniWorX -dispatchJobSynchroniseAvsId = JobHandlerException . void . upsertAvsUserById -- updates UserAvsLAstSynch +dispatchJobSynchroniseAvs :: Either AvsPersonId UserId -> Maybe UTCTime -> JobHandler UniWorX +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 -dispatchJobSynchroniseAvsUser jUser = JobHandlerException $ do - runDB (getBy $ UniqueUserAvsUser jUser) >>= \case - Nothing -> return () -- no attempt to associate an AVS user is done here - Just usrAvsEnt -> void $ upsertAvsUserById $ usrAvsEnt ^. _entityVal . _userAvsPersonId -- updates UserAvsLAstSynch +dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe UTCTime -> JobHandler UniWorX +dispatchJobSynchroniseAvsId = dispatchJobSynchroniseAvs . Left + +dispatchJobSynchroniseAvsUser :: UserId -> Maybe UTCTime -> JobHandler UniWorX +dispatchJobSynchroniseAvsUser = dispatchJobSynchroniseAvs . Right diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 77181b5a7..4a2a9787e 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Steffen Jost +-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen ,Sarah Vaupel ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -89,8 +89,12 @@ data Job , jIteration :: Natural } | JobSynchroniseLdapUser { jUser :: UserId } - | JobSynchroniseAvsUser { jUser :: UserId } - | JobSynchroniseAvsId { jAvsId:: AvsPersonId } + | JobSynchroniseAvsUser { jUser :: UserId + , jSynchAfter :: Maybe UTCTime + } + | JobSynchroniseAvsId { jAvsId:: AvsPersonId + , jSynchAfter :: Maybe UTCTime + } | JobChangeUserDisplayEmail { jUser :: UserId , jDisplayEmail :: UserEmail }