chore(ldap): refactor ldapLogin type

This commit is contained in:
Sarah Vaupel 2024-01-28 18:16:10 +01:00
parent d4a3459adf
commit aa893062f1
2 changed files with 6 additions and 5 deletions

View File

@ -263,6 +263,7 @@ campusForm = do
<*> areq passwordField (fslpI MsgCampusPassword (mr MsgCampusPasswordPlaceholder) & addAttr "autocomplete" "current-password") Nothing <*> areq passwordField (fslpI MsgCampusPassword (mr MsgCampusPasswordPlaceholder) & addAttr "autocomplete" "current-password") Nothing
-- TODO: reintroduce Failover
ldapLogin :: forall site. ldapLogin :: forall site.
( YesodAuth site ( YesodAuth site
, RenderMessage site CampusMessage , RenderMessage site CampusMessage
@ -271,10 +272,10 @@ ldapLogin :: forall site.
, RenderMessage site ADInvalidCredentials , RenderMessage site ADInvalidCredentials
, Button site ButtonSubmit , Button site ButtonSubmit
) )
=> (LdapConf, LdapPool) -- TODO: reintroduce Failover => LdapConf
-> FailoverMode -> LdapPool
-> AuthPlugin site -> AuthPlugin site
ldapLogin pool mode = AuthPlugin{..} ldapLogin conf@LdapConf{..} pool = AuthPlugin{..}
where where
apName :: Text apName :: Text
apName = apLdap apName = apLdap
@ -285,7 +286,7 @@ ldapLogin pool mode = AuthPlugin{..}
tp <- getRouteToParent tp <- getRouteToParent
resp <- formResultMaybe loginRes $ \CampusLogin{ campusIdent = CI.original -> campusIdent, ..} -> Just <$> do resp <- formResultMaybe loginRes $ \CampusLogin{ campusIdent = CI.original -> campusIdent, ..} -> Just <$> do
ldapResult <- withLdap _2 pool mode $ \(conf@LdapConf{..}, ldap) -> liftIO $ do ldapResult <- withLdap pool $ \ldap -> liftIO $ do
Ldap.bind ldap ldapDn ldapPassword Ldap.bind ldap ldapDn ldapPassword
searchResults <- findUser conf ldap campusIdent [ldapUserPrincipalName] searchResults <- findUser conf ldap campusIdent [ldapUserPrincipalName]
case searchResults of case searchResults of

View File

@ -142,7 +142,7 @@ instance YesodAuth UniWorX where
authenticate = UniWorX.authenticate authenticate = UniWorX.authenticate
authPlugins UniWorX{ appSettings' = AppSettings{..}, appLdapPool, appAuthPlugins } = appAuthPlugins ++ catMaybes authPlugins UniWorX{ appSettings' = AppSettings{..}, appLdapPool, appAuthPlugins } = appAuthPlugins ++ catMaybes
[ flip campusLogin campusUserFailoverMode <$> appLdapPool [ uncurry ldapLogin <$> appLdapPool
, Just . hashLogin $ pwHashAlgorithm appAuthPWHash , Just . hashLogin $ pwHashAlgorithm appAuthPWHash
, dummyLogin <$ guard appAuthDummyLogin , dummyLogin <$ guard appAuthDummyLogin
] ]