fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(exam-correct): upsert exam part results (TODO)

Browse Source
This commit is contained in:
Sarah Vaupel 2020-01-15 18:06:20 +01:00 committed by Gregor Kleen
parent 5f9a176bc6
commit c0f91bccdd
2 changed files with 42 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
frontend/src/utils/exam-correct/exam-correct.js
View File

@ -1,5 +1,6 @@
import { Utility } from '../../core/utility';
import { StorageManager, LOCATION } from '../../lib/storage-manager/storage-manager';
import { HttpClient } from '../../services/http-client/http-client';
import './exam-correct.sass';
@ -135,10 +136,13 @@ export class ExamCorrect {
const url = EXAM_CORRECT_URL_POST;
const headers = {
'X-XSRF-TOKEN': Cookies.get('XSRF-TOKEN'),
'Content-Type': HttpClient.ACCEPT.JSON,
'Accept': HttpClient.ACCEPT.JSON,
};
const body = {
participant: participant,
name: participant,
results: results,
op: true,
};
console.log('body', body);
@ -146,10 +150,10 @@ export class ExamCorrect {
this._app.httpClient.post({
url: url,
headers: headers,
body: body,
body: JSON.stringify(body),
}).then(
// (response) => response.json()
//).then(
(response) => response.json()
).then(
(response) => this._processResponse(response, participant)
).catch((error) => {
console.error('Error while processing response', error);

58
src/Handler/Exam/Correct.hs
View File

@ -20,7 +20,7 @@ data CorrectInterfaceUser
, ciuDisplayName :: Text
, ciuMatNr :: Maybe UserMatriculation
, ciuId :: CryptoUUIDUser
}
} deriving (Eq,Ord)
deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1
} ''CorrectInterfaceUser
@ -43,7 +43,7 @@ data CorrectInterfaceResponse
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 3
, fieldLabelModifier = camelToPathPiece' 1
, sumEncoding = TaggedObject "status" "result"
, sumEncoding = TaggedObject "status" "results"
} ''CorrectInterfaceResponse
-- E.g.: { "status": "success", "user-ident": "Max Musterstudent", "user-matrikelnummer": "123", "results": { "1a": null, "2a": 7, "2c3.5": 12 } }
@ -51,7 +51,7 @@ data CorrectInterfaceRequest
= CorrectInterfaceRequest
{ ciqName :: Text
, ciqResults :: Map ExamPartNumber (Maybe Points)
, ciqNoOp :: Bool
, ciqOp :: Bool -- not no-op
}
deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1
@ -87,19 +87,17 @@ getECorrectR tid ssh csh examn = do
postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Value
postECorrectR tid ssh csh examn = do
now <- liftIO getCurrentTime
mUid <- maybeAuthId
MsgRenderer mr <- getMsgRenderer
CorrectInterfaceRequest{ciqName,ciqResults,ciqNoOp} <- requireCheckJsonBody
CorrectInterfaceRequest{ciqName,ciqResults,ciqOp} <- requireCheckJsonBody
participantMatches <- runDB $ do
Entity eId _ <- fetchExam tid ssh csh examn
E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
E.on $ examRegistration E.^. ExamRegistrationUser E.==. user
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 ciqName
E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val ciqName
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
@ -109,7 +107,7 @@ postECorrectR tid ssh csh examn = do
return user
let
usersToResponse = traverse $ \user@(Entity uid User{..}) -> do
userToResponse (Entity uid User{..}) = do
uuid <- encrypt uid
return CorrectInterfaceUser
{ ciuSurname = userSurname
@ -119,15 +117,30 @@ postECorrectR tid ssh csh examn = do
}
if
| ciqNoOp -> do
users <- usersToResponse participantMatches
| not ciqOp -> do
users <- traverse userToResponse participantMatches
returnJson $ CorrectInterfaceResponseNoOp
{ cirnUsers = Set.fromList users
}
| [match] <- participantMatches -> do
-- TODO upsert results
-- TODO log to Transaction Log
[user] <- usersToResponse participantMatches
| [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
@ -136,16 +149,13 @@ postECorrectR tid ssh csh examn = do
{ cirfMessage = mr MsgExamCorrectErrorNoMatchingParticipants
}
| otherwise -> do
users <- usersToResponse participantMatches
users <- traverse userToResponse participantMatches
returnJson $ CorrectInterfaceResponseAmbiguous
{ ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants
, ciraUsers = Set.fromList users
}
-- TODO if the request is a noop, respond with a 200 and the matches
-- TODO if there is exactly one match, respond with a 200, a (Map ExamPartNumber ExamPartPoints)
-- and a single (surname,displayName,matrikelnummer)
-- TODO if there are multiple matches, respond with a 400 and a set containing the matches (Ambiguous case)
-- TODO if there are no matches, respond with a 400 and an error message (no matches, Failure case)
-- 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