fix: restrict guessUser to consistent queries

This commit is contained in:
Gregor Kleen 2020-01-14 17:05:59 +01:00
parent 3b739f751d
commit bcd5326129

View File

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