diff --git a/src/Handler/SAP.hs b/src/Handler/SAP.hs index d8a0ac98a..f7b1eaffa 100644 --- a/src/Handler/SAP.hs +++ b/src/Handler/SAP.hs @@ -100,13 +100,8 @@ getQualificationSAPDirectR = do let ldapSources = case userAuthConf of UserAuthConfSingleSource (AuthSourceConfLdap LdapConf{..}) - -> [ AuthSourceIdLdap - { authSourceIdLdapHost = tshow ldapConfHost -- TODO: ugh... what to do in case of tls? - , authSourceIdLdapPort = fromInteger $ toInteger ldapConfPort -- TODO: ugh... - } - ] - _other - -> mempty + -> singleton $ AuthSourceIdLdap ldapConfSourceId + _other -> mempty ldapCutoff = addDiffDaysRollOver (fromMonths $ -3) now qualUsers <- runDB $ E.select $ do diff --git a/src/Jobs/HealthReport.hs b/src/Jobs/HealthReport.hs index 403a78f4c..04f4f9006 100644 --- a/src/Jobs/HealthReport.hs +++ b/src/Jobs/HealthReport.hs @@ -110,10 +110,13 @@ dispatchHealthCheckHTTPReachable = fmap HealthHTTPReachable . yesodTimeout (^. _ dispatchHealthCheckLDAPAdmins :: Handler HealthReport dispatchHealthCheckLDAPAdmins = fmap HealthLDAPAdmins . yesodTimeout (^. _appHealthCheckLDAPAdminsTimeout) (Just 0) $ do ldapPool' <- getsYesod appLdapPool ---reTestAfter <- getsYesod $ view _appUserdbRetestFailover + userAuthConf <- getsYesod $ view _appUserAuthConf case ldapPool' of Just ldapPool -> do - currentLdapSources <- return [] -- TODO: fetch from current user-auth config + let currentLdapSources = case userAuthConf of + UserAuthConfSingleSource (AuthSourceConfLdap LdapConf{..}) + -> singleton $ AuthSourceIdLdap ldapConfSourceId + _other -> mempty 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 diff --git a/src/Model/Types/Auth.hs b/src/Model/Types/Auth.hs index 5747661f6..fe683f258 100644 --- a/src/Model/Types/Auth.hs +++ b/src/Model/Types/Auth.hs @@ -43,7 +43,6 @@ import Data.Universe import Data.Universe.Instances.Reverse () import Data.Universe.Instances.Reverse.MonoTraversable () import Data.UUID (UUID) -import Data.Word (Word16) import Database.Persist.Sql @@ -79,8 +78,7 @@ data AuthSourceIdent { authSourceIdAzureClientId :: UUID } | AuthSourceIdLdap - { authSourceIdLdapHost :: Text -- See comment above for why we do not use Ldap.Host directly - , authSourceIdLdapPort :: Word16 -- See comment above for why we do not use Ldap.PortNumber directly + { authSourceIdLdapHost :: Text -- normally either just the hostname, or hostname and port } deriving (Eq, Ord, Read, Show, Data, Generic) deriving anyclass (NFData) diff --git a/src/Settings/Ldap.hs b/src/Settings/Ldap.hs index 44d0a4dd9..ae821f155 100644 --- a/src/Settings/Ldap.hs +++ b/src/Settings/Ldap.hs @@ -26,6 +26,7 @@ import Ldap.Client.Instances () data LdapConf = LdapConf { ldapConfHost :: Ldap.Host , ldapConfPort :: Ldap.PortNumber + , ldapConfSourceId :: Text -- ^ Some unique identifier for this LDAP instance, e.g. hostname or hostname:port , ldapConfDn :: Ldap.Dn , ldapConfPassword :: Ldap.Password , ldapConfBase :: Ldap.Dn @@ -48,8 +49,12 @@ instance FromJSON LdapConf where | null spec -> return Nothing Nothing -> return Nothing _otherwise -> fail "Could not parse LDAP TLSSettings" - ldapConfHost <- maybe Ldap.Plain (flip Ldap.Tls) tlsSettings <$> o .:? "host" .!= "" - ldapConfPort <- (fromIntegral :: Int -> Ldap.PortNumber) <$> o .: "port" + hostname :: Text <- o .: "host" + port :: Int <- o .: "port" + let + ldapConfHost = maybe Ldap.Plain (flip Ldap.Tls) tlsSettings $ show hostname + ldapConfPort = fromIntegral port + ldapConfSourceId <- o .:? "source-id" .!= hostname ldapConfDn <- Ldap.Dn <$> o .:? "user" .!= "" ldapConfPassword <- Ldap.Password . Text.encodeUtf8 <$> o .:? "pass" .!= "" ldapConfBase <- Ldap.Dn <$> o .:? "baseDN" .!= "" diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index 881598b6d..2b10fa14f 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -134,7 +134,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later $case sourceIdent $of AuthSourceIdAzure _clientId _{MsgAuthKindAzure}: # - $of AuthSourceIdLdap _host _port + $of AuthSourceIdLdap _sourceId _{MsgAuthKindLDAP}: # #{authIdent} #