Merge branch 'eecorrectr' into 'master'

EECorrectR

See merge request uni2work/uni2work!22

frontend/src/utils/exam-correct/exam-correct.js

@@ -19,6 +19,7 @@ const EXAM_CORRECT_SEND_BTN_ID = 'exam-correct__send-btn';
 const EXAM_CORRECT_USER_INPUT_ID = 'exam-correct__user';
 const EXAM_CORRECT_USER_INPUT_STATUS_ID = 'exam-correct__user-status';
 const EXAM_CORRECT_USER_INPUT_CANDIDATES_ID = 'exam-correct__user-candidates';
+const EXAM_CORRECT_USER_INPUT_CANDIDATES_MORE_ID = 'exam-correct__user-candidates-more';
 const EXAM_CORRECT_INPUT_BODY_ID = 'exam-correct__new';
 const EXAM_CORRECT_USER_ATTR = 'exam-correct--user-id';
 const EXAM_CORRECT_USER_DNAME_ATTR = 'exam-correct--user-dname';
@@ -45,6 +46,7 @@ export class ExamCorrect {
   _userInput;
   _userInputStatus;
   _userInputCandidates;
+  _userInputCandidatesMore;
   _partInputs;
   _resultSelect;
   _resultGradeSelect;
@@ -77,6 +79,7 @@ export class ExamCorrect {
     this._userInput = document.getElementById(EXAM_CORRECT_USER_INPUT_ID);
     this._userInputStatus = document.getElementById(EXAM_CORRECT_USER_INPUT_STATUS_ID);
     this._userInputCandidates = document.getElementById(EXAM_CORRECT_USER_INPUT_CANDIDATES_ID);
+    this._userInputCandidatesMore = document.getElementById(EXAM_CORRECT_USER_INPUT_CANDIDATES_MORE_ID);
     this._partInputs = [...this._element.querySelectorAll(`input[${EXAM_CORRECT_PART_INPUT_ATTR}]`)];
     const resultCell = document.getElementById('uw-exam-correct__result');
     this._resultSelect = resultCell && resultCell.querySelector('select');
@@ -109,6 +112,10 @@ export class ExamCorrect {
       throw new Error('ExamCorrect utility could not detect user input candidate list!');
     }
 
+    if (!this._userInputCandidatesMore) {
+      throw new Error('ExamCorrect utility could not detect user input candidate more element');
+    }
+
     // TODO get date format by post request
     this._dateFormat = 'DD.MM.YYYY HH:mm:ss';
 
@@ -178,6 +185,7 @@ export class ExamCorrect {
     // do nothing in case of empty or invalid input
     if (!this._userInput.value || this._userInput.reportValidity && !this._userInput.reportValidity()) {
       removeAllChildren(this._userInputCandidates);
+      this._userInputCandidatesMore.hidden = true;
       setStatus(this._userInputStatus, STATUS.NONE);
       return;
     }
@@ -212,6 +220,7 @@ export class ExamCorrect {
     // TODO avoid code duplication
     if (this._userInput.reportValidity && !this._userInput.reportValidity()) {
       removeAllChildren(this._userInputCandidates);
+      this._userInputCandidatesMore.hidden = true;
       setStatus(this._userInput, STATUS.NONE);
       return;
     }
@@ -305,6 +314,7 @@ export class ExamCorrect {
         if (response.users) {
           // delete candidate list entries from previous requests
           removeAllChildren(this._userInputCandidates);
+          this._userInputCandidatesMore.hidden = true;
 
           // show error if there are no matches for this input
           if (response.users.length === 0) {
@@ -335,6 +345,7 @@ export class ExamCorrect {
               
               // remove all candidates on accept
               removeAllChildren(this._userInputCandidates);
+              this._userInputCandidatesMore.hidden = true;
 
               setStatus(this._userInputStatus, STATUS.SUCCESS);
 
@@ -344,6 +355,7 @@ export class ExamCorrect {
 
             this._userInputCandidates.appendChild(candidateItem);
           });
+          this._userInputCandidatesMore.hidden = response['has-more'] !== true;
         } else {
           // TODO what to do in this case?
           setStatus(this._userInputStatus, STATUS.FAILURE);
@@ -388,6 +400,7 @@ export class ExamCorrect {
               // TODO set edit button visibility
               status = STATUS.AMBIGUOUS;
               newEntry.users = response.users;
+              newEntry.hasMore = response['has-more'] === true;
               newEntry.message = response.message || null;
               break;
             case 'failure':
@@ -426,7 +439,7 @@ export class ExamCorrect {
             userElem.innerHTML = userToHTML(user);
             userElem.setAttribute(EXAM_CORRECT_USER_ATTR, user.id || user);
           } else if (userElem && newEntry.users) {
-            row.replaceChild(userElem, this._showUserList(row, newEntry.users, { partResults: request.results, result: request.grade } ));
+            row.replaceChild(userElem, this._showUserList(row, newEntry.users, { partResults: request.results, result: request.grade }, newEntry.hasMore === true));
           }
 
           for (let [k, v] of Object.entries(newEntry.results)) {
@@ -477,7 +490,7 @@ export class ExamCorrect {
   }
 
   // TODO better name
-  _showUserList(row, users, results) {
+  _showUserList(row, users, results, hasMore) {
     let userElem = row.cells.item(this._cIndices.get('user'));
     if (!userElem) {
       userElem = document.createElement('TD');
@@ -499,6 +512,12 @@ export class ExamCorrect {
         list.appendChild(listItem);
       }
       userElem.appendChild(list);
+      if (hasMore === true) {
+        const moreElem = this._userInputCandidatesMore.cloneNode(true);
+        moreElem.removeAttribute('id');
+        moreElem.hidden = false;
+        userElem.appendChild(moreElem);
+      }
     } else {
       console.error('Unable to show users from invalid response');
     }
@@ -598,6 +617,7 @@ export class ExamCorrect {
 
   _clearUserInput() {
     removeAllChildren(this._userInputCandidates);
+    this._userInputCandidatesMore.hidden = true;
     clearInput(this._userInput);
     this._userInput.removeAttribute(EXAM_CORRECT_USER_ATTR);
     this._userInput.removeAttribute(EXAM_CORRECT_USER_DNAME_ATTR);

frontend/src/utils/hide-columns/hide-columns.js

@@ -376,7 +376,9 @@ function isEmptyElement(element) {
 }
 
 function isTableHider(element) {
-  return element.classList.contains(TABLE_HIDER_CLASS)
+  return element && element.classList && (
+       element.classList.contains(TABLE_HIDER_CLASS)
     || element.classList.contains(TABLE_HIDER_VISIBLE_CLASS)
-    || element.classList.contains(TABLE_PILL_CLASS);
+    || element.classList.contains(TABLE_PILL_CLASS)
+  );
 }

messages/uniworx/de-de-formal.msg

@@ -1346,6 +1346,7 @@ MenuExternalExamUsers: Teilnehmer
 MenuExternalExamEdit: Bearbeiten
 MenuExternalExamNew: Neue externe Prüfung
 MenuExternalExamList: Externe Prüfungen
+MenuExternalExamCorrect: Prüfungsleistungen eintragen
 MenuParticipantsList: Kursteilnehmerlisten
 MenuParticipantsIntersect: Überschneidung von Kursteilnehmern
 MenuAllocationUsers: Bewerber
@@ -1417,6 +1418,7 @@ BreadcrumbExternalExamEdit: Editieren
 BreadcrumbExternalExamUsers: Teilnehmer
 BreadcrumbExternalExamGrades: Prüfungsleistungen
 BreadcrumbExternalExamStaffInvite: Einladung zum Prüfer
+BreadcrumbExternalExamCorrect: Prüfungsleistungen eintragen
 BreadcrumbParticipantsList: Kursteilnehmerlisten
 BreadcrumbParticipants: Kursteilnehmerliste
 BreadcrumbExamAutoOccurrence: Automatische Termin-/Raumverteilung
@@ -1433,6 +1435,7 @@ BreadcrumbAdminCrontab: Crontab
 
 ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn}
 ExternalExamGrades coursen@CourseName examn@ExamName: Prüfungsleistungen: #{coursen}, #{examn}
+ExternalExamCorrectHeading coursen@CourseName examn@ExamName: Prüfungsleistungen für #{coursen}, #{examn} eintragen
 ExternalExamUsers coursen@CourseName examn@ExamName: Teilnehmer: #{coursen}, #{examn}
 
 TitleMetrics: Metriken
@@ -1574,6 +1577,7 @@ ExamRegistrationInviteExplanation: Sie wurden eingeladen, Prüfungsteilnehmer zu
 ExamCorrectHeading examname@Text: Prüfungsergebnisse für #{examname} eintragen
 ExamCorrectExamResultDelete: Prüfungsergebnis löschen
 ExamCorrectExamResultNone: Keine Änderung
+ExamCorrectUserCandidatesMore: und weitere
 
 ExamCorrectHeadDate: Zeit
 ExamCorrectHeadParticipant: Teilnehmer
@@ -1589,6 +1593,9 @@ ExamCorrectErrorNoMatchingParticipants: Dem Identifikator konnte kein Prüfungst
 ExamCorrectErrorPartResultOutOfBounds examPartNumber@ExamPartNumber: Prüfungsergebnis für Teil #{examPartNumber} ist nicht größer Null.
 ExamCorrectErrorPartResultOutOfBoundsMax examPartNumber@ExamPartNumber maxPoints@Points: Prüfungsergebnis für Teil #{examPartNumber} liegt nicht zwischen 0 und #{maxPoints}.
 
+ExternalExamCorrectErrorMultipleMatchingUsers: Dem Identifikator konnten mehrere Studierende zugeordnet werden.
+ExternalExamCorrectErrorNoMatchingUsers: Dem Identifikator konnte kein Studierender zugeordnet werden.
+
 SubmissionUserInvitationAccepted shn@SheetName: Sie wurden als Mitabgebende(r) für eine Abgabe zu #{shn} eingetragen
 SubmissionUserInvitationDeclined shn@SheetName: Sie haben die Einladung, Mitabgebende(r) für #{shn} zu werden, abgelehnt
 SubmissionUserInviteHeading shn@SheetName: Einladung zu einer Abgabe für #{shn}
@@ -2042,6 +2049,7 @@ ExamBonusNone: Keine Bonuspunkte
 ExamUserCsvCourseNoteDeleted: Notiz wird gelöscht
 
 ExamUserCsvExceptionNoMatchingUser: Benutzer konnte nicht eindeutig identifiziert werden. Alle Identifikatoren des Benutzers (Vorname(n), Nachname, Voller Name, Matrikelnummer, ...) müssen exakt übereinstimmen. Sie können versuchen für diese Zeile manche der Identifikatoren zu entfernen (also z.B. nur eine Matrikelnummer angeben) um dem System zu erlauben nur Anhand der verbleibenden Identifikatoren zu suchen. Sie sollten dann natürlich besonders kontrollieren, dass das System den fraglichen Benutzer korrekt identifiziert hat.
+ExamUserCsvExceptionMultipleMatchingUsers: Benutzer konnte nicht eindeutig identifiziert werden. Es wurden mehrere Benutzer gefunden, welche mit den gegebenen Identifikatoren übereinstimmen. Sie können versuchen, für diese Zeile weitere Identifikatoren anzugeben damit nur noch der gewünschte Benutzer mit diesen identifiziert werden kann.
 ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Benutzers zugeordnet werden. Sie können versuchen für diese Zeile die Studiengangsdaten zu entfernen um das System automatisch ein Studienfach wählen zu lassen.
 ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden. Überprüfen Sie, dass diese Zeile nur interne Raumbezeichnungen enthält, wie sie auch für die Prüfung konfiguriert wurden.
 ExamUserCsvExceptionMismatchedGradingMode expectedGradingMode@ExamGradingMode actualGradingMode@ExamGradingMode: Es wurde versucht eine Prüfungsleistung einzutragen, die zwar vom System interpretiert werden konnte, aber nicht dem für diese Prüfung erwarteten Modus entspricht. Der erwartete Bewertungsmodus kann unter "Prüfung bearbeiten" angepasst werden ("Bestanden/Nicht Bestanden", "Numerische Noten" oder "Gemischt").

messages/uniworx/en-eu.msg

@@ -1346,6 +1346,7 @@ MenuExternalExamUsers: Participants
 MenuExternalExamEdit: Edit
 MenuExternalExamNew: New external exam
 MenuExternalExamList: External exams
+MenuExternalExamCorrect: Enter exam results
 MenuParticipantsList: Lists of course participants
 MenuParticipantsIntersect: Common course participants
 MenuAllocationUsers: Applicants
@@ -1417,6 +1418,7 @@ BreadcrumbExternalExamEdit: Edit
 BreadcrumbExternalExamUsers: Participants
 BreadcrumbExternalExamGrades: Exam results
 BreadcrumbExternalExamStaffInvite: Invitation
+BreadcrumbExternalExamCorrect: Enter exam results
 BreadcrumbParticipantsList: Lists of course participants
 BreadcrumbParticipants: Course participants
 BreadcrumbExamAutoOccurrence: Automatic occurrence/room distribution
@@ -1433,6 +1435,7 @@ BreadcrumbAdminCrontab: Crontab
 
 ExternalExamEdit coursen examn: Edit: #{coursen}, #{examn}
 ExternalExamGrades coursen examn: Exam achievements: #{coursen}, #{examn}
+ExternalExamCorrectHeading coursen examn: Enter exam results for #{coursen}, #{examn}
 ExternalExamUsers coursen examn: Exam participants: #{coursen}, #{examn}
 
 TitleMetrics: Metrics
@@ -1585,8 +1588,12 @@ ExamCorrectErrorNoMatchingParticipants: This identifier does not match on any ex
 ExamCorrectErrorPartResultOutOfBounds examPartNumber: Exam part result for #{examPartNumber} ist not greater zero.
 ExamCorrectErrorPartResultOutOfBoundsMax examPartNumber maxPoints: Exam part result for #{examPartNumber} is not between 0 and #{maxPoints}.
 
+ExternalExamCorrectErrorMultipleMatchingUsers: This identifier matches on multiple students.
+ExternalExamCorrectErrorNoMatchingUsers: This identifier does not match any student.
+
 ExamCorrectExamResultDelete: Delete exam result
 ExamCorrectExamResultNone: No change
+ExamCorrectUserCandidatesMore: and more
 
 SubmissionUserInvitationAccepted shn: You now participate in a submission for #{shn}
 SubmissionUserInvitationDeclined shn: You have declined the invitation to participate in a submission for #{shn}
@@ -2041,6 +2048,7 @@ ExamBonusNone: No bonus points
 ExamUserCsvCourseNoteDeleted: Course note will be deleted
 
 ExamUserCsvExceptionNoMatchingUser: Course participant could not be identified uniquely. All identifiers (given name(s), surname, display name, matriculation, ..) must match exactly. You can try to remove some of the identifiers for the given line (i.e. all but matriculation). Uni2work will then search for users using only the remaining identifiers. In this case special care should be taken that Uni2work correctly identifies the intended user.
+ExamUserCsvExceptionMultipleMatchingUsers: Course participant could not be identified uniquely. There are multiple users that match the given identifiers. You can try to add more identifiers for the given line to ensure that only the intended user can be identified with them.
 ExamUserCsvExceptionNoMatchingStudyFeatures: The specified field did not match with any of the participant's fields of study. You can try to remove the field of study for the given line. Uni2work will then automatically choose a field of study.
 ExamUserCsvExceptionNoMatchingOccurrence: Occurrence/room could not be identified uniquely. Please ensure that the given line only contains internal room identifiers exactly as they have been configured for this exam.
 ExamUserCsvExceptionMismatchedGradingMode expectedGradingMode actualGradingMode: The imported data contained an exam achievement which does not match the grading mode for this exam. The expected grading mode can be changed at "Edit exam" ("Passed/Failed", "Numeric grades", or "Mixed").

routes

@@ -92,6 +92,7 @@
   /users                   EEUsersR            GET POST
   /grades                  EEGradesR           GET POST        !exam-office
   /staff-invite            EEStaffInviteR      GET POST
+  /correct                 EECorrectR          GET POST
   
 
 /term                      TermShowR           GET             !free

src/CryptoID.hs

@@ -72,6 +72,7 @@ decCryptoIDs [ ''SubmissionId
              , ''CourseNewsId
              , ''CourseEventId
              , ''TutorialId
+             , ''ExternalExamId
              ]
 
 decCryptoIDKeySize

src/Foundation/Navigation.hs

@@ -329,6 +329,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
     EEUsersR -> i18nCrumb MsgBreadcrumbExternalExamUsers . Just $ EExamR tid ssh coursen examn EEShowR
     EEGradesR -> i18nCrumb MsgBreadcrumbExternalExamGrades . Just $ EExamR tid ssh coursen examn EEShowR
     EEStaffInviteR -> i18nCrumb MsgBreadcrumbExternalExamStaffInvite . Just $ EExamR tid ssh coursen examn EEShowR
+    EECorrectR -> i18nCrumb MsgBreadcrumbExternalExamCorrect . Just $ EExamR tid ssh coursen examn EEShowR
 
 
 data NavQuickView
@@ -2128,9 +2129,66 @@ pageActions (EExamR tid ssh coursen examn EEShowR) = return
         }
       , navChildren = []
       }
+  , NavPageActionPrimary
+      { navLink = NavLink
+        { navLabel       = MsgMenuExternalExamCorrect
+        , navRoute       = EExamR tid ssh coursen examn EECorrectR
+        , navAccess'     = return True
+        , navType        = NavTypeLink { navModal = False }
+        , navQuick'      = mempty
+        , navForceActive = False
+        }
+      , navChildren = []
+      }
   ]
 pageActions (EExamR tid ssh coursen examn EEGradesR) = return
   [ NavPageActionPrimary
+      { navLink = NavLink
+        { navLabel       = MsgMenuExternalExamCorrect
+        , navRoute       = EExamR tid ssh coursen examn EECorrectR
+        , navAccess'     = return True
+        , navType        = NavTypeLink { navModal = False }
+        , navQuick'      = mempty
+        , navForceActive = False
+        }
+      , navChildren = []
+      }
+  , NavPageActionPrimary
+      { navLink = NavLink
+        { navLabel       = MsgMenuExternalExamUsers
+        , navRoute       = EExamR tid ssh coursen examn EEUsersR
+        , navAccess'     = return True
+        , navType        = NavTypeLink { navModal = False }
+        , navQuick'      = mempty
+        , navForceActive = False
+        }
+      , navChildren = []
+      }
+  , NavPageActionPrimary
+      { navLink = NavLink
+        { navLabel       = MsgMenuExternalExamEdit
+        , navRoute       = EExamR tid ssh coursen examn EEEditR
+        , navAccess'     = return True
+        , navType        = NavTypeLink { navModal = False }
+        , navQuick'      = mempty
+        , navForceActive = False
+        }
+      , navChildren = []
+      }
+  ]
+pageActions (EExamR tid ssh coursen examn EECorrectR) = return
+  [ NavPageActionPrimary
+      { navLink = NavLink
+        { navLabel       = MsgMenuExternalExamGrades
+        , navRoute       = EExamR tid ssh coursen examn EEGradesR
+        , navAccess'     = return True
+        , navType        = NavTypeLink { navModal = False }
+        , navQuick'      = mempty
+        , navForceActive = False
+        }
+      , navChildren = []
+      }
+  , NavPageActionPrimary
       { navLink = NavLink
         { navLabel       = MsgMenuExternalExamUsers
         , navRoute       = EExamR tid ssh coursen examn EEUsersR
@@ -2165,6 +2223,17 @@ pageActions (EExamR tid ssh coursen examn EEUsersR) = return
         }
       , navChildren = []
       }
+  , NavPageActionPrimary
+      { navLink = NavLink
+        { navLabel       = MsgMenuExternalExamCorrect
+        , navRoute       = EExamR tid ssh coursen examn EECorrectR
+        , navAccess'     = return True
+        , navType        = NavTypeLink { navModal = False }
+        , navQuick'      = mempty
+        , navForceActive = False
+        }
+      , navChildren = []
+      }
   , NavPageActionPrimary
       { navLink = NavLink
         { navLabel       = MsgMenuExternalExamEdit

src/Handler/Exam/Correct.hs

@@ -6,7 +6,6 @@ import Import
 
 import qualified Data.Set as Set
 import qualified Data.CaseInsensitive as CI
-import qualified Data.Aeson as JSON
 
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
@@ -15,63 +14,16 @@ import Database.Persist.Sql (transactionUndo)
 import Handler.Utils
 import Handler.Utils.Exam (fetchExam)
 
-import qualified Data.HashMap.Strict as HashMap
+import Utils.Exam.Correct
 
 
-data CorrectInterfaceUser
+-- | Minimum length of a participant identifier. Identifiers that are shorter would result in too many query results and are therefor rejected.
-  = CorrectInterfaceUser
+minNeedleLength :: Int
-    { ciuSurname     :: Text
+minNeedleLength = 3
-    , ciuDisplayName :: Text
-    , ciuMatNr       :: Maybe UserMatriculation
-    , ciuId          :: CryptoUUIDUser
-    } deriving (Eq,Ord)
-deriveJSON defaultOptions
-  { fieldLabelModifier = camelToPathPiece' 1
-  } ''CorrectInterfaceUser
 
-data CorrectInterfaceResponse
+-- | Maximum number of participant matches to show. Also serves as an upper limit to the number of query results from participant lookups.
-  = CorrectInterfaceResponseSuccess
+maxCountUserMatches :: Integral a => a
-    { cirsUser       :: CorrectInterfaceUser
+maxCountUserMatches = 10
-    , cirsResults    :: Map ExamPartNumber (Maybe ExamResultPoints)
-    , cirsGrade      :: Maybe (Maybe ExamResultPassedGrade)
-    , cirsTime       :: UTCTime
-    }
-  | CorrectInterfaceResponseAmbiguous
-    { ciraUsers      :: Set CorrectInterfaceUser
-    , ciraMessage    :: Text
-    }
-  | CorrectInterfaceResponseFailure
-    { cirfUser       :: Maybe CorrectInterfaceUser
-    , cirfMessage    :: Text
-    }
-  | CorrectInterfaceResponseNoOp
-    { cirnUsers      :: Set CorrectInterfaceUser
-    }
-deriveToJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 3
-  , fieldLabelModifier     = camelToPathPiece' 1
-  , sumEncoding            = TaggedObject "status" "results"
-  , omitNothingFields      = True
-  } ''CorrectInterfaceResponse
-
-data CorrectInterfaceRequest
-  = CorrectInterfaceRequest
-    { ciqUser        :: Either Text (CryptoID UUID (Key User))
-    , ciqResults     :: Maybe (NonNull (Map ExamPartNumber (Maybe Points)))
-    , ciqGrade       :: Maybe (Maybe ExamResultPassedGrade)
-    }
-
-instance FromJSON CorrectInterfaceRequest where
-  parseJSON = JSON.withObject "CorrectInterfaceRequest" $ \o -> do
-    ciqUser <- Right <$> o JSON..: "user" <|> Left <$> o JSON..: "user"
-    results <- o JSON..:? "results"
-    ciqResults <- for results $ maybe (fail "Results may not be nullable") return . fromNullable
-    ciqGrade <- if
-      | "grade" `HashMap.member` o
-        -> Just <$> o JSON..: "grade"
-      | otherwise
-        -> pure Nothing
-    return CorrectInterfaceRequest{..}
 
 
 getECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
@@ -116,10 +68,9 @@ postECorrectR tid ssh csh examn = do
     Entity eId Exam{} <- lift $ fetchExam tid ssh csh examn
     euid <- traverse decrypt ciqUser
 
-    guardMExceptT (maybe True ((>= 3) . length) $ euid ^? _Left) $
+    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
@@ -138,24 +89,16 @@ 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 $ succ maxCountUserMatches
       return user
 
-    let
-      userToResponse (Entity uid User{..}) = do
-        uuid <- encrypt uid
-        return CorrectInterfaceUser
-          { ciuSurname     = userSurname
-          , ciuDisplayName = userDisplayName
-          , ciuMatNr       = userMatrikelnummer
-          , ciuId          = uuid
-          }
-
     if
       -- on no-op request, answer with 200 and a set of all participant matches
       | is _Nothing ciqResults, is _Nothing ciqGrade -> do
-        users <- traverse userToResponse participantMatches
+        users <- traverse userToResponse $ take maxCountUserMatches participantMatches
         return CorrectInterfaceResponseNoOp
-          { cirnUsers = Set.fromList users
+          { cirnUsers   = Set.fromList users
+          , cirnHasMore = length participantMatches > maxCountUserMatches
           }
 
       -- on match with exactly one exam participant, insert results and/or grade and answer with 200
@@ -247,19 +190,14 @@ 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
           }
-
+  
-  let
-    responseStatus = case response of
-      CorrectInterfaceResponseSuccess{} -> ok200
-      CorrectInterfaceResponseNoOp{}    -> ok200
-      _                                 -> badRequest400
-
   whenM acceptsJson $
-    sendResponseStatus responseStatus $ toJSON response
+    sendResponseStatus (ciResponseStatus response) $ toJSON response
-
+  
   redirect $ CExamR tid ssh csh examn EShowR

src/Handler/Exam/Users.hs

@@ -389,6 +389,7 @@ deriveJSON defaultOptions
 
 data ExamUserCsvException
   = ExamUserCsvExceptionNoMatchingUser
+  | ExamUserCsvExceptionMultipleMatchingUsers
   | ExamUserCsvExceptionNoMatchingStudyFeatures
   | ExamUserCsvExceptionNoMatchingOccurrence
   | ExamUserCsvExceptionMismatchedGradingMode ExamGradingMode ExamGradingMode
@@ -972,13 +973,14 @@ postEUsersR tid ssh csh examn = do
 
               guessUser' :: ExamUserTableCsv -> DB (Bool, UserId)
               guessUser' ExamUserTableCsv{..} = do
-                let criteria = Set.fromList $ catMaybes
+                let criteria = PredDNF . maybe Set.empty Set.singleton . fromNullable . Set.fromList . fmap PLVariable $ catMaybes
                       [ GuessUserMatrikelnummer <$> csvEUserMatriculation
                       , GuessUserDisplayName <$> csvEUserName
                       , GuessUserSurname <$> csvEUserSurname
                       , GuessUserFirstName <$> csvEUserFirstName
                       ]
-                pid <- 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
 
               lookupOccurrence :: ExamUserTableCsv -> DB (Maybe ExamOccurrenceId)

src/Handler/ExternalExam.hs

@@ -8,3 +8,4 @@ import Handler.ExternalExam.Show as Handler.ExternalExam
 import Handler.ExternalExam.Edit as Handler.ExternalExam
 import Handler.ExternalExam.Users as Handler.ExternalExam
 import Handler.ExternalExam.StaffInvite as Handler.ExternalExam
+import Handler.ExternalExam.Correct as Handler.ExternalExam

src/Handler/ExternalExam/Correct.hs

@@ -0,0 +1,149 @@
+module Handler.ExternalExam.Correct
+  ( getEECorrectR, postEECorrectR
+  ) where
+
+import Import
+
+import qualified Data.Set as Set
+import qualified Data.List.NonEmpty as NonEmpty (toList)
+
+import qualified Database.Esqueleto as E
+--import qualified Database.Esqueleto.Utils as E
+import Database.Persist.Sql (transactionUndo)
+
+import Handler.Utils
+import Handler.Utils.ExternalExam
+import Handler.Utils.Users
+
+import Utils.Exam.Correct
+
+
+-- | 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
+
+-- | 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
+  MsgRenderer mr <- getMsgRenderer
+
+  Entity eeId ExternalExam{..} <- runDB $ fetchExternalExam tid ssh coursen examn
+
+  mayEditResults <- hasWriteAccessTo $ EExamR tid ssh coursen examn EEUsersR
+
+  let
+    heading = mr $ MsgExternalExamCorrectHeading coursen examn
+
+    ptsInput :: ExamPartNumber -> Widget
+    ptsInput = const mempty
+
+    examParts :: [ExamPart]
+    examParts = []
+
+    examGrades :: [ExamGrade]
+    examGrades = universeF
+
+    examGradingMode = externalExamGradingMode
+
+  examCorrectIdent <- encrypt eeId :: Handler CryptoUUIDExternalExam
+
+  siteLayoutMsg heading $ do
+    setTitleI heading
+    let examCorrectExplanation = $(i18nWidgetFile "external-exam-correct-explanation")
+    $(widgetFile "exam-correct")
+
+
+postEECorrectR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Void
+postEECorrectR tid ssh coursen examn = do
+  MsgRenderer mr <- getMsgRenderer
+
+  CorrectInterfaceRequest{..} <- requireCheckJsonBody
+
+  mayEditResults <- hasWriteAccessTo $ EExamR tid ssh coursen examn EEUsersR
+
+  response <- runDB . exceptT (<$ transactionUndo) return $ do
+    Entity eeId ExternalExam{..} <- lift $ fetchExternalExam tid ssh coursen examn
+    euid <- traverse decrypt ciqUser
+
+    guardMExceptT (maybe True ((>= minNeedleLength) . length) $ euid ^? _Left) $
+      CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
+
+    matches <- case euid of
+      Right uid   -> lift . E.select . E.from $ \user -> E.where_ (user E.^. UserId E.==. E.val uid) >> return user
+      Left  ident ->
+        let pdnf = PredDNF . Set.fromList $ impureNonNull . Set.fromList . pure . PLVariable <$>
+              [ GuessUserMatrikelnummer (ident :: UserMatriculation)
+              , GuessUserDisplayName    (ident :: UserDisplayName)
+              , GuessUserSurname        (ident :: UserSurname)
+              , GuessUserFirstName      (ident :: UserFirstName)
+              ]
+        in  maybe [] (either NonEmpty.toList pure) <$> lift (guessUser pdnf $ Just $ maxCountUserMatches+1)
+
+    if
+      | is _Nothing ciqResults, is _Nothing ciqGrade -> do
+        users <- traverse userToResponse $ take maxCountUserMatches matches
+        return CorrectInterfaceResponseNoOp
+          { cirnUsers   = Set.fromList users
+          , cirnHasMore = length matches > maxCountUserMatches
+          }
+      | [match@(Entity uid _)] <- matches -> do
+        now <- liftIO getCurrentTime
+        newExamResult <- for ciqGrade $ \ciqGrade' -> lift $ do
+          unless mayEditResults $
+            permissionDeniedI MsgUnauthorizedExamCorrectorGrade
+          mOldResult <- getBy $ UniqueExternalExamResult eeId uid
+          if
+            | Just (Entity oldId _) <- mOldResult, is _Nothing ciqGrade' -> do
+              delete oldId
+              audit $ TransactionExternalExamResultDelete eeId uid
+              return Nothing
+            | Just resultGrade <- ciqGrade' -> let
+                mOld = externalExamResultResult . entityVal <$> mOldResult
+              in if
+                | ciqGrade' /= mOld -> do
+                  let resultTime = fromMaybe now externalExamDefaultTime
+                  newResult <- upsert ExternalExamResult
+                    { externalExamResultExam        = eeId
+                    , externalExamResultUser        = uid
+                    , externalExamResultResult      = resultGrade
+                    , externalExamResultTime        = resultTime
+                    , externalExamResultLastChanged = now
+                    }
+                    [ ExternalExamResultResult      =. resultGrade
+                    , ExternalExamResultTime        =. resultTime
+                    , ExternalExamResultLastChanged =. now
+                    ]
+                  audit $ TransactionExternalExamResultEdit eeId uid
+                  return $ newResult ^? _entityVal . _externalExamResultResult
+                | otherwise -> return $ mOldResult ^? _Just . _entityVal . _externalExamResultResult
+            | otherwise -> return Nothing
+
+        user <- userToResponse match
+        return CorrectInterfaceResponseSuccess
+          { cirsUser    = user
+          , cirsResults = mempty
+          , cirsGrade   = newExamResult
+          , cirsTime    = now
+          }
+
+      | [] <- matches -> return CorrectInterfaceResponseFailure
+        { cirfUser    = Nothing
+        , cirfMessage = mr MsgExternalExamCorrectErrorNoMatchingUsers
+        }
+
+      | otherwise -> do
+        users <- traverse userToResponse $ take maxCountUserMatches matches
+        return CorrectInterfaceResponseAmbiguous
+          { ciraUsers   = Set.fromList users
+          , ciraHasMore = length matches > maxCountUserMatches
+          , ciraMessage = mr MsgExternalExamCorrectErrorMultipleMatchingUsers
+          }
+
+  whenM acceptsJson $
+    sendResponseStatus (ciResponseStatus response) $ toJSON response
+
+  redirect $ EExamR tid ssh coursen examn EEShowR

src/Handler/Utils/ExternalExam.hs

@@ -0,0 +1,15 @@
+module Handler.Utils.ExternalExam
+  ( fetchExternalExam
+  ) where
+
+import Import
+
+
+fetchExternalExam :: MonadHandler m => TermId -> SchoolId -> CourseName -> ExamName -> ReaderT SqlBackend m (Entity ExternalExam)
+fetchExternalExam tid ssh coursen examn = 
+  let cachId = encodeUtf8 $ tshow (tid, ssh, coursen, examn)
+  in  cachedBy cachId $ do
+      mExtEx <- getBy $ UniqueExternalExam tid ssh coursen examn
+      case mExtEx of
+        Just extEx -> return extEx
+        _          -> notFound

src/Handler/Utils/ExternalExam/Users.hs

@@ -10,6 +10,7 @@ import Handler.Utils.Users
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import qualified Data.List.NonEmpty as NonEmpty (head)
 
 import qualified Colonnade
 
@@ -393,7 +394,8 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
     dbtCsvDecode
       | mode == EEUMUsers = Just DBTCsvDecode
         { dbtCsvRowKey = \csv -> do
-            pid <- lift $ guessUser' csv
+            guess <- lift $ guessUser' csv
+            let pid = either (entityKey . NonEmpty.head) entityKey guess
             fmap E.Value . MaybeT . getKeyBy $ UniqueExternalExamResult eeId pid
         , dbtCsvComputeActions = \case
             DBCsvDiffMissing{dbCsvOldKey}
@@ -401,8 +403,10 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
             DBCsvDiffNew{dbCsvNewKey = Just _}
               -> error "An UniqueExternalExamResult could be found, but the ExternalExamResultKey is not among the existing keys"
             DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
-              pid <- lift $ guessUser' dbCsvNew
+              guess <- lift $ guessUser' dbCsvNew
-              let ExternalExamUserTableCsv{..} = dbCsvNew
+              let
+                pid = either (entityKey . NonEmpty.head) entityKey guess
+                ExternalExamUserTableCsv{..} = dbCsvNew
               occTime <- maybe (throwM ExamUserCsvExceptionNoOccurrenceTime) return $ fmap zonedTimeToUTC csvEUserOccurrenceStart <|> externalExamDefaultTime
               yield $ ExternalExamUserCsvRegisterData pid occTime csvEUserExamResult
             DBCsvDiffExisting{..} -> do
@@ -485,16 +489,16 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
         registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname
           where
             Entity _ User{..} = view resultUser $ existing Map.! registration
-
+        
-        guessUser' :: ExternalExamUserTableCsv -> DB UserId
+        guessUser' :: ExternalExamUserTableCsv -> DB (Either (NonEmpty (Entity User)) (Entity User))
         guessUser' ExternalExamUserTableCsv{..} = do
-          let criteria = Set.fromList $ catMaybes
+          let criteria = PredDNF . maybe Set.empty Set.singleton . fromNullable . Set.fromList . fmap PLVariable $ catMaybes
                 [ GuessUserMatrikelnummer <$> csvEUserMatriculation
                 , GuessUserDisplayName <$> csvEUserName
                 , 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

src/Handler/Utils/Users.hs

@@ -15,6 +15,8 @@ import Foundation.Yesod.Auth (upsertCampusUser)
 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
 
@@ -68,15 +70,20 @@ matchesName (repack -> haystack) (repack -> needle)
       , singletonMap NameMatchPermutation $ ((==) `on` MultiSet.fromList) (asWords needle) (asWords haystack)
       ]
 
-guessUser :: Set GuessUserInfo -> DB (Maybe UserId)
+
-guessUser (Set.toList -> 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
 
     containsAsSet x y = E.and . map (\y' -> x `E.hasInfix` E.val y') $ asWords y
-
+    
-    toSql user = \case
+    toSql user pl = bool id E.not_ (is _PLNegated pl) $ case pl ^. _plVar of
       GuessUserMatrikelnummer userMatriculation' -> user E.^. UserMatrikelnummer  E.==.          E.val (Just userMatriculation')
       GuessUserDisplayName    userDisplayName'   -> user E.^. UserDisplayName    `containsAsSet` userDisplayName'
       GuessUserSurname        userSurname'       -> user E.^. UserSurname        `containsAsSet` userSurname'
@@ -84,39 +91,84 @@ guessUser (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
 
     go didLdap = do
       let retrieveUsers = E.select . E.from $ \user -> do
-            E.where_ . E.and $ map (toSql user) criteria
+            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
 
           matchesMatriculation :: Entity User -> Maybe Bool
-          matchesMatriculation = preview $ _entityVal . _userMatrikelnummer . to (\userMatr -> all ((== userMatr) . Just) $ criteria ^.. folded . _guessUserMatrikelnummer)
+          matchesMatriculation = preview $ _entityVal . _userMatrikelnummer . to (\userMatr ->
+            any (\p -> all ((== userMatr) . Just) (p ^.. folded . _PLVariable . _guessUserMatrikelnummer)
+                    && all ((/= userMatr) . Just) (p ^.. folded . _PLNegated  . _guessUserMatrikelnummer))
+            $ criteria ^.. folded)
 
           closeness :: Entity User -> Entity User -> Ordering
-          closeness = mconcat $ concat
+          closeness ul ur = maximum $ impureNonNull $ criteria <&> \term -> 
-            [ pure $ comparing (fmap Down . matchesMatriculation)
+            let
-            , (criteria ^.. folded . _guessUserSurname) <&> \surn -> comparing (view $ _entityVal . _userSurname . to (`matchesName` surn))
+              matches userField name = _entityVal . userField . to (`matchesName` name)
-            , (criteria ^.. folded . _guessUserFirstName) <&> \firstn -> comparing (view $ _entityVal . _userFirstName . to (`matchesName` firstn))
+              comp True  userField guess = (term ^.. folded . _PLVariable . guess) <&> \name ->
-            , (criteria ^.. folded . _guessUserDisplayName) <&> \dispn -> comparing (view $ _entityVal . _userDisplayName . to (`matchesName` dispn))
+                compare (       ul ^. userField `matches` name)
-            ]
+                        (       ur ^. userField `matches` name)
+              comp False userField guess = (term ^.. folded . _PLNegated  . guess) <&> \name ->
+                compare (Down $ ul ^. userField `matches` name)
+                        (Down $ ur ^. userField `matches` name)
+            in mconcat $ concat $
+                 [ pure $ compare (Down $ matchesMatriculation ul) (Down $ matchesMatriculation ur)
+                 ] <>
+                 [ comp b userField guess
+                 | (userField,guess) <- [(_userSurname    , _guessUserSurname)
+                                        ,(_userFirstName  , _guessUserFirstName)
+                                        ,(_userDisplayName, _guessUserDisplayName)
+                                        ]
+                  , b <- [True,False]
+                  ]
+          
+          -- Assuming the input list is sorted in descending order by closeness:
+          takeClosest []  = []
+          takeClosest [x] = [x]
+          takeClosest (x:x':xs)
+            | EQ <- x `closeness` x' = x : takeClosest (x':xs)
+            | otherwise = [x]
 
           doLdap userMatr = do
             ldapPool' <- getsYesod $ view _appLdapPool
-            fmap (fmap entityKey . join) . for ldapPool' $ \ldapPool -> do
+            fmap join . for ldapPool' $ \ldapPool -> do
               ldapData <- campusUserMatr' ldapPool FailoverUnlimited userMatr
               for ldapData $ upsertCampusUser UpsertCampusUser
 
+      let
+        getTermMatr :: [PredLiteral GuessUserInfo] -> Maybe UserMatriculation
+        getTermMatr = getTermMatrAux Nothing where
+          getTermMatrAux acc [] = acc
+          getTermMatrAux acc (PLVariable (GuessUserMatrikelnummer matr):xs)
+            | Just matr' <- acc, matr == matr' = getTermMatrAux acc xs
+            | Nothing    <- acc                = getTermMatrAux (Just matr) xs
+            | otherwise                        = Nothing
+          getTermMatrAux acc (PLNegated  (GuessUserMatrikelnummer matr):xs)
+            | Just matr' <- acc, matr /= matr' = getTermMatrAux acc xs
+            | Nothing    <- acc                = getTermMatrAux acc xs
+            | otherwise                        = Nothing
+          getTermMatrAux acc (_:xs) = getTermMatrAux acc xs
+
+        convertLdapResults :: [Entity User] -> Maybe (Either (NonEmpty (Entity User)) (Entity User))
+        convertLdapResults []  = Nothing
+        convertLdapResults [x] = Just $ Right x
+        convertLdapResults xs  = Just $ Left $ NonEmpty.fromList xs
+      
       if
-        | [x@(Entity pid _)] <- users'
+        | [x] <- users'
         , Just True == matchesMatriculation x || didLdap
-          -> return $ Just pid
+          -> return $ Just $ Right x
-        | x@(Entity pid _) : x' : _ <- users'
+        | x : x' : _ <- users'
         , Just True == matchesMatriculation x || didLdap
         , GT <- x `closeness` x'
-          -> return $ Just pid
+          -> return $ Just $ Right x
+        | xs@(x:_:_) <- takeClosest users'
+        , Just True == matchesMatriculation x || didLdap
+          -> return $ Just $ Left $ NonEmpty.fromList xs
         | not didLdap
-        , userMatr : userMatrs' <- criteria ^.. folded . _guessUserMatrikelnummer
+        , userMatrs <- (Set.toList . Set.fromList . catMaybes) $ getTermMatr <$> criteria
-        , all (== userMatr) userMatrs'
+          -> mapM doLdap userMatrs >>= maybe (go True) (return . Just) . convertLdapResults . catMaybes
-          -> doLdap userMatr >>= maybe (go True) (return . Just)
         | otherwise
           -> return Nothing

src/Model/Types/Security.hs

@@ -132,6 +132,7 @@ data PredLiteral a = PLVariable { plVar :: a } | PLNegated { plVar :: a }
   deriving anyclass (Hashable, Binary)
 
 makeLenses_ ''PredLiteral
+makePrisms ''PredLiteral
 
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 1

src/Utils/Exam/Correct.hs

@@ -0,0 +1,87 @@
+module Utils.Exam.Correct
+  ( CorrectInterfaceRequest(..)
+  , CorrectInterfaceResponse(..), ciResponseStatus
+  , CorrectInterfaceUser(..), userToResponse
+  ) where
+
+import Import.NoFoundation
+
+import qualified Data.Aeson as JSON
+import qualified Data.HashMap.Strict as HashMap
+
+
+data CorrectInterfaceUser
+  = CorrectInterfaceUser
+    { ciuSurname     :: Text
+    , ciuDisplayName :: Text
+    , ciuMatNr       :: Maybe UserMatriculation
+    , ciuId          :: CryptoUUIDUser
+    } deriving (Eq,Ord)
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  } ''CorrectInterfaceUser
+
+userToResponse :: (MonadHandler m, MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey) => Entity User -> m CorrectInterfaceUser
+userToResponse (Entity uid User{..}) = do
+  uuid <- encrypt uid
+  return CorrectInterfaceUser
+    { ciuSurname     = userSurname
+    , ciuDisplayName = userDisplayName
+    , ciuMatNr       = userMatrikelnummer
+    , ciuId          = uuid
+    }
+
+
+data CorrectInterfaceResponse
+  = CorrectInterfaceResponseSuccess
+    { cirsUser       :: CorrectInterfaceUser
+    , cirsResults    :: Map ExamPartNumber (Maybe ExamResultPoints)
+    , cirsGrade      :: Maybe (Maybe ExamResultPassedGrade)
+    , cirsTime       :: UTCTime
+    }
+  | CorrectInterfaceResponseAmbiguous
+    { ciraUsers      :: Set CorrectInterfaceUser
+    , ciraHasMore    :: Bool
+    , ciraMessage    :: Text
+    }
+  | CorrectInterfaceResponseFailure
+    { cirfUser       :: Maybe CorrectInterfaceUser
+    , cirfMessage    :: Text
+    }
+  | CorrectInterfaceResponseNoOp
+    { cirnUsers      :: Set CorrectInterfaceUser
+    , cirnHasMore    :: Bool
+    }
+
+deriveToJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 3
+  , fieldLabelModifier     = camelToPathPiece' 1
+  , sumEncoding            = TaggedObject "status" "results"
+  , omitNothingFields      = True
+  } ''CorrectInterfaceResponse
+
+ciResponseStatus :: CorrectInterfaceResponse -> Status
+ciResponseStatus CorrectInterfaceResponseSuccess{} = ok200
+ciResponseStatus CorrectInterfaceResponseNoOp{}    = ok200
+ciResponseStatus _                                 = badRequest400
+
+
+data CorrectInterfaceRequest
+  = CorrectInterfaceRequest
+    { ciqUser        :: Either Text (CryptoID UUID (Key User))
+    , ciqResults     :: Maybe (NonNull (Map ExamPartNumber (Maybe Points)))
+    , ciqGrade       :: Maybe (Maybe ExamResultPassedGrade)
+    }
+
+instance FromJSON CorrectInterfaceRequest where
+  parseJSON = JSON.withObject "CorrectInterfaceRequest" $ \o -> do
+    ciqUser <- Right <$> o JSON..: "user" <|> Left <$> o JSON..: "user"
+    results <- o JSON..:? "results"
+    ciqResults <- for results $ maybe (fail "Results may not be nullable") return . fromNullable
+    ciqGrade <- if
+      | "grade" `HashMap.member` o
+        -> Just <$> o JSON..: "grade"
+      | otherwise
+        -> pure Nothing
+    return CorrectInterfaceRequest{..}

templates/exam-correct.hamlet

@@ -23,9 +23,11 @@ $newline never
         <tr .table__row #exam-correct__new>
           <td .table__td .uw-exam-correct--date-cell>
           <td .table__td .exam-correct--input-status>
-            <input #exam-correct__user .uw-exam-correct--user-cell type="text" autofocus minLength=3>
+            <input #exam-correct__user .uw-exam-correct--user-cell type="text" autofocus minLength=#{minNeedleLength}>
             <i #exam-correct__user-status .fas .fa-fw>
             <ul #exam-correct__user-candidates>
+            <div #exam-correct__user-candidates-more hidden=true>
+              _{MsgExamCorrectUserCandidatesMore}
           $forall ExamPart{examPartNumber} <- examParts
             <td .table__td .uw-exam-correct--part-cell>
               ^{ptsInput examPartNumber}

templates/i18n/external-exam-correct-explanation/de-de-formal.hamlet

@@ -0,0 +1,17 @@
+$newline never
+<p>
+  Um eine Prüfungsleistung einzutragen können Sie in der #
+  Teilnehmer-Spalte einen beliebigen eindeutigen Identifikator des #
+  Teilnehmers angeben.<br />
+
+  Vermutlich eindeutig ist die Matrikelnummer des Teilnehmers, aber #
+  auch der (volle) Name oder ein Teil der Matrikelnummer können unter #
+  Umständen bereits eindeutig sein.<br />
+
+  Beim Senden von Prüfungsleistungen wird der bisherige Stand in der #
+  Datenbank überschrieben. #
+  Es werden auch Prüfungsleistungen überschrieben, die andere Benutzer #
+  eingetragen haben.<br />
+
+  Bereits eingetragene Prüfungsleistungen können auch gelöscht werden; #
+  es ist danach keine Prüfungsleistung mehr in der Datenbank hinterlegt.

templates/i18n/external-exam-correct-explanation/en-eu.hamlet

@@ -0,0 +1,15 @@
+$newline never
+<p>
+  To enter a participant's exam result you can submit any string #
+  that uniquely identifies the participant.<br />
+
+  Matriculation numbers are likely unique. #
+  The participant's (full) name or a part of their matriculation number #
+  may also be sufficiently unique.<br />
+
+  When entering results, the current state in the database is #
+  overwritten. #
+  Results entered by other users are also overwritten.<br />
+
+  It is possible to delete results. #
+  After doing so no exam result is saved within the database.