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

chore(login): non-ldap logins should work again if laziness permits

Browse Source
This commit is contained in:
Steffen Jost 2022-09-21 13:19:44 +02:00
parent a92c8f3d08
commit 02c117b579
1 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -157,14 +157,18 @@ upsertCampusUser upsertMode ldapData = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
userDefaultConf <- getsYesod $ view _appUserDefaults userDefaultConf <- getsYesod $ view _appUserDefaults
(newUser@User{..},userUpdate) <- decodeUser now userDefaultConf upsertMode ldapData (newUser,userUpdate) <- decodeUser now userDefaultConf upsertMode ldapData
oldUsers <- for userLdapPrimaryKey $ \pKey -> selectKeysList [ UserLdapPrimaryKey ==. Just pKey ] []
oldUsers <- for (userLdapPrimaryKey newUser) $ \pKey -> selectKeysList [ UserLdapPrimaryKey ==. Just pKey ] []
user@(Entity userId userRec) <- case oldUsers of user@(Entity userId userRec) <- case oldUsers of
Just [oldUserId] -> updateGetEntity oldUserId userUpdate Just [oldUserId] -> updateGetEntity oldUserId userUpdate
_other -> upsertBy (UniqueAuthentication userIdent) newUser userUpdate _other -> upsertBy (UniqueAuthentication (newUser ^. _userIdent)) newUser userUpdate
unless (validDisplayName userTitle userFirstName userSurname $ userRec ^. _userDisplayName) $ unless (validDisplayName (newUser ^. _userTitle)
update userId [ UserDisplayName =. userDisplayName ] (newUser ^. _userFirstName)
(newUser ^. _userSurname)
(userRec ^. _userDisplayName)) $
update userId [ UserDisplayName =. (newUser ^. _userDisplayName) ]
let let
userSystemFunctions = determineSystemFunctions . Set.fromList $ map CI.mk userSystemFunctions' userSystemFunctions = determineSystemFunctions . Set.fromList $ map CI.mk userSystemFunctions'
@ -201,7 +205,7 @@ decodeUser now UserDefaultConf{..} upsertMode ldapData = do
userAuthentication userAuthentication
| is _UpsertCampusUserLoginOther upsertMode | is _UpsertCampusUserLoginOther upsertMode
= error "Non-LDAP logins should only work for users that are already known" = AuthPWHash (error "Non-LDAP logins should only work for users that are already known")
| otherwise = AuthLDAP | otherwise = AuthLDAP
userLastAuthentication = guardOn isLogin now userLastAuthentication = guardOn isLogin now
isLogin = has (_UpsertCampusUserLoginLdap <> _UpsertCampusUserLoginOther . united) upsertMode isLogin = has (_UpsertCampusUserLoginLdap <> _UpsertCampusUserLoginOther . united) upsertMode