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): do not authenticate against external sources on dummy login

Browse Source
This commit is contained in:
Sarah Vaupel 2024-03-01 20:42:51 +01:00
parent f88e527fe4
commit 434eed2217
1 changed files with 22 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -105,7 +105,6 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend
excRecovery . ServerError $ mr cExc excRecovery . ServerError $ mr cExc
] ]
-- | Authenticate already existing ExternalUser entries only
acceptExisting :: SqlPersistT (HandlerFor UniWorX) (AuthenticationResult UniWorX) acceptExisting :: SqlPersistT (HandlerFor UniWorX) (AuthenticationResult UniWorX)
acceptExisting = do acceptExisting = do
res <- maybe (UserError $ IdentifierNotFound credsIdent) (Authenticated . entityKey) <$> getBy uAuth res <- maybe (UserError $ IdentifierNotFound credsIdent) (Authenticated . entityKey) <$> getBy uAuth
@ -121,19 +120,21 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend
$logDebugS "Auth" $ tshow Creds{..} $logDebugS "Auth" $ tshow Creds{..}
flip catches excHandlers $ case userAuthConf of flip catches excHandlers $ if
UserAuthConfSingleSource (AuthSourceConfAzureAdV2 upsertUserAzureConf) | not isDummy, not isOther
| Just upsertMode' <- upsertMode -> do , UserAuthConfSingleSource (AuthSourceConfAzureAdV2 upsertUserAzureConf) <- userAuthConf
upsertUserAzureData <- azureUser upsertUserAzureConf Creds{..} , Just upsertMode' <- upsertMode -> do
$logDebugS "AuthAzure" $ "Successful Azure lookup: " <> tshow upsertUserAzureData upsertUserAzureData <- azureUser upsertUserAzureConf Creds{..}
Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataAzure{..} $logDebugS "AuthAzure" $ "Successful Azure lookup: " <> tshow upsertUserAzureData
UserAuthConfSingleSource (AuthSourceConfLdap upsertUserLdapConf) Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataAzure{..}
| Just upsertMode' <- upsertMode -> do | not isDummy, not isOther
ldapPool <- fmap (fromMaybe $ error "No LDAP Pool") . getsYesod $ view _appLdapPool , UserAuthConfSingleSource (AuthSourceConfLdap upsertUserLdapConf) <- userAuthConf
upsertUserLdapData <- ldapUser ldapPool Creds{..} , Just upsertMode' <- upsertMode -> do
$logDebugS "AuthLDAP" $ "Successful LDAP lookup: " <> tshow upsertUserLdapData ldapPool <- fmap (fromMaybe $ error "No LDAP Pool") . getsYesod $ view _appLdapPool
Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataLdap{..} upsertUserLdapData <- ldapUser ldapPool Creds{..}
_other $logDebugS "AuthLDAP" $ "Successful LDAP lookup: " <> tshow upsertUserLdapData
Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataLdap{..}
| otherwise
-> acceptExisting -> acceptExisting
@ -150,7 +151,6 @@ data UserConversionException
deriving anyclass (Exception) deriving anyclass (Exception)
-- TODO: this is probably not a sane traversal anymore...
_upsertUserMode :: Traversal' (Creds UniWorX) UpsertUserMode _upsertUserMode :: Traversal' (Creds UniWorX) UpsertUserMode
_upsertUserMode mMode cs@Creds{..} _upsertUserMode mMode cs@Creds{..}
| credsPlugin == apDummy = setMode <$> mMode (UpsertUserLoginDummy $ CI.mk credsIdent) | credsPlugin == apDummy = setMode <$> mMode (UpsertUserLoginDummy $ CI.mk credsIdent)
@ -159,15 +159,15 @@ _upsertUserMode mMode cs@Creds{..}
| otherwise = setMode <$> mMode (UpsertUserLoginOther $ CI.mk credsIdent) | otherwise = setMode <$> mMode (UpsertUserLoginOther $ CI.mk credsIdent)
where where
setMode UpsertUserLogin{..} | upsertUserSource `elem` loginAPs setMode UpsertUserLogin{..} | upsertUserSource `elem` loginAPs
= cs{ credsPlugin = upsertUserSource } = cs { credsPlugin = upsertUserSource }
setMode UpsertUserLoginDummy{..} setMode UpsertUserLoginDummy{..}
= cs{ credsPlugin = apDummy = cs { credsPlugin = apDummy
, credsIdent = CI.original upsertUserIdent , credsIdent = CI.original upsertUserIdent
} }
setMode UpsertUserLoginOther{..} setMode UpsertUserLoginOther{..}
= cs{ credsPlugin = bool defaultOther credsPlugin (credsPlugin `notElem` [apDummy, apLdap, apAzure]) = cs { credsPlugin = bool defaultOther credsPlugin (credsPlugin `notElem` [apDummy, apLdap, apAzure])
, credsIdent = CI.original upsertUserIdent , credsIdent = CI.original upsertUserIdent
} }
setMode _ = cs setMode _ = cs
loginAPs = [ apAzure, apLdap ] loginAPs = [ apAzure, apLdap ]