feat(exam-correct): single runDB in POST handler; more response handling
This commit is contained in:
Sarah Vaupel
parent
650598fc22
commit
6837c44b7f
@ -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']), `<strong>${user['surname']}</strong>`) + (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 += '<br/>';
|
||||
}
|
||||
} else {
|
||||
console.error('Unable to show users from invalid response');
|
||||
}
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user