chore(ldap): refactor ldapLogin type
This commit is contained in:
parent
d4a3459adf
commit
aa893062f1
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
]
|
]
|
||||||
|
|||||||
Reference in New Issue
Block a user