diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 0f9ef0772..0850a4677 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 0a790037f..78c59e0e7 100644 --- a/messages/uniworx/en-eu.msg +++ b/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 diff --git a/src/Handler/ExternalExam/Correct.hs b/src/Handler/ExternalExam/Correct.hs index e930a0680..401890fc9 100644 --- a/src/Handler/ExternalExam/Correct.hs +++ b/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 diff --git a/src/Handler/Utils/ExternalExam.hs b/src/Handler/Utils/ExternalExam.hs new file mode 100644 index 000000000..1d411e960 --- /dev/null +++ b/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 diff --git a/templates/i18n/external-exam-correct-explanation/de-de-formal.hamlet b/templates/i18n/external-exam-correct-explanation/de-de-formal.hamlet new file mode 100644 index 000000000..5cc48c036 --- /dev/null +++ b/templates/i18n/external-exam-correct-explanation/de-de-formal.hamlet @@ -0,0 +1,30 @@ +$newline never +

+ Um eine Prüfungsleistung einzutragen können Sie in der # + Teilnehmer-Spalte einen beliebigen eindeutigen Identifikator des # + Teilnehmers angeben.
+ + 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.
+ + Vermutlich eindeutig ist die Matrikelnummer des Teilnehmers, aber # + auch der Name oder ein Teil der Matrikelnummer können unter # + Umständen bereits eindeutig sein.
+ + Wenn Felder für Ergebnisse frei gelassen werden, wird an dieser # + Stelle nichts in die Datenbank eingetragen.
+ + Beim Senden von Ergebnissen wird der bisherige Stand in der # + Datenbank überschrieben. # + Es werden auch Ergebnisse überschrieben, die andere Benutzer # + eingetragen haben.
+ + 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.
+ + Falls eine automatische Notenberechnung konfiguriert ist, müssen die # + berechneten Ergebnisse noch auf der Seite der Klausurteilnehmerliste # + akzeptiert werden. diff --git a/templates/i18n/external-exam-correct-explanation/en-eu.hamlet b/templates/i18n/external-exam-correct-explanation/en-eu.hamlet new file mode 100644 index 000000000..2b41a9ee8 --- /dev/null +++ b/templates/i18n/external-exam-correct-explanation/en-eu.hamlet @@ -0,0 +1,27 @@ +$newline never +

+ To enter a participant's exam achievement you can submit any string # + that uniquely identifies the participant.
+ + 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.
+ + If any fields are left blank no result is saved for that part of the # + exam.
+ + When entering results, the current state in the database is # + overwritten. # + Results entered by other users are also overwritten.
+ + It is possible to delete results. # + After doing so no result is saved for that part of the exam within # + the database.
+ + 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.