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 :: Int
|
||||||
minNeedleLength = 3
|
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 :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
|
||||||
getECorrectR tid ssh csh examn = do
|
getECorrectR tid ssh csh examn = do
|
||||||
@ -67,7 +74,6 @@ postECorrectR tid ssh csh examn = do
|
|||||||
guardMExceptT (maybe True ((>= minNeedleLength) . length) $ euid ^? _Left) $
|
guardMExceptT (maybe True ((>= minNeedleLength) . length) $ euid ^? _Left) $
|
||||||
CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
|
CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
|
||||||
|
|
||||||
|
|
||||||
participantMatches <- lift . E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
|
participantMatches <- lift . E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
|
||||||
E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
||||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
|
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.==. E.val mUserIdent
|
||||||
E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
|
E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
|
||||||
Nothing -> E.val False)
|
Nothing -> E.val False)
|
||||||
|
E.limit $ maxCountUserMatches+1
|
||||||
return user
|
return user
|
||||||
|
|
||||||
if
|
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
|
-- on match with multiple exam participants, answer with 400 and a set of all matches
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
users <- traverse userToResponse participantMatches
|
users <- traverse userToResponse $ take maxCountUserMatches participantMatches
|
||||||
return CorrectInterfaceResponseAmbiguous
|
return CorrectInterfaceResponseAmbiguous
|
||||||
{ ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants
|
{ ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants
|
||||||
|
, ciraHasMore = length participantMatches > maxCountUserMatches
|
||||||
, ciraUsers = Set.fromList users
|
, ciraUsers = Set.fromList users
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@ -15,10 +15,17 @@ import Handler.Utils.ExternalExam
|
|||||||
|
|
||||||
import Utils.Exam
|
import Utils.Exam
|
||||||
|
|
||||||
|
|
||||||
-- | Minimum length of a participant identifier. Identifiers that are shorter would result in too many query results and are therefor rejected.
|
-- | Minimum length of a participant identifier. Identifiers that are shorter would result in too many query results and are therefor rejected.
|
||||||
minNeedleLength :: Int
|
minNeedleLength :: Int
|
||||||
minNeedleLength = 3 -- TODO rethink
|
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 :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
|
||||||
getEECorrectR tid ssh coursen examn = do
|
getEECorrectR tid ssh coursen examn = do
|
||||||
@ -66,6 +73,7 @@ postEECorrectR tid ssh coursen examn = do
|
|||||||
guardMExceptT (maybe True ((>= minNeedleLength) . length) $ euid ^? _Left) $
|
guardMExceptT (maybe True ((>= minNeedleLength) . length) $ euid ^? _Left) $
|
||||||
CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
|
CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
|
||||||
|
|
||||||
|
-- TODO additionally call guessUser if this query produces too few results
|
||||||
matches <- lift . E.select . E.from $ \user -> do
|
matches <- lift . E.select . E.from $ \user -> do
|
||||||
let mUserIdent = euid ^? _Left
|
let mUserIdent = euid ^? _Left
|
||||||
E.where_ $ either (const E.false) (\uid -> user E.^. UserId E.==. E.val uid) euid
|
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.==. E.val mUserIdent
|
||||||
E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
|
E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
|
||||||
Nothing -> E.false)
|
Nothing -> E.false)
|
||||||
|
E.limit $ maxCountUserMatches+1
|
||||||
return user
|
return user
|
||||||
|
|
||||||
if
|
if
|
||||||
@ -134,9 +143,10 @@ postEECorrectR tid ssh coursen examn = do
|
|||||||
}
|
}
|
||||||
|
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
users <- traverse userToResponse matches
|
users <- traverse userToResponse $ take maxCountUserMatches matches
|
||||||
return CorrectInterfaceResponseAmbiguous
|
return CorrectInterfaceResponseAmbiguous
|
||||||
{ ciraUsers = Set.fromList users
|
{ ciraUsers = Set.fromList users
|
||||||
|
, ciraHasMore = length matches > maxCountUserMatches
|
||||||
, ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants -- TODO use new msg
|
, ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants -- TODO use new msg
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@ -42,6 +42,7 @@ data CorrectInterfaceResponse
|
|||||||
}
|
}
|
||||||
| CorrectInterfaceResponseAmbiguous
|
| CorrectInterfaceResponseAmbiguous
|
||||||
{ ciraUsers :: Set CorrectInterfaceUser
|
{ ciraUsers :: Set CorrectInterfaceUser
|
||||||
|
, ciraHasMore :: Bool
|
||||||
, ciraMessage :: Text
|
, ciraMessage :: Text
|
||||||
}
|
}
|
||||||
| CorrectInterfaceResponseFailure
|
| CorrectInterfaceResponseFailure
|
||||||
|
|||||||
Reference in New Issue
Block a user