refactor(jobs): ldap->userdb

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

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

src/Jobs/Handler/SynchroniseLdap.hs

@@ -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)

src/Jobs/Handler/SynchroniseUserdb.hs

@@ -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)

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