feat(submissions): non-anonymized correction

Fixes #524 Fixes #292
2020-04-17 15:19:26 +02:00 · 2020-04-17 15:19:26 +02:00 · fd2c2881ea
commit fd2c2881ea
parent e704b23a53
19 changed files with 135 additions and 86 deletions
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@ -324,6 +324,8 @@ SheetSolutionFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren könn
 SheetMarkingTip: Hinweise zur Korrektur, sichtbar nur für Korrektoren
 SheetPseudonym: Persönliches Abgabe-Pseudonym
 SheetGeneratePseudonym: Generieren
+SheetAnonymousCorrection: Anonymisierte Korrektur
+SheetAnonymousCorrectionTip: Wenn die Korrektur anonymisiert erfolgt, können Korrektoren die ihnen zugeteilten Abgaben nicht bestimmten Studierenden zuordnen (Name & Matrikelnummer der Abgebenden werden versteckt) 

 SheetFormType: Wertung & Abgabe
 SheetFormTimes: Zeiten
@ -565,6 +567,8 @@ DBTablePagesize: Einträge pro Seite
 DBTablePagesizeAll: Alle

 CorrDownload: Herunterladen
+CorrDownloadAnonymous: Anonymisiert
+CorrDownloadAnonymousTip: Wenn Abgaben nicht-anonymisiert heruntergeladen werden, werden an die Verzeichnisnamen der einzelnen Abgaben die Nachnamen der Abgeber angehängt, sofern erlaubt 
 CorrUploadField: Korrekturen
 CorrUpload: Korrekturen hochladen
 CorrSetCorrector: Korrektor zuweisen
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@ -323,6 +323,8 @@ SheetSolutionFromTip: Always invisible for participants if left empty; corrector
 SheetMarkingTip: Instructions for correction, visible only to correctors
 SheetPseudonym: Personal pseudonym
 SheetGeneratePseudonym: Generate
+SheetAnonymousCorrection: Anonymized correction
+SheetAnonymousCorrectionTip: If correction is anonymized, correctors cannot see which students are involved in submissions that are assigned to them (names & matriculation numbers are hidden)

 SheetFormType: Valuation & submission
 SheetFormTimes: Times
@ -563,6 +565,8 @@ DBTablePagesize: Entries per page
 DBTablePagesizeAll: All

 CorrDownload: Download
+CorrDownloadAnonymous: Anonymized
+CorrDownloadAnonymousTip: If submissions are downloaded non-anonymized the surnames of the submittors are appended to the name of the dirctory for each submission where permitted
 CorrUploadField: Corrections
 CorrUpload: Upload corrections
 CorrSetCorrector: Assign corrector
--- a/models/sheets.model
+++ b/models/sheets.model
@ -12,6 +12,7 @@ Sheet   -- exercise sheet for a given course
    solutionFrom    UTCTime Maybe    -- Solution is made available
    submissionMode  SubmissionMode   -- Submission upload by students and/or through tutors?
    autoDistribute  Bool default=false  -- Should correctors be assigned submissions automagically?
+    anonymousCorrection Bool default=true
    CourseSheet course name
    deriving Generic
 SheetEdit                     -- who edited when a row in table "Course", kept indefinitely
--- a/package.yaml
+++ b/package.yaml
@ -141,6 +141,7 @@ dependencies:
  - wai-middleware-prometheus
  - extended-reals
  - rfc5051
+  - unidecode
  - pandoc

 other-extensions:
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@ -2009,13 +2009,13 @@ getSystemMessageState smId = liftHandler $ do
  where
    getSystemMessageStateRequest =
          (lookupRegisteredCookiesJson id CookieSystemMessageState :: Handler (MergeHashMap CryptoUUIDSystemMessage UserSystemMessageState))
-      >>= ifoldMapM (\(cID :: CryptoUUIDSystemMessage) v -> MergeHashMap <$> (HashMap.singleton <$> decrypt cID <*> pure v))
+      >>= ifoldMapM (\(cID :: CryptoUUIDSystemMessage) v -> MergeHashMap <$> (maybeT (return mempty) . catchMPlus (Proxy @CryptoIDError) $ HashMap.singleton <$> decrypt cID <*> pure v))
    getDBSystemMessageState uid = runDB . runConduit $ selectSource [ SystemMessageHiddenUser ==. uid ] [] .| C.foldMap foldSt
      where foldSt (Entity _ SystemMessageHidden{..})
              = MergeHashMap . HashMap.singleton systemMessageHiddenMessage $ mempty { userSystemMessageHidden = Just systemMessageHiddenTime }

 applySystemMessages :: (MonadHandler m, HandlerSite m ~ UniWorX) => m ()
-applySystemMessages = liftHandler . maybeT_ $ do
+applySystemMessages = liftHandler . maybeT_ . catchMPlus (Proxy @CryptoIDError) $ do
  lift $ maybeAuthId >>= traverse_ syncSystemMessageHidden
  
  cRoute <- lift getCurrentRoute
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@ -67,7 +67,7 @@ import qualified Data.Conduit.List as C

 type CorrectionTableExpr  = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
 type CorrectionTableWhere = CorrectionTableExpr -> E.SqlExpr (E.Value Bool)
-type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym), CryptoFileNameSubmission)
+type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym), CryptoFileNameSubmission, Bool {- Access to non-anonymous submission data -})

 correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v
 correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
@ -119,7 +119,7 @@ colSchool = sortable (Just "school") (i18nCell MsgCourseSchool)

 colCourse :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colCourse = sortable (Just "course") (i18nCell MsgCourse)
-        $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid),_ , _, _, _) } -> courseCellCL (tid,sid,csh)
+        $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid),_ , _, _, _, _) } -> courseCellCL (tid,sid,csh)

 colSheet :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \row ->
@ -133,12 +133,12 @@ colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \row ->

 colCorrector :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
-  DBRow{ dbrOutput = (_, _, _, Nothing  , _, _, _) } -> cell mempty
-  DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _, _, _) } -> userCell userDisplayName userSurname
+  DBRow{ dbrOutput = (_, _, _, Nothing  , _, _, _, _) } -> cell mempty
+  DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _, _, _, _) } -> userCell userDisplayName userSurname

 colSubmissionLink :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colSubmissionLink = sortable (Just "submission") (i18nCell MsgSubmission)
-        $ \DBRow{ dbrOutput=(_, sheet, course, _, _,_, cid) } ->
+        $ \DBRow{ dbrOutput=(_, sheet, course, _, _,_, cid, _) } ->
          let csh = course ^. _2
              tid = course ^. _3
              ssh = course ^. _4
@ -146,27 +146,30 @@ colSubmissionLink = sortable (Just "submission") (i18nCell MsgSubmission)
          in anchorCellC $cacheIdentHere (CSubmissionR tid ssh csh shn cid SubShowR) (toPathPiece cid)

 colSelect :: forall act h. (Semigroup act, Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary))
-colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(_, _, _, _, _, _, cid) } -> return cid
+colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(_, _, _, _, _, _, cid, _) } -> return cid

 colSubmittors :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, _, users, _) } -> let
-  csh = course ^. _2
-  tid = course ^. _3
-  ssh = course ^. _4
-  link cid = CourseR tid ssh csh $ CUserR cid
-  protoCell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo)) ->
-    anchorCellCM $cacheIdentHere (link <$> encrypt userId) $ case mPseudo of
-      Nothing -> nameWidget userDisplayName userSurname
-      Just p  -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review _PseudonymText p})|]
-  in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, course, _, _, users, _, hasAccess) } ->
+  let
+    csh = course ^. _2
+    tid = course ^. _3
+    ssh = course ^. _4
+    link cid = CourseR tid ssh csh $ CUserR cid
+    protoCell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo)) ->
+      anchorCellCM $cacheIdentHere (link <$> encrypt userId) $ case mPseudo of
+        Nothing -> nameWidget userDisplayName userSurname
+        Just p  -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review _PseudonymText p})|]
+  in if | hasAccess -> protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+        | otherwise -> mempty

 colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, _, users, _) } -> let
-  protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellCM $cacheIdentHere (AdminUserR <$> encrypt userId) (fromMaybe mempty userMatrikelnummer)
-  in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+colSMatrikel = sortable (Just "submittors-matriculation") (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, (_, csh, tid, ssh), _, _, users, _, hasAccess) } ->
+  let protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellCM $cacheIdentHere (CourseR tid ssh csh . CUserR <$> encrypt userId) (fromMaybe mempty userMatrikelnummer)
+  in if | hasAccess -> protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+        | otherwise -> mempty

 colRating :: forall m a. IsDBTable m (a, SheetTypeSummary) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary))
-colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _, _) } ->
+colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _, _, _) } ->
  let csh = course ^. _2
      tid = course ^. _3
      ssh = course ^. _4
@ -186,43 +189,43 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E
     ]

 colAssigned :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _, _) } ->
+colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _, _, _) } ->
  maybe mempty dateTimeCell submissionRatingAssigned

 colRated :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _, _) } ->
+colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _, _, _) } ->
  maybe mempty dateTimeCell submissionRatingTime

 colPseudonyms :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, _, users, _) } -> let
+colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, _, users, _, _) } -> let
    lCell = listCell (catMaybes $ snd . snd <$> Map.toList users) $ \pseudo ->
      cell [whamlet|#{review _PseudonymText pseudo}|]
  in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]

 colRatedField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (Bool, a, b) CorrectionTableData)))
 colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell id
-  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _) } -> return subId)
-  (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done))
+  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId)
+  (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done))

 colPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData)))
 colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell id
-  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _) } -> return subId)
-  (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _, _) } mkUnique -> case sheetType of
+  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId)
+  (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _, _, _) } mkUnique -> case sheetType of
      NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty)
      _other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) (fsUniq mkUnique "points") (Just submissionRatingPoints)
  )

 colMaxPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData)))
-colMaxPointsField = sortable (Just "sheet-type") (i18nCell MsgSheetType) $ i18nCell . (\DBRow{ dbrOutput=(_, Entity _ Sheet{sheetType}, _, _, _, _, _) } -> sheetType)
+colMaxPointsField = sortable (Just "sheet-type") (i18nCell MsgSheetType) $ i18nCell . (\DBRow{ dbrOutput=(_, Entity _ Sheet{sheetType}, _, _, _, _, _, _) } -> sheetType)

 colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData)))
 colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ fmap (cellAttrs <>~ [("style","width:60%")]) $ formCell id
-  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _) } -> return subId)
-  (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))
+  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId)
+  (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))

 colLastEdit :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colLastEdit = sortable (Just "last-edit") (i18nCell MsgLastEdit) $
-   \DBRow{ dbrOutput=(_, _, _, _, mbLastEdit, _, _) } -> maybe mempty dateTimeCell mbLastEdit
+   \DBRow{ dbrOutput=(_, _, _, _, mbLastEdit, _, _, _) } -> maybe mempty dateTimeCell mbLastEdit


 makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
@ -239,7 +242,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
            in (submission, sheet, crse, corrector, lastEditQuery submission)
          )
      dbtProj :: DBRow _ -> DB CorrectionTableData
-      dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector,  E.Value mbLastEdit) -> do
+      dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId Sheet{..}), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector,  E.Value mbLastEdit) -> do
        submittors <- E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do
          E.on $ pseudonym E.?. SheetPseudonymUser E.==. E.just (user E.^. UserId)
           E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
@ -249,8 +252,11 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
          return (user, pseudonym E.?. SheetPseudonymPseudonym)
        let
          submittorMap = List.foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
+        nonAnonymousAccess <- or2M
+          (return $ not sheetAnonymousCorrection)
+          (hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR)
        cid <- encrypt sId
-        return (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap, cid)
+        return (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap, cid, nonAnonymousAccess)
  dbTable psValidator DBTable
    { dbtSQLQuery
    , dbtRowKey = \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) -> submission E.^. SubmissionId
@ -292,13 +298,10 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingAssigned
        )
      , ( "submittors"
-        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) ->
-            E.subSelectUnsafe . E.from $ \(submissionUser `E.InnerJoin` user) -> do
-              E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
-              E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
-              E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
-              E.limit 1
-              return (user E.^. UserSurname)
+        , SortProjected . comparing $ \DBRow{ dbrOutput = (_, Entity _ Sheet{..}, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap ((userSurname &&& userDisplayName) . view _1) $ Map.elems submittors
+        )
+      , ( "submittors-matriculation"
+        , SortProjected . comparing $ \DBRow{ dbrOutput = (_, Entity _ Sheet{..}, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap (view $ _1 . _userMatrikelnummer) $ Map.elems submittors
        )
      , ( "comment" -- sorting by comment specifically requested by correctors to easily see submissions to be done
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingComment
@ -421,7 +424,7 @@ instance Finite ActionCorrections
 nullaryPathPiece ''ActionCorrections $ camelToPathPiece' 1
 embedRenderMessage ''UniWorX ''ActionCorrections id

-data ActionCorrectionsData = CorrDownloadData
+data ActionCorrectionsData = CorrDownloadData Bool {- Not anonymized? -}
                           | CorrSetCorrectorData (Maybe UserId)
                           | CorrAutoSetCorrectorData SheetId
                           | CorrDeleteData
@ -470,10 +473,10 @@ correctionsR' whereClause displayColumns dbtFilterUI psValidator actions = do
      auditAllSubEdit = mapM_ $ \sId -> getJust sId >>= \sub -> audit $ TransactionSubmissionEdit sId $ sub ^. _submissionSheet

  formResult actionRes $ \case
-    (CorrDownloadData, subs) -> do
+    (CorrDownloadData nonAnonymous, subs) -> do
      ids <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable
      addHeader "Content-Disposition" [st|attachment; filename="corrections.zip"|]
-      sendResponse =<< submissionMultiArchive ids
+      sendResponse =<< submissionMultiArchive nonAnonymous ids
    (CorrSetCorrectorData (Just uid), subs') -> do
      subs <- mapM decrypt $ Set.toList subs'
      now <- liftIO getCurrentTime
@ -583,7 +586,7 @@ type ActionCorrections' = (ActionCorrections, AForm (HandlerFor UniWorX) ActionC

 downloadAction, deleteAction :: ActionCorrections'
 downloadAction = ( CorrDownload
-                 , pure CorrDownloadData
+                 , CorrDownloadData <$> apopt (convertField not not checkBoxField) (fslI MsgCorrDownloadAnonymous & setTooltip MsgCorrDownloadAnonymousTip) (Just False)
                 )
 deleteAction = ( CorrDelete
               , pure CorrDeleteData
@ -625,6 +628,8 @@ postCorrectionsR = do
        , colTerm
        , colCourse
        , colSheet
+        , colSMatrikel
+        , colSubmittors
        , colPseudonyms
        , colSubmissionLink
        , colAssigned
@ -1045,6 +1050,8 @@ postCorrectionsGradeR = do
        , colTerm
        , colCourse
        , colSheet
+        , colSMatrikel
+        , colSubmittors
        , colPseudonyms
        , colSubmissionLink
        , colRated
@ -1074,7 +1081,7 @@ postCorrectionsGradeR = do
        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
      psValidator = def
        & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData))
-      unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
+      unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)

  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI psValidator $ def
    { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@ -66,6 +66,7 @@ data SheetForm = SheetForm
      , sfSubmissionMode :: SubmissionMode
      , sfAutoDistribute :: Bool
      , sfMarkingText  :: Maybe Html
+      , sfAnonymousCorrection :: Bool
      , sfCorrectors   :: Loads
      -- Keine SheetId im Formular!
      }
@ -126,6 +127,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
      <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
      <*> aopt htmlField    (fslI MsgSheetMarking) (sfMarkingText <$> template)
+      <*> apopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template)
      <*> correctorForm (fromMaybe mempty $ sfCorrectors <$> template)
    return $ case result of
      FormSuccess sheetResult
@ -534,6 +536,7 @@ getSheetNewR tid ssh csh = do
            , sfMarkingText    = sheetMarkingText
            , sfAutoDistribute = sheetAutoDistribute
            , sfCorrectors     = loads
+            , sfAnonymousCorrection = sheetAnonymousCorrection
            }
        _other -> Nothing
  let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
@ -570,6 +573,7 @@ getSEditR tid ssh csh shn = do
        , sfMarkingF       = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetMarking
        , sfMarkingText    = sheetMarkingText
        , sfAutoDistribute = sheetAutoDistribute
+        , sfAnonymousCorrection = sheetAnonymousCorrection
        , sfCorrectors     = currentLoads
        }

@ -603,6 +607,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
              , sheetSolutionFrom   = sfSolutionFrom
              , sheetSubmissionMode = sfSubmissionMode
              , sheetAutoDistribute = sfAutoDistribute
+              , sheetAnonymousCorrection = sfAnonymousCorrection
              }
        mbsid <- dbAction newSheet
        case mbsid of
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@ -684,7 +684,7 @@ getCorrectionsDownloadR = do -- download all assigned and open submissions
  when (null subs) $ do
    addMessageI Info MsgNoOpenSubmissions
    redirect CorrectionsR
-  submissionMultiArchive $ Set.fromList subs
+  submissionMultiArchive True $ Set.fromList subs -- not anonymized, where permissable


 getSubAssignR, postSubAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@ -48,6 +48,10 @@ import qualified Control.Monad.Catch as E (Handler(..))

 import qualified Data.CaseInsensitive as CI

+import Text.Unidecode (unidecode)
+import Data.Char (isAlphaNum)
+
+
 data AssignSubmissionException = NoCorrectors
                               | NoCorrectorsByProportion
                               | SubmissionsNotFound (NonNull (Set SubmissionId))
@ -256,14 +260,18 @@ submissionFileSource = E.selectSource . fmap snd . E.from . submissionFileQuery
 submissionFileQuery :: SubmissionId -> E.SqlExpr (Entity SubmissionFile) `E.InnerJoin` E.SqlExpr (Entity File)
                        -> E.SqlQuery (E.SqlExpr (Entity SubmissionFile), E.SqlExpr (Entity File))
 submissionFileQuery submissionID (sf `E.InnerJoin` f) = E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
-  E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
+  E.on $ f E.^. FileId E.==. sf E.^. SubmissionFileFile
  E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
-  E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion -- TODO@gk: won't work as intended! Fix with refactor
+  E.where_ . E.not_ . E.exists . E.from $ \(sf' `E.InnerJoin` f') -> do
+    E.on $ f' E.^. FileId E.==. sf' E.^. SubmissionFileFile
+    E.where_ $ sf' E.^. SubmissionFileIsDeletion
+         E.&&. sf' E.^. SubmissionFileSubmission E.==. sf E.^. SubmissionFileSubmission
+         E.&&. f' E.^. FileTitle E.==. f E.^. FileTitle
  E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]  -- E.desc returns corrector updated data first
  return (sf, f)

-submissionMultiArchive :: Set SubmissionId -> Handler TypedContent
-submissionMultiArchive (Set.toList -> ids) = do
+submissionMultiArchive :: Bool -> Set SubmissionId -> Handler TypedContent
+submissionMultiArchive notAnonymized (Set.toList -> ids) = do
  (dbrunner, cleanup) <- getDBRunner

  ratedSubmissions <- runDBRunner dbrunner $ do
@ -271,26 +279,41 @@ submissionMultiArchive (Set.toList -> ids) = do
      E.on $ sheet E.^. SheetId     E.==. submission E.^. SubmissionSheet
      E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
      E.where_ $ submission E.^. SubmissionId `E.in_` E.valList ids
-      return (submission, (sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseSchool, course E.^. CourseTerm))
+      return (submission, (sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseSchool, course E.^. CourseTerm, sheet E.^. SheetAnonymousCorrection))

    forM submissions $ \(s@(Entity submissionId _), courseSheetInfo) ->
-       maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s, $(E.unValueN 4) courseSheetInfo)) =<< getRating submissionId
+       maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s, $(E.unValueN 5) courseSheetInfo)) =<< getRating submissionId
  let (setSheet,setCourse,setSchool,setTerm) =
-        execWriter . forM ratedSubmissions $ \(_rating,_submission,(shn,csh,ssh,tid)) ->
+        execWriter . forM ratedSubmissions $ \(_rating,_submission,(shn,csh,ssh,tid,_anon)) ->
          tell (Set.singleton shn, Set.singleton csh, Set.singleton ssh, Set.singleton tid)

  archiveName <- ap getMessageRender $ pure MsgSubmissionArchiveName
  setContentDisposition' $ Just ((addExtension `on` unpack) archiveName extensionZip)
  (<* cleanup) . respondSource typeZip . transPipe (runDBRunner dbrunner) $ do
    let
-      fileEntitySource' :: (Rating, Entity Submission, (SheetName,CourseShorthand,SchoolId,TermId)) -> ConduitT () File (YesodDB UniWorX) ()
-      fileEntitySource' (rating, Entity submissionID Submission{..},(shn,csh,ssh,tid)) = do
+      fileEntitySource' :: (Rating, Entity Submission, (SheetName,CourseShorthand,SchoolId,TermId,Bool)) -> ConduitT () File (YesodDB UniWorX) ()
+      fileEntitySource' (rating, Entity submissionID Submission{..},(shn,csh,ssh,tid,sheetAnonymous)) = do
        cID <- encrypt submissionID

        let
          dirFrag :: PathPiece p => p -> FilePath
          dirFrag = Text.unpack . toPathPiece
-          submissionDirectory  = dirFrag (cID :: CryptoFileNameSubmission)
+
+          withNames fp = do
+            surnames <- lift . E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> do
+              E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
+              E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val submissionID
+              return $ user E.^. UserSurname
+            let asciiNames = sort $ map (filter isAlphaNum . foldMap unidecode . unpack . E.unValue) surnames
+            return . intercalate "_" $ fp : asciiNames
+
+        notAnonymized' <- and2M
+          (return notAnonymized)
+          (or2M (return $ not sheetAnonymous) (hasReadAccessTo $ CourseR tid ssh csh CCorrectionsR))
+
+        submissionDirectory <- bool return withNames notAnonymized' $ dirFrag (cID :: CryptoFileNameSubmission)
+
+        let
          directoryName
            | Set.size setTerm   > 1 = dirFrag tid </> dirFrag ssh </> dirFrag csh </> dirFrag shn </> submissionDirectory
            | Set.size setSchool > 1 =                 dirFrag ssh </> dirFrag csh </> dirFrag shn </> submissionDirectory
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@ -38,7 +38,7 @@ module Handler.Utils.Table.Pagination
  , maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM'
  , anchorCellC, anchorCellCM, anchorCellCM', linkEitherCellCM', maybeLinkEitherCellCM'
  , cellTooltip
-  , listCell
+  , listCell, listCell'
  , formCell, DBFormResult(..), getDBFormResult
  , dbSelect
  , (&)
@ -1527,7 +1527,11 @@ maybeLinkEitherCellCM' mCache xM x2route (x2widgetAuth,x2widgetUnauth) = cell $


 listCell :: (IsDBTable m a, Traversable f) => f r' -> (r' -> DBCell m a) -> DBCell m a
-listCell xs mkCell = review dbCell . ([], ) $ do
+listCell = listCell' . return
+  
+listCell' :: (IsDBTable m a, Traversable f) => WriterT a m (f r') -> (r' -> DBCell m a) -> DBCell m a
+listCell' mkXS mkCell = review dbCell . ([], ) $ do
+  xs <- mkXS
  cells <- forM xs $
    \(view dbCell . mkCell -> (attrs, mkWidget)) -> (attrs, ) <$> mkWidget
  return $(widgetFile "table/cell/list")
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -664,7 +664,7 @@ assertM_ f x = guard . f =<< x
 assertM' :: Alternative m => (a -> Bool) -> a -> m a
 assertM' f x = x <$ guard (f x)

-guardOn :: Alternative m => Bool -> a -> m a
+guardOn :: forall m a. Alternative m => Bool -> a -> m a
 guardOn b x = x <$ guard b

 guardOnM :: Alternative m => Bool -> m a -> m a
--- a/src/Utils/Tooltip.hs
+++ b/src/Utils/Tooltip.hs
@ -1,6 +0,0 @@
-module Utils.Tooltip where
-
-import ClassyPrelude.Yesod hiding (Proxy)
-
-textTooltip :: forall site. WidgetFor site () -> WidgetFor site () -> WidgetFor site ()
-textTooltip ttHandle ttContent = $(whamletFile "templates/widgets/text-tooltip.hamlet")
--- a/stack.yaml
+++ b/stack.yaml
@ -102,5 +102,7 @@ extra-deps:

  - acid-state-0.16.0

+  - unidecode-0.1.0.4
+
 resolver: lts-15.0
 allow-newer: true
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@ -274,6 +274,13 @@ packages:
      sha256: c6e4b7f00d2a500e6286beafe3a2da7ba898a9ea31f5744df57cdce8a8f5890f
  original:
    hackage: acid-state-0.16.0
+- completed:
+    hackage: unidecode-0.1.0.4@sha256:99581ee1ea334a4596a09ae3642e007808457c66893b587e965b31f15cbf8c4d,1144
+    pantry-tree:
+      size: 492
+      sha256: 4959068a0caf410dd4b8046f0b0138e3cf6471abb0cc865c9993db3b2930d283
+  original:
+    hackage: unidecode-0.1.0.4
 snapshots:
 - completed:
    size: 488576
--- a/templates/allocation/show.hamlet
+++ b/templates/allocation/show.hamlet
@ -47,25 +47,16 @@ $newline never
      <dt .deflist__dt>
        $maybe _ <- allocationRegisterByStaffTo
          _{MsgAllocationRegisterByStaff}
-          <span .tooltip>
-            <span .tooltip__handle>
-            <span .tooltip__content>
-                _{MsgAllocationRegisterByStaffTip}
+          ^{iconTooltip (i18n MsgAllocationRegisterByStaffTip) Nothing True}
        $nothing
          _{MsgAllocationRegisterByStaffFrom}
-          <span .tooltip>
-            <span .tooltip__handle>
-            <span .tooltip__content>
-                _{MsgAllocationRegisterByStaffFromTip}
+          ^{iconTooltip (i18n MsgAllocationRegisterByStaffFromTip) Nothing True}
      <dd .deflist__dd>
        ^{formatTimeRangeW SelFormatDateTime fromT allocationRegisterByStaffTo}
    $maybe fromT <- allocationRegisterByCourse
      <dt .deflist__dt>
        _{MsgAllocationRegisterByCourseFrom}
-        <span .tooltip>
-          <span .tooltip__handle>
-          <span .tooltip__content>
-            _{MsgAllocationRegisterByCourseFromTip}
+        ^{iconTooltip (i18n MsgAllocationRegisterByCourseFromTip) Nothing True}
      <dd .deflist__dd>
        ^{formatTimeW SelFormatDateTime fromT}
    $maybe toT <- allocationOverrideDeregister
--- a/templates/i18n/changelog/de-de-formal.hamlet
+++ b/templates/i18n/changelog/de-de-formal.hamlet
@ -6,6 +6,8 @@ $newline never
    <ul>
      <li>
        Anzeige von Abgaben, Tutorien und Klausuren auf der Seite für einzelne Kursteilnehmer
+      <li>
+        Nicht-anonymisierte Korrektur von Übungsblatt-Abgaben

  <dt .deflist__dt>
    ^{formatGregorianW 2020 04 15}
--- a/templates/i18n/changelog/en-eu.hamlet
+++ b/templates/i18n/changelog/en-eu.hamlet
@ -6,6 +6,8 @@ $newline never
    <ul>
      <li>
        Submissions, tutorials, and exams are now shown on the detail page for course participants
+      <li>
+        Non-anonymized correction of sheet submissions

  <dt .deflist__dt>
    ^{formatGregorianW 2020 04 15}
--- a/templates/widgets/text-tooltip.hamlet
+++ b/templates/widgets/text-tooltip.hamlet
@ -1,6 +0,0 @@
-$newline never
-<span .tooltip>
-  <span>
-    ^{ttHandle}
-  <span .tooltip__content>
-    ^{ttContent}
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@ -209,7 +209,7 @@ fillDb = do
    , userEmail  = "tester@campus.lmu.de"
    , userDisplayEmail = "tina@tester.example"
    , userDisplayName = "Tina Tester"
-    , userSurname = "von Terror"
+    , userSurname = "vön Tërrör¿"
    , userFirstName = "Sabrina"
    , userTitle = Just "Magister"
    , userMaxFavourites = 5
@ -570,6 +570,7 @@ fillDb = do
    , sheetHintFrom = Nothing
    , sheetSolutionFrom = Nothing
    , sheetAutoDistribute = False
+    , sheetAnonymousCorrection = True
    }
  insert_ $ SheetEdit gkleen now adhoc
  feste <- insert Sheet
@ -586,6 +587,7 @@ fillDb = do
    , sheetHintFrom = Nothing
    , sheetSolutionFrom = Nothing
    , sheetAutoDistribute = False
+    , sheetAnonymousCorrection = True
    }
  insert_ $ SheetEdit gkleen now feste
  keine <- insert Sheet
@ -602,6 +604,7 @@ fillDb = do
    , sheetHintFrom = Nothing
    , sheetSolutionFrom = Nothing
    , sheetAutoDistribute = False
+    , sheetAnonymousCorrection = True
    }
  insert_ $ SheetEdit gkleen now keine
  void . insertMany $ map (\(u,sf) -> CourseParticipant ffp u now sf Nothing)
@ -747,6 +750,7 @@ fillDb = do
    , sheetHintFrom = Nothing
    , sheetSolutionFrom = Nothing
    , sheetAutoDistribute = True
+    , sheetAnonymousCorrection = False
    }
  void . insert $ SheetEdit jost now sh1
  forM_ [fhamann, maxMuster, tinaTester] $ \u -> do
@ -797,6 +801,7 @@ fillDb = do
    , sheetHintFrom = Nothing
    , sheetSolutionFrom = Nothing
    , sheetAutoDistribute = True
+    , sheetAnonymousCorrection = False
    }
  void . insert $ SheetEdit jost now sh2
  sh3 <- insert Sheet
@ -813,6 +818,7 @@ fillDb = do
    , sheetHintFrom = Nothing
    , sheetSolutionFrom = Nothing
    , sheetAutoDistribute = True
+    , sheetAnonymousCorrection = True
    }
  void . insert $ SheetEdit jost now sh3
  sh4 <- insert Sheet
@ -829,6 +835,7 @@ fillDb = do
    , sheetHintFrom = Nothing
    , sheetSolutionFrom = Nothing
    , sheetAutoDistribute = True
+    , sheetAnonymousCorrection = True
    }
  void . insert $ SheetEdit jost now sh4
  tut1 <- insert Tutorial
@ -1025,6 +1032,7 @@ fillDb = do
      , sheetHintFrom = Nothing
      , sheetSolutionFrom = Nothing
      , sheetAutoDistribute = False
+      , sheetAnonymousCorrection = True
      }
    manyUsers' <- shuffleM $ take 1024 manyUsers
    groupSizes <- getRandomRs (1, 3)