feat(exam-correct): limit number of matching users (BE)
This commit is contained in:
parent
62fef35475
commit
d4d27f8ef6
@ -21,6 +21,13 @@ import Utils.Exam
|
||||
minNeedleLength :: Int
|
||||
minNeedleLength = 3
|
||||
|
||||
-- TODO use according to description
|
||||
-- TODO maybe renders minNeedleLength unnecessary?
|
||||
-- TODO maybe also perform user and ldap lookups if there are fewer results than this number? (TODO add user as exam participant if not already participant)
|
||||
-- | Maximum number of participant matches to show. Also serves as an upper limit to the number of query results from participant lookups.
|
||||
maxCountUserMatches :: Integral a => a
|
||||
maxCountUserMatches = 10
|
||||
|
||||
|
||||
getECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
|
||||
getECorrectR tid ssh csh examn = do
|
||||
@ -67,7 +74,6 @@ postECorrectR tid ssh csh examn = do
|
||||
guardMExceptT (maybe True ((>= minNeedleLength) . length) $ euid ^? _Left) $
|
||||
CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
|
||||
|
||||
|
||||
participantMatches <- lift . E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
|
||||
E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
|
||||
@ -86,6 +92,7 @@ postECorrectR tid ssh csh examn = do
|
||||
E.||. user E.^. UserMatrikelnummer E.==. E.val mUserIdent
|
||||
E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
|
||||
Nothing -> E.val False)
|
||||
E.limit $ maxCountUserMatches+1
|
||||
return user
|
||||
|
||||
if
|
||||
@ -185,9 +192,10 @@ postECorrectR tid ssh csh examn = do
|
||||
|
||||
-- on match with multiple exam participants, answer with 400 and a set of all matches
|
||||
| otherwise -> do
|
||||
users <- traverse userToResponse participantMatches
|
||||
users <- traverse userToResponse $ take maxCountUserMatches participantMatches
|
||||
return CorrectInterfaceResponseAmbiguous
|
||||
{ ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants
|
||||
, ciraHasMore = length participantMatches > maxCountUserMatches
|
||||
, ciraUsers = Set.fromList users
|
||||
}
|
||||
|
||||
|
||||
@ -15,10 +15,17 @@ import Handler.Utils.ExternalExam
|
||||
|
||||
import Utils.Exam
|
||||
|
||||
|
||||
-- | Minimum length of a participant identifier. Identifiers that are shorter would result in too many query results and are therefor rejected.
|
||||
minNeedleLength :: Int
|
||||
minNeedleLength = 3 -- TODO rethink
|
||||
|
||||
-- TODO use according to description
|
||||
-- TODO maybe renders minNeedleLength unnecessary?
|
||||
-- | Maximum number of user matches to show. Also serves as an upper limit to the number of query results from user and/or ldap lookups.
|
||||
maxCountUserMatches :: Integral a => a
|
||||
maxCountUserMatches = 10
|
||||
|
||||
|
||||
getEECorrectR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
|
||||
getEECorrectR tid ssh coursen examn = do
|
||||
@ -66,6 +73,7 @@ postEECorrectR tid ssh coursen examn = do
|
||||
guardMExceptT (maybe True ((>= minNeedleLength) . length) $ euid ^? _Left) $
|
||||
CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
|
||||
|
||||
-- TODO additionally call guessUser if this query produces too few results
|
||||
matches <- 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
|
||||
@ -80,6 +88,7 @@ postEECorrectR tid ssh coursen examn = do
|
||||
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
|
||||
@ -134,9 +143,10 @@ postEECorrectR tid ssh coursen examn = do
|
||||
}
|
||||
|
||||
| otherwise -> do
|
||||
users <- traverse userToResponse matches
|
||||
users <- traverse userToResponse $ take maxCountUserMatches matches
|
||||
return CorrectInterfaceResponseAmbiguous
|
||||
{ ciraUsers = Set.fromList users
|
||||
, ciraHasMore = length matches > maxCountUserMatches
|
||||
, ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants -- TODO use new msg
|
||||
}
|
||||
|
||||
|
||||
@ -42,6 +42,7 @@ data CorrectInterfaceResponse
|
||||
}
|
||||
| CorrectInterfaceResponseAmbiguous
|
||||
{ ciraUsers :: Set CorrectInterfaceUser
|
||||
, ciraHasMore :: Bool
|
||||
, ciraMessage :: Text
|
||||
}
|
||||
| CorrectInterfaceResponseFailure
|
||||
|
||||
Loading…
Reference in New Issue
Block a user