diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index c65dd414f..476cfe841 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -317,7 +317,7 @@ determineCrontab = execWriterT $ do forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do tell $ HashMap.singleton - (JobCtlQueue JobSynchroniseUserdb + (JobCtlQueue JobSynchroniseUsers { jEpoch = fromInteger nextEpoch , jNumIterations = fromInteger numIntervals , jIteration = fromInteger nextInterval diff --git a/src/Jobs/Handler/SynchroniseUser.hs b/src/Jobs/Handler/SynchroniseUser.hs new file mode 100644 index 000000000..883dc8ca6 --- /dev/null +++ b/src/Jobs/Handler/SynchroniseUser.hs @@ -0,0 +1,69 @@ +-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel , Gregor Kleen +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +module Jobs.Handler.SynchroniseUser + ( dispatchJobSynchroniseUsers, dispatchJobSynchroniseUser + , SynchroniseUserException(..) + ) where + +import Import + +import qualified Data.Conduit.List as C + +import Auth.LDAP +import Auth.OAuth2 +import Foundation.Yesod.Auth (UserConversionException, upsertUser) + +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 $ do + userSourceConf <- getsYesod $ view _appUserAuthConf + case userSourceConf of + UserAuthConfSingleSource (AuthSourceConfLdap _ldapConf) -> + runDB . void . runMaybeT . handleExc $ do + ldapPool@(upsertUserLdapConf,_) <- MaybeT . getsYesod $ view _appLdapPool + user@User{userIdent = upsertUserIdent} <- MaybeT $ get jUser + $logInfoS "SynchroniseUser" [st|Synchronising #{upsertUserIdent} with LDAP|] + -- reTestAfter <- getsYesod $ view _appUserdbRetestFailover + -- ldapAttrs <- MaybeT $ campusUserReTest' ldapConf ((>= reTestAfter) . realToFrac) FailoverUnlimited user + upsertUserLdapData <- MaybeT $ ldapUser' ldapPool user + void . lift $ upsertUser UpsertUserSync{..} UpsertUserDataLdap{..} + UserAuthConfSingleSource (AuthSourceConfAzureAdV2 upsertUserAzureConf) -> + runDB . void . runMaybeT . handleExc $ do + user@User{userIdent = upsertUserIdent} <- MaybeT $ get jUser + $logInfoS "SynchroniseUser" [st|Synchronising #{upsertUserIdent} with Azure|] + upsertUserAzureData <- MaybeT $ azureUser' upsertUserAzureConf user + void . lift $ upsertUser UpsertUserSync{..} UpsertUserDataAzure{..} + where + handleExc :: MaybeT DB a -> MaybeT DB a + handleExc + = catchMPlus (Proxy @AzureUserException) + . catchMPlus (Proxy @LdapUserException) + . catchMPlus (Proxy @UserConversionException) diff --git a/src/Jobs/Handler/SynchroniseUserdb.hs b/src/Jobs/Handler/SynchroniseUserdb.hs deleted file mode 100644 index dab3233a0..000000000 --- a/src/Jobs/Handler/SynchroniseUserdb.hs +++ /dev/null @@ -1,72 +0,0 @@ --- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel , Gregor Kleen --- --- SPDX-License-Identifier: AGPL-3.0-or-later - -module Jobs.Handler.SynchroniseUserdb - ( dispatchJobSynchroniseUserdb, dispatchJobSynchroniseUserdbUser - , SynchroniseUserdbException(..) - ) where - -import Import - -import qualified Data.CaseInsensitive as CI -import qualified Data.Conduit.List as C -import qualified Data.UUID as UUID - -import Auth.LDAP -import Auth.OAuth2 -import Foundation.Yesod.Auth (CampusUserConversionException, upsertLdapUser, upsertAzureUser) - -import Jobs.Queue - - -data SynchroniseUserdbException - = SynchroniseUserdbNoUserdb - deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) -instance Exception SynchroniseUserdbException - -dispatchJobSynchroniseUserdb :: Natural -> Natural -> Natural -> JobHandler UniWorX -dispatchJobSynchroniseUserdb 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 "SynchroniseUserdb" [st|User ##{tshow (fromSqlKey userId)}: sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|] - guard $ userIteration == currentIteration - - return $ JobSynchroniseUserdbUser userId - -dispatchJobSynchroniseUserdbUser :: UserId -> JobHandler UniWorX -dispatchJobSynchroniseUserdbUser jUser = JobHandlerException $ do - userSourceConf <- getsYesod $ view _appUserSourceConf - case userSourceConf of - UserSourceConfSingleSource (UserSourceLdap _ldapConf) -> - runDB . void . runMaybeT . handleExc $ do - ldapPool <- MaybeT . getsYesod $ view _appLdapPool - user@User{userIdent,userLdapPrimaryKey} <- MaybeT $ get jUser - let upsertIdent = maybe userIdent CI.mk userLdapPrimaryKey - $logInfoS "SynchroniseUserdb" [st|Synchronising #{upsertIdent} with LDAP|] - -- reTestAfter <- getsYesod $ view _appUserdbRetestFailover - -- ldapAttrs <- MaybeT $ campusUserReTest' ldapConf ((>= reTestAfter) . realToFrac) FailoverUnlimited user - ldapAttrs <- MaybeT $ ldapUser' ldapPool user - void . lift $ upsertLdapUser (UpsertUserSync upsertIdent) ldapAttrs - UserSourceConfSingleSource (UserSourceAzureAdV2 azureConf) -> - runDB . void . runMaybeT . handleExc $ do - user@User{userIdent,userAzurePrimaryKey} <- MaybeT $ get jUser - let upsertIdent = maybe userIdent (CI.mk . UUID.toText) userAzurePrimaryKey -- TODO: use userPrincipalName - $logInfoS "SynchroniseUserdb" [st|Synchronising #{upsertIdent} with Azure|] - azureAttrs <- MaybeT $ azureUser' azureConf user - void . lift $ upsertAzureUser (UpsertUserSync upsertIdent) azureAttrs - where - handleExc :: MaybeT DB a -> MaybeT DB a - handleExc - = catchMPlus (Proxy @CampusUserException) - . catchMPlus (Proxy @CampusUserConversionException) diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 2e8100cd1..107bf627c 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022-23 Gregor Kleen ,Sarah Vaupel ,Steffen Jost +-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel , Gregor Kleen ,Sarah Vaupel ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -92,11 +92,11 @@ data Job | JobTruncateTransactionLog | JobPruneInvitations | JobDeleteTransactionLogIPs - | JobSynchroniseUserdb { jNumIterations + | JobSynchroniseUsers { jNumIterations , jEpoch , jIteration :: Natural } - | JobSynchroniseUserdbUser { jUser :: UserId } + | JobSynchroniseUser { jUser :: UserId } | JobSynchroniseAvs { jNumIterations , jEpoch , jIteration :: Natural @@ -348,8 +348,8 @@ jobNoQueueSame = \case JobTruncateTransactionLog{} -> Just JobNoQueueSame JobPruneInvitations{} -> Just JobNoQueueSame JobDeleteTransactionLogIPs{} -> Just JobNoQueueSame - JobSynchroniseUserdb{} -> Just JobNoQueueSame - JobSynchroniseUserdbUser{} -> Just JobNoQueueSame + JobSynchroniseUsers{} -> Just JobNoQueueSame + JobSynchroniseUser{} -> Just JobNoQueueSame JobSynchroniseAvs{} -> Just JobNoQueueSame JobSynchroniseAvsUser{} -> Just JobNoQueueSame JobSynchroniseAvsId{} -> Just JobNoQueueSame