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

fix: restrict guessUser to consistent queries

Browse Source
This commit is contained in:
Gregor Kleen 2020-01-14 17:05:59 +01:00
parent 3b739f751d
commit bcd5326129
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Handler/Utils/Users.hs
View File

@ -40,14 +40,14 @@ guessUser :: Set GuessUserInfo -> DB (Maybe UserId)
guessUser (Set.toList -> criteria) = $cachedHereBinary criteria $ go False guessUser (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
where where
toSql user = \case toSql user = \case
GuessUserMatrikelnummer userMatriculation' -> user E.^. UserMatrikelnummer E.==. E.val (Just userMatriculation') GuessUserMatrikelnummer userMatriculation' -> user E.^. UserMatrikelnummer E.==. E.val (Just userMatriculation')
GuessUserDisplayName userDisplayName' -> user E.^. UserDisplayName `E.hasInfix` E.val userDisplayName' GuessUserDisplayName userDisplayName' -> user E.^. UserDisplayName `E.hasInfix` E.val userDisplayName'
GuessUserSurname userSurname' -> user E.^. UserSurname `E.hasInfix` E.val userSurname' GuessUserSurname userSurname' -> user E.^. UserSurname `E.hasInfix` E.val userSurname'
GuessUserFirstName userFirstName' -> user E.^. UserFirstName `E.hasInfix` E.val userFirstName' GuessUserFirstName userFirstName' -> user E.^. UserFirstName `E.hasInfix` E.val userFirstName'
go didLdap = do go didLdap = do
let retrieveUsers = E.select . E.from $ \user -> do let retrieveUsers = E.select . E.from $ \user -> do
E.where_ . E.or $ map (toSql user) criteria E.where_ . E.and $ map (toSql user) criteria
return user return user
users <- retrieveUsers users <- retrieveUsers
let users' = reverse $ sortBy closeness users let users' = reverse $ sortBy closeness users