chore(avs): fix #39 by queueing avs synch for known avs users
This commit is contained in:
parent
f123f40ad2
commit
9d715cd20c
@ -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`
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user