49 lines
1.9 KiB
Haskell
49 lines
1.9 KiB
Haskell
-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Jobs.Handler.SynchroniseUser
|
|
( dispatchJobSynchroniseUsers, dispatchJobSynchroniseUser
|
|
, SynchroniseUserException(..)
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Foundation.Yesod.Auth (userLookupAndUpsert)
|
|
|
|
import qualified Data.CaseInsensitive as CI
|
|
import qualified Data.Conduit.List as C
|
|
|
|
import Jobs.Queue
|
|
|
|
|
|
data SynchroniseUserException
|
|
= SynchroniseUserNoSource
|
|
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
|
instance Exception SynchroniseUserException
|
|
|
|
dispatchJobSynchroniseUsers :: Natural -> Natural -> Natural -> JobHandler UniWorX
|
|
dispatchJobSynchroniseUsers numIterations epoch iteration
|
|
= JobHandlerAtomic . runConduit $
|
|
readUsers .| filterIteration .| sinkDBJobs
|
|
where
|
|
readUsers :: ConduitT () UserId (YesodJobDB UniWorX) ()
|
|
readUsers = selectKeys [] []
|
|
|
|
filterIteration :: ConduitT UserId Job (YesodJobDB UniWorX) ()
|
|
filterIteration = C.mapMaybeM $ \userId -> runMaybeT $ do
|
|
let
|
|
userIteration, currentIteration :: Integer
|
|
userIteration = toInteger (hash epoch `hashWithSalt` userId) `mod` toInteger numIterations
|
|
currentIteration = toInteger iteration `mod` toInteger numIterations
|
|
$logDebugS "SynchroniseUsers" [st|User ##{tshow (fromSqlKey userId)}: sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|]
|
|
guard $ userIteration == currentIteration
|
|
|
|
return $ JobSynchroniseUser userId
|
|
|
|
dispatchJobSynchroniseUser :: UserId -> JobHandler UniWorX
|
|
dispatchJobSynchroniseUser jUser = JobHandlerException . runDB $ do
|
|
User{userIdent = upsertUserIdent} <- getJust jUser
|
|
$logInfoS "SynchroniseUser" [st|Synchronising #{upsertUserIdent} with external sources|]
|
|
void $ userLookupAndUpsert (CI.original upsertUserIdent) UpsertUserSync{..}
|