diff --git a/frontend/src/utils/exam-correct/exam-correct.js b/frontend/src/utils/exam-correct/exam-correct.js
index 08b679767..45f967ee7 100644
--- a/frontend/src/utils/exam-correct/exam-correct.js
+++ b/frontend/src/utils/exam-correct/exam-correct.js
@@ -99,8 +99,6 @@ export class ExamCorrect {
// abort send if there are no results (after validation)
if (Object.keys(results).length <= 0) return;
- console.log('input validated, proceeding', participant, results);
-
// TODO create and use template for this
const correctionRow = document.createElement('TR');
correctionRow.classList.add('table__row');
@@ -145,8 +143,6 @@ export class ExamCorrect {
op: true,
};
- console.log('body', body);
-
this._app.httpClient.post({
url: url,
headers: headers,
@@ -170,19 +166,35 @@ export class ExamCorrect {
if (participantIdent === participant) {
let faIcon, ecClass;
switch (response.status) {
+ // TODO fetch update time from response and replace
case 'success':
- // TODO replace loading spinner class with fontawesome tick mark icon
- // TODO replace participant identifier with participant from response
faIcon = 'fa-check';
ecClass = 'exam-correct--success';
+ if (response.user) {
+ participantElem.setAttribute(EXAM_CORRECT_PARTICIPANT_ATTR, response.user.id);
+ participantElem.innerHTML = '';
+ formatUser(participantElem, response.user);
+ }
+ // TODO replace results with results from response
+ // TODO set edit button visibility
break;
- case 'error':
- // TODO replace loading spinner class with fontawesome error icon
- // TODO show tooltip with error message?
+ case 'ambiguous':
+ // TODO show tooltip with error message
+ // TODO set edit button visibility
+ faIcon = 'fa-times';
+ ecClass = 'exam-correct--error';
+ // TODO show users
+ if (response.users) {
+ showUsers(participantElem, response.users);
+ }
+ break;
+ case 'failure':
faIcon = 'fa-times';
ecClass = 'exam-correct--error';
break;
default:
+ // TODO show tooltip with 'invalid response'
+ // TODO set edit button visibility
console.error('Invalid response');
faIcon = 'fa-times';
ecClass = 'exam-correct--error';
@@ -212,3 +224,24 @@ export class ExamCorrect {
function clearInput(inputElement) {
inputElement.value = null;
}
+
+function formatUser(elem, user) {
+ if (user && user['display-name'] && user['surname']) {
+ elem.innerHTML += user['display-name'].replace(new RegExp(user['surname']), `${user['surname']}`) + (user['mat-nr'] ? ` (${user['mat-nr']})` : '');
+ } else {
+ console.error('Unable to format invalid user response');
+ }
+}
+
+// TODO better name
+function showUsers(elem, users) {
+ elem.innerHTML = '';
+ if (users) {
+ for (const user of users) {
+ formatUser(elem, user);
+ elem.innerHTML += '
';
+ }
+ } else {
+ console.error('Unable to show users from invalid response');
+ }
+}
diff --git a/src/Handler/Exam/Correct.hs b/src/Handler/Exam/Correct.hs
index 141fee1ea..1c8b798b1 100644
--- a/src/Handler/Exam/Correct.hs
+++ b/src/Handler/Exam/Correct.hs
@@ -29,6 +29,7 @@ data CorrectInterfaceResponse
= CorrectInterfaceResponseSuccess
{ cirsUser :: CorrectInterfaceUser
, cirsResults :: Map ExamPartNumber (Maybe Points)
+ , cirsTime :: UTCTime
}
| CorrectInterfaceResponseAmbiguous
{ ciraUsers :: Set CorrectInterfaceUser
@@ -85,77 +86,98 @@ getECorrectR tid ssh csh examn = do
$(widgetFile "exam-correct")
-postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Value
+postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Void
postECorrectR tid ssh csh examn = do
MsgRenderer mr <- getMsgRenderer
CorrectInterfaceRequest{ciqName,ciqResults,ciqOp} <- requireCheckJsonBody
- participantMatches <- runDB $ do
+ response <- runDB $ do
Entity eId _ <- fetchExam tid ssh csh examn
- E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
+
+ participantMatches <- 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
- E.&&. ( user E.^. UserMatrikelnummer E.==. E.val (Just ciqName)
- E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val (Just ciqName)
- E.||. user E.^. UserSurname E.==. E.val ciqName
- E.||. user E.^. UserSurname `E.hasInfix` E.val ciqName
- E.||. user E.^. UserFirstName E.==. E.val ciqName
- E.||. user E.^. UserFirstName `E.hasInfix` E.val ciqName
- E.||. user E.^. UserDisplayName E.==. E.val ciqName
- E.||. user E.^. UserDisplayName `E.hasInfix` E.val ciqName )
+ E.where_ $ user E.^. UserMatrikelnummer E.==. E.val (Just ciqName)
+ E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val (Just ciqName)
+ E.||. user E.^. UserSurname E.==. E.val ciqName
+ E.||. user E.^. UserSurname `E.hasInfix` E.val ciqName
+ E.||. user E.^. UserFirstName E.==. E.val ciqName
+ E.||. user E.^. UserFirstName `E.hasInfix` E.val ciqName
+ E.||. user E.^. UserDisplayName E.==. E.val ciqName
+ E.||. user E.^. UserDisplayName `E.hasInfix` E.val ciqName
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
+ | not ciqOp -> do
+ users <- traverse userToResponse participantMatches
+ return CorrectInterfaceResponseNoOp
+ { cirnUsers = Set.fromList users
+ }
+
+ -- on match with exactly one exam participant, insert results and answer with 200
+ | [match@(Entity uid _)] <- participantMatches -> do
+ now <- liftIO getCurrentTime
+ newExamPartResults <- iforM ciqResults $ \partNumber mPartResult -> do
+ examPartId <- getKeyBy404 $ UniqueExamPartNumber eId partNumber
+ mOldResult <- getBy $ UniqueExamPartResult examPartId uid
+ if
+ | Just (Entity oldId _) <- mOldResult, is _Nothing mPartResult -> do
+ delete oldId
+ audit $ TransactionExamPartResultDeleted examPartId uid
+ return Nothing
+ | Just partResult <- mPartResult
+ , fmap (examPartResultResult . entityVal) mOldResult /= fmap ExamAttended mPartResult -> do
+ newExamPartResult <- upsert ExamPartResult
+ { examPartResultExamPart = examPartId
+ , examPartResultUser = uid
+ , examPartResultResult = ExamAttended partResult
+ , examPartResultLastChanged = now
+ }
+ [ ExamPartResultResult =. ExamAttended partResult
+ , ExamPartResultLastChanged =. now
+ ]
+ audit $ TransactionExamPartResultEdit examPartId uid
+ return $ newExamPartResult ^? _entityVal . _examPartResultResult . _ExamAttended
+ | otherwise -> return Nothing
+ user <- userToResponse match
+ return CorrectInterfaceResponseSuccess
+ { cirsUser = user
+ , cirsResults = newExamPartResults
+ , cirsTime = now
+ }
+
+ -- on match with no exam participant, answer with 400
+ | [] <- participantMatches -> return CorrectInterfaceResponseFailure
+ { cirfMessage = mr MsgExamCorrectErrorNoMatchingParticipants
+ }
+
+ -- on match with multiple exam participants, answer with 400 and a set of all matches
+ | otherwise -> do
+ users <- traverse userToResponse participantMatches
+ return CorrectInterfaceResponseAmbiguous
+ { ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants
+ , ciraUsers = Set.fromList users
+ }
+
let
- userToResponse (Entity uid User{..}) = do
- uuid <- encrypt uid
- return CorrectInterfaceUser
- { ciuSurname = userSurname
- , ciuDisplayName = userDisplayName
- , ciuMatNr = userMatrikelnummer
- , ciuId = uuid
- }
+ responseStatus = case response of
+ CorrectInterfaceResponseSuccess{} -> ok200
+ CorrectInterfaceResponseNoOp{} -> ok200
+ _ -> badRequest400
- if
- | not ciqOp -> do
- users <- traverse userToResponse participantMatches
- returnJson $ CorrectInterfaceResponseNoOp
- { cirnUsers = Set.fromList users
- }
- | [match@(Entity uid _)] <- participantMatches -> do
- runDB $ do
- Entity eId _ <- fetchExam tid ssh csh examn
- iforM_ ciqResults $ \partNumber mPartResult -> do
- examPartId <- getKeyBy404 $ UniqueExamPartNumber eId partNumber
- mOldResult <- getBy $ UniqueExamPartResult examPartId uid
- unless (fmap (examPartResultResult . entityVal) mOldResult /= mPartResult) $ do
- let partResult = maybe 0.00 (\p -> ExamPartResultResult p) mPartResult
- now <- liftIO getCurrentTime
- upsert ExamPartResult
- { examPartResultExamPart = examPartId
- , examPartResultUser = uid
- , examPartResultResult = partResult
- , examPartResultLastChanged = now
- }
- [ ExamPartResultResult =. partResult
- ]
- audit $ TransactionExamPartResultEdit examPartId uid
- user <- userToResponse match
- returnJson $ CorrectInterfaceResponseSuccess
- { cirsUser = user
- , cirsResults = ciqResults
- }
- | [] <- participantMatches -> returnJson $ CorrectInterfaceResponseFailure
- { cirfMessage = mr MsgExamCorrectErrorNoMatchingParticipants
- }
- | otherwise -> do
- users <- traverse userToResponse participantMatches
- returnJson $ CorrectInterfaceResponseAmbiguous
- { ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants
- , ciraUsers = Set.fromList users
- }
-
- -- TODO if the request is a noop, respond with a 200
- -- TODO if there is exactly one match, respond with a 200
- -- TODO if there are multiple matches, respond with a 400
- -- TODO if there are no matches, respond with a 400
+ whenM acceptsJson $
+ sendResponseStatus responseStatus $ toJSON response
+
+ redirect $ CExamR tid ssh csh examn EShowR