refactor(jobs): ldap->userdb
This commit is contained in:
parent
12bb8b7145
commit
ff5b31929e
@ -71,7 +71,7 @@ import Jobs.Handler.SendCourseCommunication
|
|||||||
import Jobs.Handler.Invitation
|
import Jobs.Handler.Invitation
|
||||||
import Jobs.Handler.SendPasswordReset
|
import Jobs.Handler.SendPasswordReset
|
||||||
import Jobs.Handler.TransactionLog
|
import Jobs.Handler.TransactionLog
|
||||||
import Jobs.Handler.SynchroniseLdap
|
import Jobs.Handler.SynchroniseUserdb
|
||||||
import Jobs.Handler.SynchroniseAvs
|
import Jobs.Handler.SynchroniseAvs
|
||||||
import Jobs.Handler.PruneInvitations
|
import Jobs.Handler.PruneInvitations
|
||||||
import Jobs.Handler.ChangeUserDisplayEmail
|
import Jobs.Handler.ChangeUserDisplayEmail
|
||||||
@ -493,7 +493,7 @@ handleJobs' wNum = C.mapM_ $ \jctl -> hoist delimitInternalState . withJobWorker
|
|||||||
, Exc.Handler $ \case
|
, Exc.Handler $ \case
|
||||||
MailNotAvailable -> return $ Right ()
|
MailNotAvailable -> return $ Right ()
|
||||||
e -> return . Left $ SomeException e
|
e -> return . Left $ SomeException e
|
||||||
, Exc.Handler $ \SynchroniseLdapNoLdap -> return $ Right ()
|
, Exc.Handler $ \SynchroniseUserdbNoLdap -> return $ Right () -- TODO
|
||||||
#endif
|
#endif
|
||||||
, Exc.Handler $ \(e :: SomeException) -> return $ Left e
|
, Exc.Handler $ \(e :: SomeException) -> return $ Left e
|
||||||
] . fmap Right
|
] . fmap Right
|
||||||
|
|||||||
@ -310,7 +310,6 @@ determineCrontab = execWriterT $ do
|
|||||||
return (nextEpoch, nextInterval, nextIntervalTime, numIntervals)
|
return (nextEpoch, nextInterval, nextIntervalTime, numIntervals)
|
||||||
|
|
||||||
if
|
if
|
||||||
-- TODO: generalize user sync job to oauth
|
|
||||||
| Just syncWithin <- appUserdbSyncWithin
|
| Just syncWithin <- appUserdbSyncWithin
|
||||||
, Just cInterval <- appJobCronInterval
|
, Just cInterval <- appJobCronInterval
|
||||||
-> do
|
-> do
|
||||||
@ -318,7 +317,7 @@ determineCrontab = execWriterT $ do
|
|||||||
|
|
||||||
forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do
|
forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do
|
||||||
tell $ HashMap.singleton
|
tell $ HashMap.singleton
|
||||||
(JobCtlQueue JobSynchroniseLdap
|
(JobCtlQueue JobSynchroniseUserdb
|
||||||
{ jEpoch = fromInteger nextEpoch
|
{ jEpoch = fromInteger nextEpoch
|
||||||
, jNumIterations = fromInteger numIntervals
|
, jNumIterations = fromInteger numIntervals
|
||||||
, jIteration = fromInteger nextInterval
|
, jIteration = fromInteger nextInterval
|
||||||
|
|||||||
@ -1,64 +0,0 @@
|
|||||||
-- 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.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)
|
|
||||||
68
src/Jobs/Handler/SynchroniseUserdb.hs
Normal file
68
src/Jobs/Handler/SynchroniseUserdb.hs
Normal file
@ -0,0 +1,68 @@
|
|||||||
|
-- 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.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)
|
||||||
@ -92,11 +92,11 @@ data Job
|
|||||||
| JobTruncateTransactionLog
|
| JobTruncateTransactionLog
|
||||||
| JobPruneInvitations
|
| JobPruneInvitations
|
||||||
| JobDeleteTransactionLogIPs
|
| JobDeleteTransactionLogIPs
|
||||||
| JobSynchroniseLdap { jNumIterations
|
| JobSynchroniseUserdb { jNumIterations
|
||||||
, jEpoch
|
, jEpoch
|
||||||
, jIteration :: Natural
|
, jIteration :: Natural
|
||||||
}
|
}
|
||||||
| JobSynchroniseLdapUser { jUser :: UserId }
|
| JobSynchroniseUserdbUser { jUser :: UserId }
|
||||||
| JobSynchroniseAvs { jNumIterations
|
| JobSynchroniseAvs { jNumIterations
|
||||||
, jEpoch
|
, jEpoch
|
||||||
, jIteration :: Natural
|
, jIteration :: Natural
|
||||||
@ -348,8 +348,8 @@ jobNoQueueSame = \case
|
|||||||
JobTruncateTransactionLog{} -> Just JobNoQueueSame
|
JobTruncateTransactionLog{} -> Just JobNoQueueSame
|
||||||
JobPruneInvitations{} -> Just JobNoQueueSame
|
JobPruneInvitations{} -> Just JobNoQueueSame
|
||||||
JobDeleteTransactionLogIPs{} -> Just JobNoQueueSame
|
JobDeleteTransactionLogIPs{} -> Just JobNoQueueSame
|
||||||
JobSynchroniseLdap{} -> Just JobNoQueueSame
|
JobSynchroniseUserdb{} -> Just JobNoQueueSame
|
||||||
JobSynchroniseLdapUser{} -> Just JobNoQueueSame
|
JobSynchroniseUserdbUser{} -> Just JobNoQueueSame
|
||||||
JobSynchroniseAvs{} -> Just JobNoQueueSame
|
JobSynchroniseAvs{} -> Just JobNoQueueSame
|
||||||
JobSynchroniseAvsUser{} -> Just JobNoQueueSame
|
JobSynchroniseAvsUser{} -> Just JobNoQueueSame
|
||||||
JobSynchroniseAvsId{} -> Just JobNoQueueSame
|
JobSynchroniseAvsId{} -> Just JobNoQueueSame
|
||||||
|
|||||||
Reference in New Issue
Block a user