diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index b64f9bc32..dc0d891f1 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -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 diff --git a/src/Handler/ExternalExam/Correct.hs b/src/Handler/ExternalExam/Correct.hs index 05eba38b4..be769d3ab 100644 --- a/src/Handler/ExternalExam/Correct.hs +++ b/src/Handler/ExternalExam/Correct.hs @@ -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 diff --git a/src/Handler/Utils/ExternalExam/Users.hs b/src/Handler/Utils/ExternalExam/Users.hs index 7b0bdac49..6df611fe7 100644 --- a/src/Handler/Utils/ExternalExam/Users.hs +++ b/src/Handler/Utils/ExternalExam/Users.hs @@ -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 diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 527535189..b17fc5f36 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -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