From c8350722a41bbfae1b4c862fb9958d0e6f8102f1 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 30 Jan 2024 14:01:54 +0100 Subject: [PATCH] chore(ldap): migrate more campusUser usages --- src/Handler/Admin/Ldap.hs | 8 ++++---- src/Handler/Utils/Avs.hs | 5 +++-- src/Handler/Utils/Users.hs | 6 +++--- src/Jobs/Handler/SynchroniseUserdb.hs | 10 +++++----- src/Jobs/HealthReport.hs | 3 ++- 5 files changed, 17 insertions(+), 15 deletions(-) diff --git a/src/Handler/Admin/Ldap.hs b/src/Handler/Admin/Ldap.hs index c3ed22c2a..27e88eab5 100644 --- a/src/Handler/Admin/Ldap.hs +++ b/src/Handler/Admin/Ldap.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022 Steffen Jost +-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel , Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -16,7 +16,7 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -- import qualified Data.Set as Set -import Foundation.Yesod.Auth (decodeUserTest,ldapLookupAndUpsert,campusUserFailoverMode,CampusUserConversionException()) +import Foundation.Yesod.Auth (decodeLdapUserTest,ldapLookupAndUpsert,CampusUserConversionException()) import Handler.Utils import qualified Ldap.Client as Ldap @@ -36,8 +36,8 @@ postAdminLdapR = do Nothing -> addMessage Error (text2Html "LDAP Configuration missing.") >> return Nothing Just ldapPool -> do addMessage Info $ text2Html "Input for LDAP test received." - ldapData <- campusUser'' ldapPool campusUserFailoverMode lid - decodedErr <- decodeUserTest (pure $ CI.mk lid) $ concat ldapData + ldapData <- ldapUser'' ldapPool lid + decodedErr <- decodeLdapUserTest (pure $ CI.mk lid) $ concat ldapData whenIsLeft decodedErr $ addMessageI Error return ldapData mbLdapData <- formResultMaybe presult procFormPerson diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 160a3f337..0f0b8094b 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -421,7 +421,7 @@ upsertAvsUserById api = do (_:_) -> throwM $ AvsUserAmbiguous api [] -> do upsRes :: Either SomeException (Entity User) - <- try $ ldapLookupAndUpsert persNo + <- try $ ldapLookupAndUpsert persNo -- TODO: do azure lookup and upsert if appropriate $logInfoS "AVS" $ "No matching existing user found. Attempted LDAP upsert returned: " <> tshow upsRes case upsRes of Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid avsPersonPersonNo now Nothing -- pin/addr are updated in next step anyway @@ -460,7 +460,8 @@ upsertAvsUserById api = do , audPinPassword = userPin , audEmail = fakeNo -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO) , audIdent = fakeIdent -- use AvsPersonId instead - , audAuth = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personnel number is known + , audAuth = maybe AuthKindNoLogin (const AuthKindAzure) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personnel number is known + , audAzureId = Nothing -- TODO } mbUid <- addNewUser newUsr -- triggers JobSynchroniseUserdbUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe whenIsJust mbUid $ \uid -> runDB $ do diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 0ef0eb1d2..45b738c07 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -25,7 +25,7 @@ module Handler.Utils.Users import Import import Auth.LDAP (ldapUserMatr') -import Foundation.Yesod.Auth (upsertCampusUser) +import Foundation.Yesod.Auth (upsertLdapUser) import Crypto.Hash (hashlazy) @@ -241,8 +241,8 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria) doLdap userMatr = do ldapPool' <- getsYesod $ view _appLdapPool fmap join . for ldapPool' $ \ldapPool -> do - ldapData <- ldapUserMatr' ldapPool FailoverUnlimited userMatr - for ldapData $ upsertCampusUser UpsertCampusUserGuessUser + ldapData <- ldapUserMatr' ldapPool userMatr + for ldapData $ upsertLdapUser UpsertUserGuessUser let getTermMatr :: [PredLiteral GuessUserInfo] -> Maybe UserMatriculation diff --git a/src/Jobs/Handler/SynchroniseUserdb.hs b/src/Jobs/Handler/SynchroniseUserdb.hs index 34069a90d..210977893 100644 --- a/src/Jobs/Handler/SynchroniseUserdb.hs +++ b/src/Jobs/Handler/SynchroniseUserdb.hs @@ -13,7 +13,7 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Conduit.List as C import Auth.LDAP -import Foundation.Yesod.Auth (CampusUserConversionException, upsertCampusUser) +import Foundation.Yesod.Auth (CampusUserConversionException, upsertLdapUser, upsertAzureUser) import Jobs.Queue @@ -53,14 +53,14 @@ dispatchJobSynchroniseUserdbUser jUser = JobHandlerException $ do $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 - UserSourceConfSingleSource (UserSourceAzure azureConf) -> + ldapAttrs <- MaybeT $ ldapUser ldapConf 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 userAzurePrimaryKey $logInfoS "SynchroniseUserdb" [st|Synchronising #{upsertIdent} with Azure|] - void . lift $ upsertAzureUser (UpsertAzureUserSync upsertIdent) azureConf + void . lift $ upsertAzureUser (UpsertUserSync upsertIdent) azureConf where handleExc :: MaybeT DB a -> MaybeT DB a handleExc diff --git a/src/Jobs/HealthReport.hs b/src/Jobs/HealthReport.hs index 56092fc7c..ea9ef1c19 100644 --- a/src/Jobs/HealthReport.hs +++ b/src/Jobs/HealthReport.hs @@ -123,7 +123,8 @@ dispatchHealthCheckLDAPAdmins = fmap HealthLDAPAdmins . yesodTimeout (^. _appHea Sum numResolved <- fmap fold . forM ldapAdminUsers $ \(CI.original -> adminIdent) -> let hCampusExc :: CampusUserException -> Handler (Sum Integer) hCampusExc err = mempty <$ $logErrorS "healthCheckLDAPAdmins" (adminIdent <> ": " <> tshow err) - in handle hCampusExc $ Sum 1 <$ ldapUserReTest ldapPool (const True) FailoverUnlimited (Creds apLdap adminIdent []) + in handle hCampusExc $ Sum 1 <$ ldapUser ldapPool (Creds apLdap adminIdent []) + --in handle hCampusExc $ Sum 1 <$ ldapUserReTest ldapPool (const True) FailoverUnlimited (Creds apLdap adminIdent []) if | numAdmins >= 1 -> return $ numResolved % numAdmins | otherwise -> return 0