Single submission assign corrector

.vscode/tasks.json

@@ -28,7 +28,8 @@
         "focus": false,
         "panel": "dedicated",
         "showReuseMessage": false
-      }      
+      },
+      "problemMatcher": []
     },
     {
       "label": "test",

messages/uniworx/de.msg

@@ -142,6 +142,8 @@ SubmissionGroupName: Gruppenname
 CorrectionsTitle: Zugewiesene Korrekturen
 CourseCorrectionsTitle: Korrekturen für diesen Kurs
 CorrectorsHead sheetName@SheetName: Korrektoren für #{sheetName}
+CorrectorAssignTitle: Korrektor zuweisen
+
 
 Unauthorized: Sie haben hierfür keine explizite Berechtigung.
 UnauthorizedAnd l@Text r@Text: (#{l} UND #{r})
@@ -189,6 +191,7 @@ CorByProportionExcludingTutorial proportion@Rational: #{display proportion} Ante
 
 DeleteRow: Zeile entfernen
 ProportionNegative: Anteile dürfen nicht negativ sein
+CorrectorUpdated: Korrektor erfolgreich aktualisiert
 CorrectorsUpdated: Korrektoren erfolgreich aktualisiert
 CorrectorsPlaceholder: Korrektoren...
 CorrectorsDefaulted: Korrektoren-Liste wurde aus bisherigen Übungsblättern diesen Kurses generiert. Es sind keine Daten gespeichert.
@@ -484,6 +487,7 @@ ErrMsgCouldNotDecodeNonce: Konnte secretbox-nonce nicht dekodieren
 ErrMsgCouldNotOpenSecretbox: Konnte libsodium-secretbox nicht öffnen (Verschlüsselte Daten sind nicht authentisch)
 ErrMsgCouldNotDecodePlaintext utf8Err@Text: Konnte Klartext nicht UTF8-dekodieren: #{utf8Err}
 ErrMsgHeading: Fehlermeldung entschlüsseln
+ErrorCryptoIdMismatch: Verschlüsselte Id der Abgabe passte nicht zu anderen Daten
 
 InvalidRoute: Konnte URL nicht interpretieren
 

models

@@ -15,7 +15,7 @@ User json
     notificationSettings NotificationSettings
     UniqueAuthentication ident
     UniqueEmail email
-    deriving Show
+    deriving Show Eq
 UserAdmin
     user   UserId
     school SchoolId

routes

@@ -79,6 +79,7 @@
     /sub/#CryptoFileNameSubmission SubmissionR !correctorANDisRead:
       /                           SubShowR                   GET POST !ownerANDtime !ownerANDisRead
       /archive/#{ZIPArchiveName SubmissionFileType} SubArchiveR                GET      !owner
+      /assign                   SAssignR      GET POST	      !lecturerANDtime
       /correction                 CorrectionR                GET POST !corrector !ownerANDisReadANDrated
       !/#SubmissionFileType/*FilePath SubDownloadR           GET      !owner
     /correctors                 SCorrR        GET POST

src/Foundation.hs

@@ -432,12 +432,13 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
         guard visible
 
         case subRoute of
-          SFileR SheetExercise _ -> guard $ sheetActiveFrom <= cTime
-          SFileR SheetHint     _ -> guard $ maybe False (<= cTime) sheetHintFrom
-          SFileR SheetSolution _ -> guard $ maybe False (<= cTime) sheetSolutionFrom
-          SubmissionNewR         -> guard   active
-          SubmissionR _ _        -> guard   active
-          _                      -> return ()
+          SFileR SheetExercise _    -> guard $ sheetActiveFrom <= cTime
+          SFileR SheetHint     _    -> guard $ maybe False (<= cTime) sheetHintFrom
+          SFileR SheetSolution _    -> guard $ maybe False (<= cTime) sheetSolutionFrom
+          SubmissionNewR            -> guard   active
+          SubmissionR _ SAssignR    -> guard $ not active -- Correctors can only be assigned when the Sheet is inactive, since submissions are subject to change
+          SubmissionR _ _           -> guard   active
+          _                         -> return ()
 
         return Authorized
 
@@ -1226,6 +1227,14 @@ pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
+  , MenuItem
+      { menuItemType = PageActionPrime
+      , menuItemLabel = MsgCorrectorAssignTitle
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SAssignR
+      , menuItemModal = True
+      , menuItemAccessCallback' = return True
+      }
   ]
 pageActions (CSheetR tid ssh csh shn SCorrR) =
   [ MenuItem

src/Handler/Corrections.hs

@@ -83,11 +83,7 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm)
 
 colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
 colCourse = sortable (Just "course") (i18nCell MsgCourse)
-        $ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
-          let tid = course ^. _3
-              ssh = course ^. _4
-              csh = course ^. _2
-          in anchorCell (CourseR tid ssh csh CShowR) [whamlet|#{display csh}|]
+        $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid), _, _) } -> courseCellCL (tid,sid,csh)
 
 colSheet :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
 colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
@@ -306,6 +302,7 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
           alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission)
           addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
         let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
+
         unless (null unassigned) $ do
           num <- updateWhereCount [SubmissionId <-. Set.toList unassigned]
                     [ SubmissionRatingBy       =. Just uid
@@ -762,3 +759,43 @@ postCorrectionsGradeR = do
 
   defaultLayout $
     $(widgetFile "corrections-grade")
+
+
+getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
+getSAssignR = postSAssignR
+postSAssignR tid ssh csh shn cID = do
+  let actionUrl = CSubmissionR tid ssh csh shn cID SAssignR
+  sId <- decrypt cID
+  (currentCorrector, sheetCorrectors) <- runDB $ do
+    Submission{submissionRatingBy, submissionSheet} <- get404 sId
+    -- Beginn Verify that CryptoId matches ordinary prameters
+    -- Necessarry, since authorisation checks those parameters only, but can be changed by user!
+    Sheet{sheetCourse, sheetName} <- get404 submissionSheet
+    Course{courseTerm, courseSchool, courseShorthand} <- get404 sheetCourse
+    let cidMatches = and [tid==courseTerm, ssh==courseSchool, csh==courseShorthand, shn==sheetName]
+    unless cidMatches $ invalidArgsI [MsgErrorCryptoIdMismatch]
+    -- End Verification
+    sheetCorrectors <- map (sheetCorrectorUser . entityVal) <$> selectList [SheetCorrectorSheet ==. submissionSheet] []
+    userCorrector <- traverse getJustEntity submissionRatingBy
+    return (userCorrector, maybe id (:) submissionRatingBy sheetCorrectors)
+
+  $logDebugS "SAssignR" $ tshow currentCorrector
+  let correctorField  = selectField $ optionsPersistCryptoId [UserId <-. sheetCorrectors] [Asc UserSurname, Asc UserDisplayName] userDisplayName
+  ((corrResult, corrForm), corrEncoding) <- runFormPost . renderAForm FormStandard $
+        aopt correctorField (fslI MsgCorrector) (Just currentCorrector)
+    <*  submitButton
+  formResult corrResult $ \(fmap entityKey -> mbUserId) -> do
+    when (mbUserId /= fmap entityKey currentCorrector) . runDB $ do
+      now <- liftIO getCurrentTime
+      update sId  [ SubmissionRatingBy =. mbUserId
+                  , SubmissionRatingAssigned =. (now <$ mbUserId)
+                  ]
+      addMessageI Success MsgCorrectorUpdated
+    redirect actionUrl
+  defaultLayout $ do
+      setTitleI MsgCorrectorAssignTitle
+      $(widgetFile "submission-assign")
+
+
+
+

templates/formPage.hamlet

@@ -1,2 +1,2 @@
-<form .form-horizontal method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
+<form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
   ^{formWidget}

templates/formPageI18n.hamlet

@@ -1,5 +1,5 @@
 $maybe text <- formText
   <h3>
     _{text}
-<form .form-horizontal method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
+<form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
    ^{formWidget}

templates/submission-assign.hamlet

@@ -0,0 +1,2 @@
+<form method=post action=@{actionUrl} enctype=#{corrEncoding}>
+   ^{corrForm}