fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Flexiblere LDAP identifier via trial and error

Browse Source 
Fixes #285
This commit is contained in:
Gregor Kleen 2019-04-02 14:44:19 +02:00
parent 6fbb1888c5
commit f75c1bdb70
2 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Auth/LDAP.hs
View File

@ -6,7 +6,7 @@ module Auth.LDAP
, Ldap.AttrList, Ldap.Attr(..), Ldap.AttrValue
) where
import Import.NoFoundation
import Import.NoFoundation hiding (userEmail, userDisplayName)
import Control.Lens
import Network.Connection
@ -39,9 +39,16 @@ data CampusMessage = MsgCampusIdentNote
findUser :: LdapConf -> Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry]
findUser LdapConf{..} ldap campusIdent = Ldap.search ldap ldapBase userSearchSettings userFilter
findUser LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM (not . null) . lift . flip (Ldap.search ldap ldapBase userSearchSettings) retAttrs) userFilters
where
userFilter = userPrincipalName Ldap.:= Text.encodeUtf8 campusIdent
userFilters =
[ userPrincipalName Ldap.:= Text.encodeUtf8 ident
, userPrincipalName Ldap.:= Text.encodeUtf8 [st|#{ident}@campus.lmu.de|]
, userEmail Ldap.:= Text.encodeUtf8 ident
, userEmail Ldap.:= Text.encodeUtf8 [st|#{ident}@lmu.de|]
, userEmail Ldap.:= Text.encodeUtf8 [st|#{ident}@campus.lmu.de|]
, userDisplayName Ldap.:= Text.encodeUtf8 ident
]
userSearchSettings = mconcat
[ Ldap.scope ldapScope
, Ldap.size 2
@ -49,8 +56,10 @@ findUser LdapConf{..} ldap campusIdent = Ldap.search ldap ldapBase userSearchSet
, Ldap.derefAliases Ldap.DerefAlways
]
userPrincipalName :: Ldap.Attr
userPrincipalName, userEmail, userDisplayName :: Ldap.Attr
userPrincipalName = Ldap.Attr "userPrincipalName"
userEmail = Ldap.Attr "mail"
userDisplayName = Ldap.Attr "displayName"
campusForm :: ( RenderMessage site FormMessage
, RenderMessage site CampusMessage

3
src/Utils.hs
View File

@ -587,6 +587,9 @@ mconcatMapM f = foldM (\x my -> mappend x <$> my) mempty . map f . Fold.toList
mconcatForM :: (Monoid b, Monad m, Foldable f) => f a -> (a -> m b) -> m b
mconcatForM = flip mconcatMapM
findM :: (Monad m, Foldable f) => (a -> MaybeT m b) -> f a -> m (Maybe b)
findM f = runMaybeT . Fold.foldr (\x as -> f x <|> as) mzero
-----------------
-- Alternative --
-----------------