diff --git a/messages/de.msg b/messages/de.msg index de6d18014..c28db3a46 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -109,6 +109,7 @@ UnauthorizedParticipant: Sie sind nicht als Teilnehmer für diese Veranstaltung UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen. UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben. UnauthorizedSubmissionOwner: Sie sind an dieser Abgabe nicht beteiligt. +UnauthorizedSubmissionRated: Diese Abgabe ist noch nicht korrigiert. UnauthorizedSubmissionCorrector: Sie sind nicht der Korrektor für diese Abgabe. OnlyUploadOneFile: Bitte nur eine Datei hochladen. DeprecatedRoute: Diese Ansicht ist obsolet und könnte in Zukunft entfallen. diff --git a/routes b/routes index 27263ba9a..0adcb0bf7 100644 --- a/routes +++ b/routes @@ -67,7 +67,7 @@ /sub/#CryptoFileNameSubmission SubmissionR !correctorANDisRead: / SubShowR GET POST !ownerANDtime !ownerANDisRead /archive/#{ZIPArchiveName SubmissionFileType} SubArchiveR GET !owner - /correction CorrectionR GET POST !corrector !ownerANDisRead + /correction CorrectionR GET POST !corrector !ownerANDisReadANDrated !/#SubmissionFileType/*FilePath SubDownloadR GET !owner /correctors SCorrR GET POST !/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector diff --git a/src/Foundation.hs b/src/Foundation.hs index b76ad30f2..cb8ac4f42 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -389,6 +389,16 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req $logErrorS "AccessControl" $ "'!owner' used on route that doesn't support it: " <> tshow r unauthorizedI MsgUnauthorized ) + ,("rated", APDB $ \route _ -> case route of + CSubmissionR _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedSubmissionRated) $ do + sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID + sub <- MaybeT $ get sid + guard $ submissionRatingDone sub + return Authorized + r -> do + $logErrorS "AccessControl" $ "'!rated' used on route that doesn't support it: " <> tshow r + unauthorizedI MsgUnauthorized + ) ,("isRead", APHandler . const $ bool (return Authorized) (unauthorizedI MsgUnauthorizedWrite)) ,("isWrite", APHandler . const $ bool (unauthorizedI MsgUnauthorized) (return Authorized)) ] @@ -875,9 +885,7 @@ pageActions (CSubmissionR tid csh shn cid SubShowR) = , menuItemAccessCallback' = do smid <- decrypt cid sm <- runDB $ get smid - case sm of - (Just (Submission { submissionRatingTime=Just _})) -> return True - _ -> return False + return $ maybe False submissionRatingDone sm } ] pageActions (CSheetR tid csh shn SCorrR) = diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index a3bd66f5a..3c7c20024 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -371,7 +371,7 @@ postCorrectionR tid csh shn cid = do let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c)) ((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ (,) - <$> aopt pointsField (fslI MsgRatingPoints) (Just $ submissionRatingPoints) + <$> aopt pointsField (fslpI MsgRatingPoints "Punktezahl" & setTooltip "Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist") (Just $ submissionRatingPoints) <*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment)) <* submitButton diff --git a/src/Model.hs b/src/Model.hs index aef13b517..1feeab96e 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -7,6 +7,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RecordWildCards #-} module Model ( module Model , module Model.Types @@ -31,3 +32,6 @@ data PWEntry = PWEntry , pwHash :: Text } deriving (Show) $(deriveJSON defaultOptions ''PWEntry) + +submissionRatingDone :: Submission -> Bool +submissionRatingDone Submission{..} = isJust submissionRatingPoints