From 4a36a010f4bc0ea326f263c0ee77132843f03c73 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <vaupel.sarah@campus.lmu.de>
Date: Tue, 21 Jan 2020 16:45:47 +0100
Subject: [PATCH] feat(exam-correct): request refactor and handling of sent
 uuids

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

diff --git a/src/Handler/Exam/Correct.hs b/src/Handler/Exam/Correct.hs
index 1c8b798b1..79d86b9d6 100644
--- a/src/Handler/Exam/Correct.hs
+++ b/src/Handler/Exam/Correct.hs
@@ -5,7 +5,8 @@ module Handler.Exam.Correct
 import Import
 
 import qualified Data.Set as Set
-import qualified Data.CaseInsensitive as CI (original)
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Aeson as JSON
 
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
@@ -46,19 +47,20 @@ deriveJSON defaultOptions
   , fieldLabelModifier     = camelToPathPiece' 1
   , sumEncoding            = TaggedObject "status" "results"
   } ''CorrectInterfaceResponse
--- E.g.: { "status": "success", "user-ident": "Max Musterstudent", "user-matrikelnummer": "123", "results": { "1a": null, "2a": 7, "2c3.5": 12 } }
 
 data CorrectInterfaceRequest
   = CorrectInterfaceRequest
-    { ciqName        :: Text
-    , ciqResults     :: Map ExamPartNumber (Maybe Points)
-    , ciqOp          :: Bool  -- not no-op
+    { ciqUser        :: Either Text (CryptoID UUID (Key User))
+    , ciqResults     :: Maybe (NonNull (Map ExamPartNumber (Maybe Points)))
     }
-deriveJSON defaultOptions
-  { fieldLabelModifier     = camelToPathPiece' 1
-  } ''CorrectInterfaceRequest
--- E.g.: { "name": "max", "results": { "1a": null, "2c3.5": 9001.2 }}
- 
+
+instance FromJSON CorrectInterfaceRequest where
+  parseJSON = JSON.withObject "CorrectInterfaceRequest" $ \o -> do
+    ciqUser <- Right <$> o JSON..: "user" <|> Left <$> o JSON..: "user"
+    results <- o JSON..:? "results"
+    ciqResults <- for results $ maybe (fail "Results may not be nullable") return . fromNullable
+    return CorrectInterfaceRequest{..}
+
 
 getECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getECorrectR tid ssh csh examn = do
@@ -90,22 +92,30 @@ postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Vo
 postECorrectR tid ssh csh examn = do
   MsgRenderer mr <- getMsgRenderer
 
-  CorrectInterfaceRequest{ciqName,ciqResults,ciqOp} <- requireCheckJsonBody
+  CorrectInterfaceRequest{ciqUser,ciqResults} <- requireCheckJsonBody
 
   response <- runDB $ do
     Entity eId _ <- fetchExam tid ssh csh examn
+    euid <- traverse decrypt ciqUser
 
     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.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
+
+      let
+        uidMatch   = either (const $ E.val False) (\uid -> user E.^. UserId E.==. E.val uid) euid
+        mUserIdent = euid ^? _Left
+      E.where_ $ uidMatch
+           E.||. user E.^. UserMatrikelnummer E.==. E.val mUserIdent
+           E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
+           E.||. (case mUserIdent of
+            Just userIdent -> (user E.^. UserSurname E.==. E.val userIdent
+                        E.||. user E.^. UserSurname `E.hasInfix` E.val userIdent
+                        E.||. user E.^. UserFirstName E.==. E.val userIdent
+                        E.||. user E.^. UserFirstName `E.hasInfix` E.val userIdent
+                        E.||. user E.^. UserDisplayName E.==. E.val userIdent
+                        E.||. user E.^. UserDisplayName `E.hasInfix` E.val userIdent)
+            Nothing -> E.val False)
       return user
 
     let
@@ -120,16 +130,16 @@ postECorrectR tid ssh csh examn = do
 
     if
       -- on no-op request, answer with 200 and a set of all participant matches
-      | not ciqOp -> do
+      | is _Nothing ciqResults -> 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
+      | [match@(Entity uid _)] <- participantMatches, Just results <- ciqResults -> do
         now <- liftIO getCurrentTime
-        newExamPartResults <- iforM ciqResults $ \partNumber mPartResult -> do
+        newExamPartResults <- iforM (toNullable results) $ \partNumber mPartResult -> do
             examPartId <- getKeyBy404 $ UniqueExamPartNumber eId partNumber
             mOldResult <- getBy $ UniqueExamPartResult examPartId uid
             if