fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore(auth): campusLogin->ldapLogin

Browse Source
This commit is contained in:
Sarah Vaupel 2024-01-28 12:45:59 +01:00
parent 7e3e772055
commit e9bbeffd7e
1 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/Auth/LDAP.hs
View File

@ -7,7 +7,7 @@
module Auth.LDAP module Auth.LDAP
( apLdap ( apLdap
, ADError(..), ADInvalidCredentials(..) , ADError(..), ADInvalidCredentials(..)
, campusLogin , ldapLogin
, CampusUserException(..) , CampusUserException(..)
, ldapUser, ldapUser', ldapUser'' , ldapUser, ldapUser', ldapUser''
, ldapUserReTest, ldapUserReTest' , ldapUserReTest, ldapUserReTest'
@ -263,18 +263,18 @@ campusForm = do
<*> areq passwordField (fslpI MsgCampusPassword (mr MsgCampusPasswordPlaceholder) & addAttr "autocomplete" "current-password") Nothing <*> areq passwordField (fslpI MsgCampusPassword (mr MsgCampusPasswordPlaceholder) & addAttr "autocomplete" "current-password") Nothing
campusLogin :: forall site. ldapLogin :: forall site.
( YesodAuth site ( YesodAuth site
, RenderMessage site CampusMessage , RenderMessage site CampusMessage
, RenderAFormSite site , RenderAFormSite site
, RenderMessage site (ValueRequired site) , RenderMessage site (ValueRequired site)
, RenderMessage site ADInvalidCredentials , RenderMessage site ADInvalidCredentials
, Button site ButtonSubmit , Button site ButtonSubmit
) )
=> Failover (LdapConf, LdapPool) => (LdapConf, LdapPool) -- TODO: reintroduce Failover
-> FailoverMode -> FailoverMode
-> AuthPlugin site -> AuthPlugin site
campusLogin pool mode = AuthPlugin{..} ldapLogin pool mode = AuthPlugin{..}
where where
apName :: Text apName :: Text
apName = apLdap apName = apLdap
@ -285,7 +285,7 @@ campusLogin 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 <- withLdapFailover _2 pool mode $ \(conf@LdapConf{..}, ldap) -> liftIO $ do ldapResult <- withLdap _2 pool mode $ \(conf@LdapConf{..}, 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