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

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

@@ -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()
+      (response) => response.json()
-    //).then(
+    ).then(
       (response) => this._processResponse(response, participant)
     ).catch((error) => {
       console.error('Error while processing response', error);

src/Handler/Exam/Correct.hs

@@ -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.==. E.val (Just ciqName)
-          E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val 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
+    | not ciqOp -> do
-      users <- usersToResponse participantMatches
+      users <- traverse userToResponse participantMatches
       returnJson $ CorrectInterfaceResponseNoOp
         { cirnUsers     = Set.fromList users
         }
-    | [match] <- participantMatches -> do
+    | [match@(Entity uid _)] <- participantMatches -> do
-      -- TODO upsert results
+      runDB $ do
-      -- TODO log to Transaction Log
+        Entity eId _ <- fetchExam tid ssh csh examn
-      [user] <- usersToResponse participantMatches
+        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 the request is a noop, respond with a 200
-    -- TODO if there is exactly one match, respond with a 200, a (Map ExamPartNumber ExamPartPoints) 
+    -- TODO if there is exactly one match, respond with a 200
-    --      and a single (surname,displayName,matrikelnummer)
+    -- TODO if there are multiple matches, respond with a 400
-
+    -- TODO if there are no matches, respond with a 400
-    -- 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)