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(foundation): fix ldap auth and user lookup

Browse Source
This commit is contained in:
Sarah Vaupel 2024-01-30 11:42:45 +01:00
parent 1cdb20eb60
commit 8e2a98c12b
1 changed files with 18 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
src/Foundation/Yesod/Auth.hs
View File

@ -4,11 +4,11 @@
module Foundation.Yesod.Auth module Foundation.Yesod.Auth
( authenticate ( authenticate
-- , ldapLookupAndUpsert , ldapLookupAndUpsert
, upsertLdapUser, upsertAzureUser , upsertLdapUser, upsertAzureUser
, decodeLdapUserTest, decodeAzureUserTest , decodeLdapUserTest, decodeAzureUserTest
, CampusUserConversionException(..) , CampusUserConversionException(..)
, campusUserFailoverMode, updateUserLanguage , updateUserLanguage
) where ) where
import Import.NoFoundation hiding (authenticate) import Import.NoFoundation hiding (authenticate)
@ -36,7 +36,6 @@ import qualified Data.Text.Encoding as Text
import qualified Data.ByteString as ByteString import qualified Data.ByteString as ByteString
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.List.PointedList as PointedList
import qualified Data.UUID as UUID import qualified Data.UUID as UUID
@ -110,10 +109,8 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend
Authenticated . entityKey <$> upsertAzureUser upsertMode' azureData Authenticated . entityKey <$> upsertAzureUser upsertMode' azureData
UserSourceConfSingleSource (UserSourceLdap _) UserSourceConfSingleSource (UserSourceLdap _)
| Just upsertMode' <- upsertMode -> do | Just upsertMode' <- upsertMode -> do
-- TODO WIP
ldapPool <- fmap (fromMaybe $ error "No LDAP Pool") . getsYesod $ view _appLdapPool ldapPool <- fmap (fromMaybe $ error "No LDAP Pool") . getsYesod $ view _appLdapPool
ldapConf <- mkFailover $ PointedList.singleton ldapPool ldapData <- ldapUser ldapPool Creds{..} -- ldapUserWith withLdap ldapPool FailoverNone Creds{..}
ldapData <- ldapUser ldapConf FailoverNone Creds{..} -- ldapUserWith withLdap ldapPool FailoverNone Creds{..}
$logDebugS "AuthLDAP" $ "Successful LDAP lookup: " <> tshow ldapData $logDebugS "AuthLDAP" $ "Successful LDAP lookup: " <> tshow ldapData
Authenticated . entityKey <$> upsertLdapUser upsertMode' ldapData Authenticated . entityKey <$> upsertLdapUser upsertMode' ldapData
_other _other
@ -158,15 +155,21 @@ _upsertUserMode mMode cs@Creds{..}
defaultOther = apHash defaultOther = apHash
-- TODO: rewrite ldapLookupAndUpsert :: forall m.
-- ldapLookupAndUpsert :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadMask m, MonadUnliftIO m) => Text -> SqlPersistT m (Entity User) ( MonadHandler m
-- ldapLookupAndUpsert ident = , HandlerSite m ~ UniWorX
-- getsYesod (view _appLdapPool) >>= \case , MonadMask m
-- Nothing -> throwM $ CampusUserLdapError $ LdapHostNotResolved "No LDAP configuration in Foundation." , MonadUnliftIO m
-- Just ldapPool -> )
-- campusUser'' ldapPool campusUserFailoverMode ident >>= \case => Text
-- Nothing -> throwM CampusUserNoResult -> SqlPersistT m (Entity User)
-- Just ldapResponse -> upsertLdapUser UpsertCampusUserGuessUser ldapResponse ldapLookupAndUpsert ident =
getsYesod (view _appLdapPool) >>= \case
Nothing -> throwM $ CampusUserLdapError $ LdapHostNotResolved "No LDAP configuration in Foundation."
Just ldapPool ->
ldapUser'' ldapPool ident >>= \case
Nothing -> throwM CampusUserNoResult
Just ldapResponse -> upsertLdapUser UpsertUserGuessUser ldapResponse
-- | Upsert User DB according to given LDAP data (does not query LDAP itself) -- | Upsert User DB according to given LDAP data (does not query LDAP itself)
@ -579,7 +582,4 @@ updateUserLanguage Nothing = runMaybeT $ do
setRegisteredCookie CookieLang lang setRegisteredCookie CookieLang lang
return lang return lang
campusUserFailoverMode :: FailoverMode
campusUserFailoverMode = FailoverUnlimited
embedRenderMessage ''UniWorX ''CampusUserConversionException id embedRenderMessage ''UniWorX ''CampusUserConversionException id