diff --git a/src/Handler/Exam/Correct.hs b/src/Handler/Exam/Correct.hs index fbd89ff81..c91c345ac 100644 --- a/src/Handler/Exam/Correct.hs +++ b/src/Handler/Exam/Correct.hs @@ -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 } diff --git a/src/Handler/ExternalExam/Correct.hs b/src/Handler/ExternalExam/Correct.hs index 18583e385..26521a266 100644 --- a/src/Handler/ExternalExam/Correct.hs +++ b/src/Handler/ExternalExam/Correct.hs @@ -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 } diff --git a/src/Utils/Exam.hs b/src/Utils/Exam.hs index c7847d6f5..a82c85ed7 100644 --- a/src/Utils/Exam.hs +++ b/src/Utils/Exam.hs @@ -42,6 +42,7 @@ data CorrectInterfaceResponse } | CorrectInterfaceResponseAmbiguous { ciraUsers :: Set CorrectInterfaceUser + , ciraHasMore :: Bool , ciraMessage :: Text } | CorrectInterfaceResponseFailure