diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 1043a6ac0..892798b94 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1613,6 +1613,7 @@ ExamFormCorrection: Korrektur ExamFormParts: Teile ExamCorrectors: Korrektoren +ExamCorrectorsTip: Hier eingetragene Korrektoren können zwischen Beginn der Prüfung und "Bewertung abgeschlossen ab" Ergebnisse für alle Teilprüfungen und alle Teilnehmer im System hinterlegen. ExamCorrectorAlreadyAdded: Ein Korrektor mit dieser E-Mail ist bereits für diese Prüfung eingetragen ExamParts: Teilprüfungen/Aufgaben diff --git a/routes b/routes index 535a80677..0d000a959 100644 --- a/routes +++ b/routes @@ -189,6 +189,7 @@ /register/#ExamOccurrenceName ERegisterOccR POST !exam-occurrence-registrationANDtimeANDcapacityANDcourse-registeredAND¬exam-occurrence-registered !exam-occurrence-registrationANDtimeANDexam-occurrence-registeredAND¬exam-result /grades EGradesR GET POST !exam-office /assign-occurrences EAutoOccurrenceR POST + /correct ECorrectR GET POST !exam-correctorANDtime /apps CApplicationsR GET POST !/apps/files CAppsFilesR GET /apps/#CryptoFileNameCourseApplication CourseApplicationR: diff --git a/src/Foundation.hs b/src/Foundation.hs index a599bd7a6..ac3a28453 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -531,6 +531,18 @@ tagAccessPredicate AuthCorrector = APDB $ \mAuthId route _ -> exceptT return ret _ -> do guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedCorrectorAny) return Authorized +tagAccessPredicate AuthExamCorrector = APDB $ \mAuthId route _ -> case route of + CExamR tid ssh csh examn _ -> exceptT return return $ do + authId <- maybeExceptT AuthenticationRequired $ return mAuthId + isCorrector <- $cachedHereBinary (mAuthId, tid, ssh, csh, examn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examCorrector) -> do + E.on $ examCorrector E.^. ExamCorrectorExam E.==. exam E.^. ExamId + E.&&. examCorrector E.^. ExamCorrectorUser E.==. E.val authId + E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId + E.where_ $ course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + E.&&. course E.^. CourseShorthand E.==. E.val csh + E.&&. exam E.^. ExamName E.==. E.val examn + r -> $unsupportedAuthPredicate AuthExamCorrector r tagAccessPredicate AuthTutor = APDB $ \mAuthId route _ -> exceptT return return $ do authId <- maybeExceptT AuthenticationRequired $ return mAuthId resList <- $cachedHereBinary authId . lift . E.select . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutor) -> do @@ -608,6 +620,8 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of -> guard $ visible && NTop examRegisterFrom <= NTop (Just cTime) && NTop (Just cTime) <= NTop examRegisterTo + ECorrectR -> guard $ NTop (Just cTime) >= NTop examStart + && NTop (Just cTime) <= NTop examFinished _ -> return () return Authorized @@ -2072,6 +2086,7 @@ instance YesodBreadcrumbs UniWorX where ERegisterR -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR ERegisterOccR _occn -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR EAutoOccurrenceR -> i18nCrumb MsgBreadcrumbExamAutoOccurrence . Just $ CExamR tid ssh csh examn EUsersR + ECorrectR -> i18nCrumb MsgMenuExamCorrect . Just $ CExamR tid ssh csh examn EShowR breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of TUsersR -> maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do @@ -3290,6 +3305,17 @@ pageActions (CExamR tid ssh csh examn EShowR) = do } , navChildren = [] } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExamCorrect + , navRoute = CExamR tid ssh csh examn ECorrectR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } ] pageActions (CExamR tid ssh csh examn EUsersR) = return [ NavPageActionPrimary diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs index ca916130c..0e3c209dd 100644 --- a/src/Handler/Exam.hs +++ b/src/Handler/Exam.hs @@ -12,3 +12,4 @@ import Handler.Exam.Show as Handler.Exam import Handler.Exam.Users as Handler.Exam import Handler.Exam.AddUser as Handler.Exam import Handler.Exam.AutoOccurrence as Handler.Exam +import Handler.Exam.Correct as Handler.Exam diff --git a/src/Handler/Exam/Correct.hs b/src/Handler/Exam/Correct.hs new file mode 100644 index 000000000..e9a7bd692 --- /dev/null +++ b/src/Handler/Exam/Correct.hs @@ -0,0 +1,40 @@ +module Handler.Exam.Correct + ( getECorrectR, postECorrectR + ) where + +import Import + +data CorrectInterfaceResponse + = CorrectInterfaceSuccess + { ciUserIdent :: CryptoUUIDUser + , ciUserDisplayName :: Text + , ciUserMatrikelnummer :: Maybe Text + , ciResults :: Map ExamPartNumber (Maybe Points) + } + | CorrectInterfaceFailure + { ciIcon :: Icon + , ciMessage :: Text + } +deriveJSON defaultOptions + { constructorTagModifier = camelToPathPiece' 2 + , fieldLabelModifier = camelToPathPiece' 1 + , sumEncoding = TaggedObject "status" "result" + } ''CorrectorInterfaceResponse +-- E.g.: { "status": "success", "user-ident": "Max Musterstudent", "user-matrikelnummer": "123", "results": { "1a": null, "2a": 7, "2c3.5": 12 } } + +data CorrectInterfaceRequest + = CorrectInterfaceRequest + { cirName :: Text + , cirResults :: Map ExamPartNumber (Maybe Points) + } +deriveJSON defaultOptions + { fieldLabelModifier = camelToPathPiece' 1 + } ''CorrectorInterfaceRequest +-- E.g.: { "name": "max", "results": { "1a": null, "2c3.5": 9001.2 }} + + +getECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html +getECorrectR = error "ECorrectR not implemented" + +postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Value +postECorrectR = error "ECorrectR not implemented" -- use returnJson & requireCheckJsonBody diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 5b8cc8723..a084c209f 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -147,7 +147,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do miLayout' :: MassInputLayout ListLength (Either UserEmail UserId) () miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/examCorrectors/layout") - fmap Set.fromList <$> massInputAccumW miAdd' miCell' miButtonAction' miLayout' ("correctors" :: Text) (fslI MsgExamCorrectors & setTooltip MsgMassInputTip) False (Set.toList <$> mPrev) + fmap Set.fromList <$> massInputAccumW miAdd' miCell' miButtonAction' miLayout' ("correctors" :: Text) (fslI MsgExamCorrectors & setTooltip (UniWorXMessages [MsgExamCorrectorsTip, MsgMassInputTip]) False (Set.toList <$> mPrev) examOccurrenceForm :: Maybe (Set ExamOccurrenceForm) -> AForm Handler (Set ExamOccurrenceForm) examOccurrenceForm prev = wFormToAForm $ do