feat(guess-user): add option to limit query

This commit is contained in:
Sarah Vaupel 2020-08-14 19:03:57 +02:00
parent ca96518e0e
commit 4154a395f4
4 changed files with 11 additions and 23 deletions

View File

@ -979,7 +979,7 @@ postEUsersR tid ssh csh examn = do
, GuessUserSurname <$> csvEUserSurname
, GuessUserFirstName <$> csvEUserFirstName
]
guess <- maybe (throwM ExamUserCsvExceptionNoMatchingUser) return =<< guessUser criteria
guess <- maybe (throwM ExamUserCsvExceptionNoMatchingUser) return =<< guessUser criteria (Just 2) -- we're only interested in at most one match, but want to throw an error on multiple matches
pid <- either (const $ throwM ExamUserCsvExceptionMultipleMatchingUsers) (return . entityKey) guess
(,) <$> exists [CourseParticipantCourse ==. examCourse, CourseParticipantUser ==. pid, CourseParticipantState ==. CourseParticipantActive] <*> pure pid

View File

@ -81,25 +81,7 @@ postEECorrectR tid ssh coursen examn = do
, GuessUserSurname (ident :: UserSurname)
, GuessUserFirstName (ident :: UserFirstName)
]
in lift (guessUser pdnf) >>= return . maybe [] (either NonEmpty.toList pure) -- TODO add and use option to E.limit query in guessUser (see deprecated query below)
-- TODO remove
--userMatches <- lift . E.select . E.from $ \user -> do
-- let mUserIdent = euid ^? _Left
-- E.where_ $ either (const E.false) (\uid -> user E.^. UserId E.==. E.val uid) euid
-- E.||. (case mUserIdent of
-- Just userIdent ->
-- user E.^. UserSurname E.==. E.val userIdent
-- E.||. user E.^. UserSurname `E.hasInfix` E.val userIdent
-- E.||. user E.^. UserFirstName E.==. E.val userIdent
-- E.||. user E.^. UserFirstName `E.hasInfix` E.val userIdent
-- E.||. user E.^. UserDisplayName E.==. E.val userIdent
-- E.||. user E.^. UserDisplayName `E.hasInfix` E.val userIdent
-- E.||. user E.^. UserMatrikelnummer E.==. E.val mUserIdent
-- E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
-- Nothing -> E.false)
-- E.limit $ maxCountUserMatches+1
-- return user
in lift (guessUser pdnf $ Just $ maxCountUserMatches+1) >>= return . maybe [] (either NonEmpty.toList pure)
if
| is _Nothing ciqResults, is _Nothing ciqGrade -> do

View File

@ -498,7 +498,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
, GuessUserSurname <$> csvEUserSurname
, GuessUserFirstName <$> csvEUserFirstName
]
maybe (throwM ExamUserCsvExceptionNoMatchingUser) return =<< guessUser criteria
maybe (throwM ExamUserCsvExceptionNoMatchingUser) return =<< guessUser criteria (Just 1) -- we're only interested in at most one match
externalExamUsersDBTableValidator = def
& defaultSorting (bool id (SortAscBy "is-synced" :) (mode == EEUMGrades) [SortAscBy "user-name"])
& defaultPagesize PagesizeAll

View File

@ -14,6 +14,7 @@ import Auth.LDAP (campusUserMatr')
import Crypto.Hash (hashlazy)
import Data.ByteArray (constEq)
import Data.Maybe (fromJust)
import qualified Data.List.NonEmpty as NonEmpty (fromList)
import qualified Data.Aeson as JSON
@ -69,8 +70,12 @@ matchesName (repack -> haystack) (repack -> needle)
]
guessUser :: PredDNF GuessUserInfo -> DB (Maybe (Either (NonEmpty (Entity User)) (Entity User)))
guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria) = $cachedHereBinary criteria $ go False
guessUser :: PredDNF GuessUserInfo -- ^ guessing criteria
-> Maybe Int64 -- ^ Should the query be limited to a maximum number of results?
-> DB (Maybe (Either (NonEmpty (Entity User)) (Entity User))) -- ^ Just (Left _) in case of multiple results,
-- Just (Right _) in case of single result, and
-- Nothing in case of no result
guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria) mQueryLimit = $cachedHereBinary criteria $ go False
where
asWords :: Text -> [Text]
asWords = filter (not . Text.null) . Text.words . Text.strip
@ -86,6 +91,7 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
go didLdap = do
let retrieveUsers = E.select . E.from $ \user -> do
E.where_ . E.or $ map (E.and . map (toSql user)) criteria
when (is _Just mQueryLimit) $ (E.limit . fromJust) mQueryLimit
return user
users <- retrieveUsers
let users' = sortBy (flip closeness) users