fix: fallback for determining user email

This commit is contained in:
Gregor Kleen 2019-10-15 14:41:36 +02:00
parent cb88fffcad
commit 6a1a256cc2
2 changed files with 9 additions and 4 deletions

View File

@ -59,9 +59,8 @@ findUser LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM (not
, Ldap.derefAliases Ldap.DerefAlways
]
ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation, ldapSex :: Ldap.Attr
ldapUserPrincipalName, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation, ldapSex :: Ldap.Attr
ldapUserPrincipalName = Ldap.Attr "userPrincipalName"
ldapUserEmail = Ldap.Attr "mail"
ldapUserDisplayName = Ldap.Attr "displayName"
ldapUserMatriculation = Ldap.Attr "LMU-Stud-Matrikelnummer"
ldapUserFirstName = Ldap.Attr "givenName"
@ -72,6 +71,12 @@ ldapUserFieldName = Ldap.Attr "dfnEduPersonFieldOfStudyString"
ldapUserSchoolAssociation = Ldap.Attr "LMU-IFI-eduPersonOrgUnitDNString"
ldapSex = Ldap.Attr "schacGender"
ldapUserEmail :: [Ldap.Attr]
ldapUserEmail =
[ Ldap.Attr "mail"
, Ldap.Attr "name"
]
data CampusUserException = CampusUserLdapError LdapPoolError
| CampusUserHostNotResolved String

View File

@ -3366,7 +3366,7 @@ upsertCampusUser ldapData Creds{..} = do
let
userMatrikelnummer' = fold [ v | (k, v) <- ldapData, k == ldapUserMatriculation ]
userEmail' = fold [ v | (k, v) <- ldapData, k == ldapUserEmail ]
userEmail' = fold [ v | (k, v) <- ldapData, k' <- ldapUserEmail, k' == k ]
userDisplayName'' = fold [ v | (k, v) <- ldapData, k == ldapUserDisplayName ]
userFirstName' = fold [ v | (k, v) <- ldapData, k == ldapUserFirstName ]
userSurname' = fold [ v | (k, v) <- ldapData, k == ldapUserSurname ]
@ -3379,7 +3379,7 @@ upsertCampusUser ldapData Creds{..} = do
userLastAuthentication = now <$ guard (not isDummy)
userEmail <- if
| [bs] <- userEmail'
| bs : _ <- userEmail'
, Right userEmail <- Text.decodeUtf8' bs
-> return $ mk userEmail
| otherwise