Introduce 'submissionRatingDone'

Resolves #129

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.

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

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
+          return $ maybe False submissionRatingDone sm
-            (Just (Submission { submissionRatingTime=Just _})) -> return True
-            _ -> return False
       }
   ]
 pageActions (CSheetR tid csh shn SCorrR) =

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
 

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