feat(eecorrectr): basic handler structure (WIP)

messages/uniworx/de-de-formal.msg

@@ -1435,6 +1435,7 @@ BreadcrumbAdminCrontab: Crontab
 
 ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn}
 ExternalExamGrades coursen@CourseName examn@ExamName: Prüfungsleistungen: #{coursen}, #{examn}
+ExternalExamCorrectHeading coursen@CourseName examn@ExamName: Prüfungsleistungen für #{coursen}, #{examn} eintragen
 ExternalExamUsers coursen@CourseName examn@ExamName: Teilnehmer: #{coursen}, #{examn}
 
 TitleMetrics: Metriken

messages/uniworx/en-eu.msg

@@ -1435,6 +1435,7 @@ BreadcrumbAdminCrontab: Crontab
 
 ExternalExamEdit coursen examn: Edit: #{coursen}, #{examn}
 ExternalExamGrades coursen examn: Exam achievements: #{coursen}, #{examn}
+ExternalExamCorrectHeading coursen examn: Enter exam results for #{coursen}, #{examn}
 ExternalExamUsers coursen examn: Exam participants: #{coursen}, #{examn}
 
 TitleMetrics: Metrics

src/Handler/ExternalExam/Correct.hs

@@ -4,10 +4,157 @@ module Handler.ExternalExam.Correct
 
 import Import
 
+import qualified Data.Set as Set
+
+import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
+import Database.Persist.Sql (transactionUndo)
+
+import Handler.Utils
+import Handler.Utils.ExternalExam
+
+import Utils.Exam
+
 
 getEECorrectR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
-getEECorrectR _tid _ssh _coursen _examn = error "getEECorrectR WIP"
+getEECorrectR tid ssh coursen examn = do
+  MsgRenderer mr <- getMsgRenderer
+
+  Entity _eeId ExternalExam{..} <- runDB $ fetchExternalExam tid ssh coursen examn
+
+  mayEditResults <- hasWriteAccessTo $ EExamR tid ssh coursen examn EEUsersR
+
+  let
+    heading = mr $ MsgExternalExamCorrectHeading coursen examn
+
+    ptsInput :: ExamPartNumber -> Widget
+    ptsInput = const mempty
+
+    examParts :: [ExamPart]
+    examParts = []
+
+    examGrades :: [ExamGrade]
+    examGrades = universeF
+
+    examGradingMode = externalExamGradingMode
+
+    examCorrectIdent :: Text
+    examCorrectIdent = "TODO"  -- TODO fix below
+
+  -- examCorrectIdent <- encrypt eeId :: Handler (CryptoID UUID ExternalExamId)
+
+  siteLayoutMsg heading $ do
+    setTitleI heading
+    let
+      examCorrectExplanation = $(i18nWidgetFile "external-exam-correct-explanation")
+    $(widgetFile "exam-correct")
 
 
 postEECorrectR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Void
-postEECorrectR _tid _ssh _coursen _examn = error "postEECorrectR WIP"
+postEECorrectR tid ssh coursen examn = do
+  MsgRenderer mr <- getMsgRenderer
+
+  CorrectInterfaceRequest{..} <- requireCheckJsonBody
+
+  mayEditResults <- hasWriteAccessTo $ EExamR tid ssh coursen examn EEUsersR
+
+  response <- runDB . exceptT (<$ transactionUndo) return $ do
+    Entity eeId ExternalExam{..} <- lift $ fetchExternalExam tid ssh coursen examn
+    euid <- traverse decrypt ciqUser
+
+    guardMExceptT (maybe True ((>= 3) . length) $ euid ^? _Left) $  -- TODO rethink max needle length
+      CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
+
+    matches <- lift . E.select . E.from $ \user -> do
+      let mUserIdent = euid ^? _Left
+      E.where_ $ either (const E.false) (\uid -> user E.^. UserId E.==. E.val uid) euid
+        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
+                   E.||. user E.^. UserMatrikelnummer  E.==.       E.val mUserIdent
+                   E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
+                 Nothing -> E.false)
+      return user
+
+    let
+      userToResponse (Entity uid User{..}) = do  -- TODO move to util
+        uuid <- encrypt uid
+        return CorrectInterfaceUser
+          { ciuSurname     = userSurname
+          , ciuDisplayName = userDisplayName
+          , ciuMatNr       = userMatrikelnummer
+          , ciuId          = uuid
+          }
+    
+    if
+      | is _Nothing ciqResults, is _Nothing ciqGrade -> do
+        users <- traverse userToResponse matches
+        return CorrectInterfaceResponseNoOp
+          { cirnUsers = Set.fromList users
+          }
+      | [match@(Entity uid _)] <- matches -> do
+        now <- liftIO getCurrentTime
+        newExamResult <- for ciqGrade $ \ciqGrade' -> lift $ do
+          unless mayEditResults $
+            permissionDeniedI MsgUnauthorizedExamCorrectorGrade
+          mOldResult <- getBy $ UniqueExternalExamResult eeId uid
+          if
+            | Just (Entity oldId _) <- mOldResult, is _Nothing ciqGrade' -> do
+              delete oldId
+              audit $ TransactionExternalExamResultDelete eeId uid
+              return Nothing
+            | Just resultGrade <- ciqGrade' -> let
+                mOld = externalExamResultResult . entityVal <$> mOldResult
+              in if
+                | ciqGrade' /= mOld -> do
+                  newResult <- upsert ExternalExamResult
+                    { externalExamResultExam        = eeId
+                    , externalExamResultUser        = uid
+                    , externalExamResultResult      = resultGrade
+                    , externalExamResultTime        = now  -- TODO add and use utcTimeField
+                    , externalExamResultLastChanged = now
+                    }
+                    [ ExternalExamResultResult      =. resultGrade
+                    , ExternalExamResultTime        =. now  -- TODO add and use utcTimeField
+                    , ExternalExamResultLastChanged =. now
+                    ]
+                  audit $ TransactionExternalExamResultEdit eeId uid
+                  return $ newResult ^? _entityVal . _externalExamResultResult
+                | otherwise -> return $ mOldResult ^? _Just . _entityVal . _externalExamResultResult
+            | otherwise -> return Nothing
+
+        user <- userToResponse match
+        return CorrectInterfaceResponseSuccess
+          { cirsUser    = user
+          , cirsResults = mempty
+          , cirsGrade   = newExamResult
+          , cirsTime    = now
+          }
+
+      | [] <- matches -> return CorrectInterfaceResponseFailure
+        { cirfUser    = Nothing
+        , cirfMessage = mr MsgExamCorrectErrorNoMatchingParticipants  -- TODO use new msg
+        }
+
+      | otherwise -> do
+        users <- traverse userToResponse matches
+        return CorrectInterfaceResponseAmbiguous
+          { ciraUsers   = Set.fromList users
+          , ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants  -- TODO use new msg
+          }
+
+  let
+    responseStatus = case response of
+      CorrectInterfaceResponseSuccess{} -> ok200
+      CorrectInterfaceResponseNoOp{}    -> ok200
+      _                                 -> badRequest400
+
+  whenM acceptsJson $
+    sendResponseStatus responseStatus $ toJSON response
+
+  redirect $ EExamR tid ssh coursen examn EEShowR

src/Handler/Utils/ExternalExam.hs

@@ -0,0 +1,15 @@
+module Handler.Utils.ExternalExam
+  ( fetchExternalExam
+  ) where
+
+import Import
+
+
+fetchExternalExam :: MonadHandler m => TermId -> SchoolId -> CourseName -> ExamName -> ReaderT SqlBackend m (Entity ExternalExam)
+fetchExternalExam tid ssh coursen examn = 
+  let cachId = encodeUtf8 $ tshow (tid, ssh, coursen, examn)
+  in  cachedBy cachId $ do
+      mExtEx <- getBy $ UniqueExternalExam tid ssh coursen examn
+      case mExtEx of
+        Just extEx -> return extEx
+        _          -> notFound

templates/i18n/external-exam-correct-explanation/de-de-formal.hamlet

@@ -0,0 +1,30 @@
+$newline never
+<p>
+  Um eine Prüfungsleistung einzutragen können Sie in der #
+  Teilnehmer-Spalte einen beliebigen eindeutigen Identifikator des #
+  Teilnehmers angeben.<br />
+
+  Es können nur Ergebnisse für Studierende eingetragen werden, die #
+  bereits Prüfungsteilnehmer sind. #
+  Über diese Oberfläche können keine neuen Benutzer zur Klausur #
+  angemeldet werden.<br />
+
+  Vermutlich eindeutig ist die Matrikelnummer des Teilnehmers, aber #
+  auch der Name oder ein Teil der Matrikelnummer können unter #
+  Umständen bereits eindeutig sein.<br />
+
+  Wenn Felder für Ergebnisse frei gelassen werden, wird an dieser #
+  Stelle nichts in die Datenbank eingetragen.<br />
+
+  Beim Senden von Ergebnissen wird der bisherige Stand in der #
+  Datenbank überschrieben. #
+  Es werden auch Ergebnisse überschrieben, die andere Benutzer #
+  eingetragen haben.<br />
+
+  Bereits eingetragene Ergebnisse können auch gelöscht werden; es ist #
+  danach für den jeweiligen Teil der Prüfung kein Ergebnis mehr in der #
+  Datenbank hinterlegt.<br />
+
+  Falls eine automatische Notenberechnung konfiguriert ist, müssen die #
+  berechneten Ergebnisse noch auf der Seite der Klausurteilnehmerliste #
+  akzeptiert werden.

templates/i18n/external-exam-correct-explanation/en-eu.hamlet

@@ -0,0 +1,27 @@
+$newline never
+<p>
+  To enter a participant's exam achievement you can submit any string #
+  that uniquely identifies the participant.<br />
+
+  Results can only be entered for users who are already exam #
+  participants. #
+  No new participants can be added to the exam using this interface. #
+
+  Matriculation numbers are likely unique. #
+  The participant's name or a part of their matriculation number may #
+  also be sufficiently unique.<br />
+
+  If any fields are left blank no result is saved for that part of the #
+  exam.<br />
+
+  When entering results, the current state in the database is #
+  overwritten. #
+  Results entered by other users are also overwritten.<br />
+
+  It is possible to delete results. #
+  After doing so no result is saved for that part of the exam within #
+  the database.<br />
+
+  If grades are to be computed automatically for this exam, the #
+  results need to be accepted. #
+  This is done via the listing of exam participants.