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

This commit is contained in:
Steffen Jost 2023-05-16 15:55:15 +00:00
parent f123f40ad2
commit 9d715cd20c
3 changed files with 35 additions and 19 deletions

View File

@ -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`

View File

@ -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

View File

@ -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 }
| JobSynchroniseAvsId { jAvsId:: AvsPersonId }
| JobSynchroniseAvsUser { jUser :: UserId
, jSynchAfter :: Maybe UTCTime
}
| JobSynchroniseAvsId { jAvsId:: AvsPersonId
, jSynchAfter :: Maybe UTCTime
}
| JobChangeUserDisplayEmail { jUser :: UserId
, jDisplayEmail :: UserEmail
}