diff --git a/src/Jobs.hs b/src/Jobs.hs index f48922abb..79c17ba25 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -71,7 +71,7 @@ import Jobs.Handler.SendCourseCommunication import Jobs.Handler.Invitation import Jobs.Handler.SendPasswordReset import Jobs.Handler.TransactionLog -import Jobs.Handler.SynchroniseLdap +import Jobs.Handler.SynchroniseUserdb import Jobs.Handler.SynchroniseAvs import Jobs.Handler.PruneInvitations import Jobs.Handler.ChangeUserDisplayEmail @@ -493,7 +493,7 @@ handleJobs' wNum = C.mapM_ $ \jctl -> hoist delimitInternalState . withJobWorker , Exc.Handler $ \case MailNotAvailable -> return $ Right () e -> return . Left $ SomeException e - , Exc.Handler $ \SynchroniseLdapNoLdap -> return $ Right () + , Exc.Handler $ \SynchroniseUserdbNoLdap -> return $ Right () -- TODO #endif , Exc.Handler $ \(e :: SomeException) -> return $ Left e ] . fmap Right diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index 3f38e7724..15819e6de 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -310,7 +310,6 @@ determineCrontab = execWriterT $ do return (nextEpoch, nextInterval, nextIntervalTime, numIntervals) if - -- TODO: generalize user sync job to oauth | Just syncWithin <- appUserdbSyncWithin , Just cInterval <- appJobCronInterval -> do @@ -318,7 +317,7 @@ determineCrontab = execWriterT $ do forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do tell $ HashMap.singleton - (JobCtlQueue JobSynchroniseLdap + (JobCtlQueue JobSynchroniseUserdb { jEpoch = fromInteger nextEpoch , jNumIterations = fromInteger numIntervals , jIteration = fromInteger nextInterval diff --git a/src/Jobs/Handler/SynchroniseLdap.hs b/src/Jobs/Handler/SynchroniseLdap.hs deleted file mode 100644 index 1a83dc555..000000000 --- a/src/Jobs/Handler/SynchroniseLdap.hs +++ /dev/null @@ -1,64 +0,0 @@ --- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel , Gregor Kleen --- --- SPDX-License-Identifier: AGPL-3.0-or-later - -module Jobs.Handler.SynchroniseLdap - ( dispatchJobSynchroniseLdap, dispatchJobSynchroniseLdapUser - , SynchroniseLdapException(..) - ) where - -import Import - -import qualified Data.CaseInsensitive as CI -import qualified Data.Conduit.List as C - -import Auth.LDAP -import Foundation.Yesod.Auth (CampusUserConversionException, upsertCampusUser) - -import Jobs.Queue - - -data SynchroniseLdapException - = SynchroniseLdapNoLdap - deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) -instance Exception SynchroniseLdapException - -dispatchJobSynchroniseLdap :: Natural -> Natural -> Natural -> JobHandler UniWorX -dispatchJobSynchroniseLdap 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 "SynchroniseLdap" [st|User ##{tshow (fromSqlKey userId)}: sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|] - guard $ userIteration == currentIteration - - return $ JobSynchroniseLdapUser userId - -dispatchJobSynchroniseLdapUser :: UserId -> JobHandler UniWorX -dispatchJobSynchroniseLdapUser jUser = JobHandlerException $ do - UniWorX{..} <- getYesod - case appLdapPool of - Just ldapPool -> - runDB . void . runMaybeT . handleExc $ do - user@User{userIdent,userLdapPrimaryKey} <- MaybeT $ get jUser - let upsertIdent = maybe userIdent CI.mk userLdapPrimaryKey - $logInfoS "SynchroniseLdap" [st|Synchronising #{upsertIdent}|] - - reTestAfter <- getsYesod $ view _appUserdbRetestFailover - ldapAttrs <- MaybeT $ campusUserReTest' ldapPool ((>= reTestAfter) . realToFrac) FailoverUnlimited user - void . lift $ upsertCampusUser (UpsertCampusUserLdapSync upsertIdent) ldapAttrs - Nothing -> - throwM SynchroniseLdapNoLdap - where - handleExc :: MaybeT DB a -> MaybeT DB a - handleExc - = catchMPlus (Proxy @CampusUserException) - . catchMPlus (Proxy @CampusUserConversionException) diff --git a/src/Jobs/Handler/SynchroniseUserdb.hs b/src/Jobs/Handler/SynchroniseUserdb.hs new file mode 100644 index 000000000..954a5edf2 --- /dev/null +++ b/src/Jobs/Handler/SynchroniseUserdb.hs @@ -0,0 +1,68 @@ +-- 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 Auth.LDAP +import Foundation.Yesod.Auth (CampusUserConversionException, upsertCampusUser) + +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 + UniWorX{..} <- getYesod + case appUserDbConf of + UserDbSingleSource (UserDbLdap ldapConf) -> + runDB . void . runMaybeT . handleExc $ do + 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 $ campusUserReTest' ldapConf ((>= reTestAfter) . realToFrac) FailoverUnlimited user + void . lift $ upsertLdapUser (UpsertLdapUserLdapSync upsertIdent) ldapAttrs + UserDbSingleSource (UserDbOAuth2 oauth2Conf) -> + runDB . void . runMaybeT . handleExc $ do + user@User{userIdent,userAzurePrimaryKey} <- MaybeT $ get jUser + let upsertIdent = maybe userIdent CI.mk userAzurePrimaryKey + $logInfoS "SynchroniseUserdb" [st|Synchronising #{upsertIdent} with Azure|] + void . lift $ upsertAzureUser (UpsertAzureUserSync upsertIdent) oauth2Conf + 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 dc8e04120..2e8100cd1 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -92,11 +92,11 @@ data Job | JobTruncateTransactionLog | JobPruneInvitations | JobDeleteTransactionLogIPs - | JobSynchroniseLdap { jNumIterations + | JobSynchroniseUserdb { jNumIterations , jEpoch , jIteration :: Natural } - | JobSynchroniseLdapUser { jUser :: UserId } + | JobSynchroniseUserdbUser { jUser :: UserId } | JobSynchroniseAvs { jNumIterations , jEpoch , jIteration :: Natural @@ -348,8 +348,8 @@ jobNoQueueSame = \case JobTruncateTransactionLog{} -> Just JobNoQueueSame JobPruneInvitations{} -> Just JobNoQueueSame JobDeleteTransactionLogIPs{} -> Just JobNoQueueSame - JobSynchroniseLdap{} -> Just JobNoQueueSame - JobSynchroniseLdapUser{} -> Just JobNoQueueSame + JobSynchroniseUserdb{} -> Just JobNoQueueSame + JobSynchroniseUserdbUser{} -> Just JobNoQueueSame JobSynchroniseAvs{} -> Just JobNoQueueSame JobSynchroniseAvsUser{} -> Just JobNoQueueSame JobSynchroniseAvsId{} -> Just JobNoQueueSame