diff --git a/src/Jobs/HealthReport.hs b/src/Jobs/HealthReport.hs index ea9ef1c19..403a78f4c 100644 --- a/src/Jobs/HealthReport.hs +++ b/src/Jobs/HealthReport.hs @@ -113,18 +113,21 @@ dispatchHealthCheckLDAPAdmins = fmap HealthLDAPAdmins . yesodTimeout (^. _appHea --reTestAfter <- getsYesod $ view _appUserdbRetestFailover case ldapPool' of Just ldapPool -> do + currentLdapSources <- return [] -- TODO: fetch from current user-auth config ldapAdminUsers' <- fmap (map E.unValue) . runDB . E.select . E.from $ \(user `E.InnerJoin` userFunction) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin - E.where_ $ user E.^. UserAuthentication E.==. E.val AuthLDAP + E.where_ . E.exists . E.from $ \externalAuth -> E.where_ $ + externalAuth E.^. ExternalAuthUser E.==. user E.^. UserId + E.&&. externalAuth E.^. ExternalAuthSource `E.in_` E.valList currentLdapSources return $ user E.^. UserIdent for (assertM' (not . null) ldapAdminUsers') $ \ldapAdminUsers -> do let numAdmins = genericLength ldapAdminUsers 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 <$ ldapUser ldapPool (Creds apLdap adminIdent []) - --in handle hCampusExc $ Sum 1 <$ ldapUserReTest ldapPool (const True) FailoverUnlimited (Creds apLdap adminIdent []) + let hLdapExc :: LdapUserException -> Handler (Sum Integer) + hLdapExc err = mempty <$ $logErrorS "healthCheckLDAPAdmins" (adminIdent <> ": " <> tshow err) + in handle hLdapExc $ Sum 1 <$ ldapUser ldapPool (Creds apLdap adminIdent []) + --in handle hLdapExc $ Sum 1 <$ ldapUserReTest ldapPool (const True) FailoverUnlimited (Creds apLdap adminIdent []) if | numAdmins >= 1 -> return $ numResolved % numAdmins | otherwise -> return 0