From eedb78664d0634531dd315af9febd3c4e5fada12 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 8 Feb 2023 16:48:59 +0100 Subject: [PATCH] chore(ldap): ldap sync uses prefers UserLdapPrimaryKey if available. Ref #29 --- src/Auth/LDAP.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index ecc9f160b..18478bb34 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -143,8 +143,10 @@ campusUserReTest :: (MonadUnliftIO m, MonadMask m, MonadLogger m) => Failover ( campusUserReTest pool doTest mode creds = throwLeft =<< campusUserWith (\l -> flip (withLdapFailoverReTest l) doTest) pool mode creds campusUserReTest' :: (MonadMask m, MonadLogger m, MonadUnliftIO m) => Failover (LdapConf, LdapPool) -> (Nano -> Bool) -> FailoverMode -> User -> m (Maybe (Ldap.AttrList [])) -campusUserReTest' pool doTest mode User{userIdent} - = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) $ campusUserReTest pool doTest mode (Creds apLdap (CI.original userIdent) []) +campusUserReTest' pool doTest mode User{userIdent,userLdapPrimaryKey} + = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) $ campusUserReTest pool doTest mode (Creds apLdap upsertIdent []) + where upsertIdent = fromMaybe (CI.original userIdent) userLdapPrimaryKey + campusUser :: (MonadMask m, MonadUnliftIO m, MonadLogger m) => Failover (LdapConf, LdapPool) -> FailoverMode -> Creds site -> m (Ldap.AttrList []) campusUser pool mode creds = throwLeft =<< campusUserWith withLdapFailover pool mode creds