feat(guess-user): add option to limit query
This commit is contained in:
parent
ca96518e0e
commit
4154a395f4
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user