From af8d77c4a4d97cdc66b7f2e09568c1481768aa73 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <vaupel.sarah@campus.lmu.de>
Date: Fri, 7 Feb 2020 09:49:39 +0100
Subject: [PATCH] fix(exam-correct): cut off at maxPoints for now (TODO)

---
 src/Handler/Exam/Correct.hs | 32 +++++++++++++++++++-------------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/src/Handler/Exam/Correct.hs b/src/Handler/Exam/Correct.hs
index 311ae4342..daaa269a0 100644
--- a/src/Handler/Exam/Correct.hs
+++ b/src/Handler/Exam/Correct.hs
@@ -151,7 +151,7 @@ postECorrectR tid ssh csh examn = do
         now <- liftIO getCurrentTime
         newExamPartResults <- if
           | Just results <- ciqResults -> iforM (toNullable results) $ \partNumber mPartResult -> do
-            examPartId <- getKeyBy404 $ UniqueExamPartNumber eId partNumber
+            (Entity examPartId ExamPart{..}) <- getBy404 $ UniqueExamPartNumber eId partNumber
             mOldResult <- getBy $ UniqueExamPartResult examPartId uid
             if
               | Just (Entity oldId _) <- mOldResult, is _Nothing mPartResult -> do
@@ -163,18 +163,24 @@ postECorrectR tid ssh csh examn = do
                   mNew = ExamAttended <$> mPartResult
                   resultVal = _entityVal . _examPartResultResult
                 in if
-                  | mOld /= mNew -> do
-                    newExamPartResult <- upsert ExamPartResult
-                      { examPartResultExamPart    = examPartId
-                      , examPartResultUser        = uid
-                      , examPartResultResult      = ExamAttended partResult
-                      , examPartResultLastChanged = now
-                      }
-                      [ ExamPartResultResult      =. ExamAttended partResult
-                      , ExamPartResultLastChanged =. now
-                      ]
-                    audit $ TransactionExamPartResultEdit examPartId uid
-                    return $ newExamPartResult ^? resultVal
+                  | mOld /= mNew -> let
+                      -- cut off part results that exceed the maximum number of points for this exam part for now
+                      -- TODO answer with new failure response type instead
+                      partResult' = if
+                        | Just maxPts <- examPartMaxPoints, maxPts < partResult -> maxPts
+                        | otherwise -> partResult
+                    in do
+                      newExamPartResult <- upsert ExamPartResult
+                        { examPartResultExamPart    = examPartId
+                        , examPartResultUser        = uid
+                        , examPartResultResult      = ExamAttended partResult'
+                        , examPartResultLastChanged = now
+                        }
+                        [ ExamPartResultResult      =. ExamAttended partResult'
+                        , ExamPartResultLastChanged =. now
+                        ]
+                      audit $ TransactionExamPartResultEdit examPartId uid
+                      return $ newExamPartResult ^? resultVal
                   | otherwise -> return $ mOldResult ^? _Just . resultVal
               | otherwise -> return Nothing
             | otherwise -> return mempty