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