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 , GuessUserSurname <$> csvEUserSurname
, GuessUserFirstName <$> csvEUserFirstName , 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 pid <- either (const $ throwM ExamUserCsvExceptionMultipleMatchingUsers) (return . entityKey) guess
(,) <$> exists [CourseParticipantCourse ==. examCourse, CourseParticipantUser ==. pid, CourseParticipantState ==. CourseParticipantActive] <*> pure pid (,) <$> exists [CourseParticipantCourse ==. examCourse, CourseParticipantUser ==. pid, CourseParticipantState ==. CourseParticipantActive] <*> pure pid

View File

@ -81,25 +81,7 @@ postEECorrectR tid ssh coursen examn = do
, GuessUserSurname (ident :: UserSurname) , GuessUserSurname (ident :: UserSurname)
, GuessUserFirstName (ident :: UserFirstName) , 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) in lift (guessUser pdnf $ Just $ maxCountUserMatches+1) >>= return . maybe [] (either NonEmpty.toList pure)
-- 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
if if
| is _Nothing ciqResults, is _Nothing ciqGrade -> do | is _Nothing ciqResults, is _Nothing ciqGrade -> do

View File

@ -498,7 +498,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
, GuessUserSurname <$> csvEUserSurname , GuessUserSurname <$> csvEUserSurname
, GuessUserFirstName <$> csvEUserFirstName , 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 externalExamUsersDBTableValidator = def
& defaultSorting (bool id (SortAscBy "is-synced" :) (mode == EEUMGrades) [SortAscBy "user-name"]) & defaultSorting (bool id (SortAscBy "is-synced" :) (mode == EEUMGrades) [SortAscBy "user-name"])
& defaultPagesize PagesizeAll & defaultPagesize PagesizeAll

View File

@ -14,6 +14,7 @@ import Auth.LDAP (campusUserMatr')
import Crypto.Hash (hashlazy) import Crypto.Hash (hashlazy)
import Data.ByteArray (constEq) import Data.ByteArray (constEq)
import Data.Maybe (fromJust)
import qualified Data.List.NonEmpty as NonEmpty (fromList) import qualified Data.List.NonEmpty as NonEmpty (fromList)
import qualified Data.Aeson as JSON 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 :: PredDNF GuessUserInfo -- ^ guessing criteria
guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria) = $cachedHereBinary criteria $ go False -> 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 where
asWords :: Text -> [Text] asWords :: Text -> [Text]
asWords = filter (not . Text.null) . Text.words . Text.strip asWords = filter (not . Text.null) . Text.words . Text.strip
@ -86,6 +91,7 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria)
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 (E.and . map (toSql user)) criteria E.where_ . E.or $ map (E.and . map (toSql user)) criteria
when (is _Just mQueryLimit) $ (E.limit . fromJust) mQueryLimit
return user return user
users <- retrieveUsers users <- retrieveUsers
let users' = sortBy (flip closeness) users let users' = sortBy (flip closeness) users