fix(submissions): maintain anonymity

messages/uniworx/categories/authorization/de-de-formal.msg

@@ -58,6 +58,7 @@ UnauthorizedSubmissionRated: Diese Abgabe ist noch nicht korrigiert.
 UnauthorizedSubmissionCorrector: Sie sind nicht Korrektor:in für diese Abgabe.
 UnauthorizedUserSubmission: Nutzer:innen dürfen für dieses Übungsblatt keine Abgaben erstellen.
 UnauthorizedCorrectorSubmission: Korrektor:innen dürfen für dieses Übungsblatt keine Abgaben erstellen.
+UnauthorizedCorrectionAnonymous: Korrektur ist nicht anonymisiert.
 DeprecatedRoute: Diese Ansicht ist obsolet und könnte in Zukunft entfallen.
 UnfreeMaterials: Die Materialien für diese Veranstaltung sind nicht allgemein freigegeben.
 UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung

messages/uniworx/categories/authorization/en-eu.msg

@@ -58,6 +58,7 @@ UnauthorizedSubmissionRated: This submission is not yet marked.
 UnauthorizedSubmissionCorrector: You are no corrector for this submission.
 UnauthorizedUserSubmission: Users may not directly submit for this exercise sheet.
 UnauthorizedCorrectorSubmission: Correctors may not create submissions for this exercise sheet.
+UnauthorizedCorrectionAnonymous: Correction is not anonymised.
 DeprecatedRoute: This view is deprecated and will be removed.
 UnfreeMaterials: Course material are not publicly accessable.
 UnauthorizedWrite: You do not have the write permission necessary to perform this action
@@ -128,4 +129,4 @@ InvalidCredentialsADPasswordMustChange: Password needs to be changed
 InvalidCredentialsADAccountLockedOut: Account disabled by intruder detection
 FormFieldRequiredTip: Required fields
 FormFieldWorkflowDatasetTip: At least one of the marked fields must be filled
-LoginTitle: Authentication
+LoginTitle: Authentication

messages/uniworx/categories/courses/submission/de-de-formal.msg

@@ -225,4 +225,6 @@ SubmissionAuthorshipStatementsTitle tid@TermId ssh@SchoolId csh@CourseShorthand
 
 SubmissionColumnAuthorshipStatementTime: Zeitstempel
 SubmissionColumnAuthorshipStatementWording: Wortlaut
-SubmissionFilterAuthorshipStatementCurrent: Aktueller Wortlaut
+SubmissionFilterAuthorshipStatementCurrent: Aktueller Wortlaut
+
+SubmissionNoUsers: Diese Abgabe hat keine assoziierten Benutzer!

messages/uniworx/categories/courses/submission/en-eu.msg

@@ -225,3 +225,5 @@ SubmissionAuthorshipStatementsTitle tid ssh csh shn cID: #{tid}-#{ssh}-#{csh} #{
 SubmissionColumnAuthorshipStatementTime: Timestamp
 SubmissionColumnAuthorshipStatementWording: Wording
 SubmissionFilterAuthorshipStatementCurrent: Current wording
+
+SubmissionNoUsers: This submission has no associated users!

messages/uniworx/categories/settings/auth_settings/de-de-formal.msg

@@ -42,6 +42,7 @@ AuthTagPersonalisedSheetFiles: Nutzer:in verfügt über personalisierte Übungsb
 AuthTagRated: Korrektur ist bewertet
 AuthTagUserSubmissions: Abgaben erfolgen durch Kursteilnehmer:innen
 AuthTagCorrectorSubmissions: Abgaben erfolgen durch Korrektor:innen
+AuthTagCorrectionAnonymous: Korrektur ist anonymisiert
 AuthTagSelf: Nutzer:in greift nur auf eigene Daten zu
 AuthTagIsLDAP: Nutzer:in meldet sich mit Campus-Kennung an
 AuthTagIsPWHash: Nutzer:in meldet sich mit Uni2work-Kennung an

messages/uniworx/categories/settings/auth_settings/en-eu.msg

@@ -42,6 +42,7 @@ AuthTagPersonalisedSheetFiles: User has been assigned personalised sheet files
 AuthTagRated: Submission is marked
 AuthTagUserSubmissions: Submissions are made by course participants
 AuthTagCorrectorSubmissions: Submissions are registered by correctors
+AuthTagCorrectionAnonymous: Correction is anonymised
 AuthTagSelf: User is only accessing their only data
 AuthTagIsLDAP: User logs in using their campus account
 AuthTagIsPWHash: User logs in using their Uni2work-internal account

routes

@@ -218,7 +218,7 @@
       /assign                   SubAssignR     GET POST        !lecturerANDtime
       /correction               CorrectionR    GET POST        !corrector !ownerANDreadANDratedANDexam-time
       /invite                   SInviteR       GET POST        !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registeredANDpersonalised-sheet-files
-      /authorship-statements    SubAuthorshipStatementsR GET   !corrector
+      /authorship-statements    SubAuthorshipStatementsR GET   !owner !correctorAND¬correction-anonymous
       !/#SubmissionFileType     SubArchiveR    GET             !owner !corrector
       !/#SubmissionFileType/*FilePath SubDownloadR  GET        !owner !corrector
     /iscorrector                SIsCorrR       GET             !corrector -- Route is used to check for corrector access to this sheet

src/Foundation/Authorization.hs

@@ -1675,6 +1675,13 @@ tagAccessPredicate AuthCorrectorSubmissions = APDB $ \_ _ _ route _ -> case rout
     guard submissionModeCorrector
     return Authorized
   r -> $unsupportedAuthPredicate AuthCorrectorSubmissions r
+tagAccessPredicate AuthCorrectionAnonymous = APDB $ \_ _ _ route _ -> case route of
+  CSheetR tid ssh csh shn _ -> maybeT (unauthorizedI MsgUnauthorizedCorrectionAnonymous) $ do
+    Entity cid _ <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
+    Entity _ Sheet{ sheetAnonymousCorrection } <- $cachedHereBinary (cid, shn) . MaybeT . getBy $ CourseSheet cid shn
+    guard sheetAnonymousCorrection
+    return Authorized
+  r -> $unsupportedAuthPredicate AuthCorrectionAnonymous r
 tagAccessPredicate AuthSelf = APDB $ \_ _ mAuthId route _ -> exceptT return return $ do
   referencedUser' <- case route of
     AdminUserR cID -> return $ Left cID

src/Handler/Submission/Helper.hs

@@ -570,7 +570,7 @@ submissionHelper tid ssh csh shn mcid = do
         , formEncoding = formEnctype
         }
 
-  ((Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector, _), (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer, isOwner, doAuthorshipStatements) <- runDB $ do
+  ((Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector, _), (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, (subUsers, subUsersVisible), isLecturer, isOwner, doAuthorshipStatements) <- runDB $ do
     sheetInfo@(Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, msubmission, _, mASDefinition) <- getSheetInfo
 
     (showCorrection, correctionInvisible) <- fmap (fromMaybe (False, Nothing)) . for ((,) <$> mcid <*> (Entity <$> msmid <*> msubmission)) $ \(cid, subEnt) -> do
@@ -630,7 +630,14 @@ submissionHelper tid ssh csh shn mcid = do
         & mapMOf (traverse . _Right) (\uid -> (,,) <$> (encrypt uid :: DB CryptoUUIDUser) <*> getJust uid <*> getUserAuthorshipStatement uid)
         & fmap (sortOn . over _Right $ (,,,) <$> views _2 userSurname <*> views _2 userDisplayName <*> views _2 userEmail <*> view _1)
 
-    return (sheetInfo, (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer, isOwner, is _Just mASDefinition)
+    subUsersVisible <- orM
+      [ return isOwner
+      , return isLecturer
+      , return $ not sheetAnonymousCorrection
+      , hasReadAccessTo $ CSheetR tid ssh csh shn SSubsR
+      ]
+
+    return (sheetInfo, (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, (subUsers, subUsersVisible), isLecturer, isOwner, is _Just mASDefinition)
 
   -- TODO(AuthorshipStatements): discuss whether to display prompt for user to update their authorship statement, if lecturer changed it
 

src/Model/Types/Security.hs

@@ -77,6 +77,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
   | AuthRated
   | AuthUserSubmissions
   | AuthCorrectorSubmissions
+  | AuthCorrectionAnonymous
   | AuthSubmissionGroup
   | AuthCapacity
   | AuthRegisterGroup

src/Utils/Icon.hs

@@ -99,6 +99,7 @@ data Icon
   | IconVideo
   | IconSubmissionUserDuplicate
   | IconNoAllocationUser
+  | IconSubmissionNoUsers
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
   deriving anyclass (Universe, Finite, NFData)
 
@@ -181,6 +182,7 @@ iconText = \case
     IconVideo                   -> "video"
     IconSubmissionUserDuplicate -> "copy"
     IconNoAllocationUser        -> "user-slash"
+    IconSubmissionNoUsers       -> "user-slash"
 
 nullaryPathPiece ''Icon $ camelToPathPiece' 1
 deriveLift ''Icon

templates/submission.hamlet

@@ -9,65 +9,67 @@ $maybe subCId <- mcid
 
       ^{wdgt}
 
-  <section>
-    <h2>
-      _{MsgSubmissionUserTable}
+  $if subUsersVisible
+    <section>
+      <h2>
+        _{MsgSubmissionUserTable}
 
-    ^{maybeVoid multipleSubmissionWarnWidget}
+      ^{maybeVoid multipleSubmissionWarnWidget}
 
-    $if not (null subUsers)
-      <div .scrolltable>
-        <table .table .table--striped .table--hover>
-          <thead>
-            <tr .table__row .table__row--head>
-              <th .table__th>
-                <div .table__td-content>
-                  _{MsgSubmissionUserDisplayName}
-              $if isLecturer
+      $if not (null subUsers)
+        <div .scrolltable>
+          <table .table .table--striped .table--hover>
+            <thead>
+              <tr .table__row .table__row--head>
                 <th .table__th>
                   <div .table__td-content>
-                    _{MsgSubmissionUserMatriculation}
-              <th .table__th>
-                <div .table__td-content>
-                  _{MsgSubmissionUserEmail}
-              $if doAuthorshipStatements
+                    _{MsgSubmissionUserDisplayName}
+                $if isLecturer
+                  <th .table__th>
+                    <div .table__td-content>
+                      _{MsgSubmissionUserMatriculation}
                 <th .table__th>
                   <div .table__td-content>
-                    ^{simpleLinkI MsgSubmissionUserAuthorshipStatementState (CSubmissionR tid ssh csh shn subCId SubAuthorshipStatementsR)}
-                    ^{iconTooltip asStatusExplainWdgt Nothing True}
-          <tbody>
-            $forall subUser <- subUsers
-              $case subUser
-                $of Left email
-                  <tr .table__row>
-                    <td .table__td>
-                    $if isLecturer
+                    _{MsgSubmissionUserEmail}
+                $if doAuthorshipStatements
+                  <th .table__th>
+                    <div .table__td-content>
+                      ^{simpleLinkI MsgSubmissionUserAuthorshipStatementState (CSubmissionR tid ssh csh shn subCId SubAuthorshipStatementsR)}
+                      ^{iconTooltip asStatusExplainWdgt Nothing True}
+            <tbody>
+              $forall subUser <- subUsers
+                $case subUser
+                  $of Left email
+                    <tr .table__row>
                       <td .table__td>
-                    <td .table__td>
-                      <div .table__td-content .email>
-                        <a href="mailto:#{email}">
-                          #{email}
-                    $if isLecturer && doAuthorshipStatements
+                      $if isLecturer
+                        <td .table__td>
                       <td .table__td>
-                $of Right (uCId, User{userDisplayName, userSurname, userEmail, userMatrikelnummer}, stmt)
-                  <tr .table__row>
-                    <td .table__td>
-                      <div .table__td-content>
-                        ^{simpleLink (nameWidget userDisplayName userSurname) (CourseR tid ssh csh (CUserR uCId))}
-                    $if isLecturer
+                        <div .table__td-content .email>
+                          <a href="mailto:#{email}">
+                            #{email}
+                      $if isLecturer && doAuthorshipStatements
+                        <td .table__td>
+                  $of Right (uCId, User{userDisplayName, userSurname, userEmail, userMatrikelnummer}, stmt)
+                    <tr .table__row>
                       <td .table__td>
                         <div .table__td-content>
-                          $maybe matriculation <- userMatrikelnummer
-                            #{matriculation}
-                    <td .table__td>
-                      <div .table__td-content .email>
-                        <a href="mailto:#{userEmail}">
-                          #{userEmail}
-                    $# TODO(AuthorshipStatements): show authorship statements to submittors?
-                    $if doAuthorshipStatements
-                      <td .table__td .heated style="--hotness: #{boolHeat (stmt /= ASExists)}">
-                        <div .table__td-content>
-                          _{stmt}
+                          ^{simpleLink (nameWidget userDisplayName userSurname) (CourseR tid ssh csh (CUserR uCId))}
+                      $if isLecturer
+                        <td .table__td>
+                          <div .table__td-content>
+                            $maybe matriculation <- userMatrikelnummer
+                              #{matriculation}
+                      <td .table__td>
+                        <div .table__td-content .email>
+                          <a href="mailto:#{userEmail}">
+                            #{userEmail}
+                      $if doAuthorshipStatements
+                        <td .table__td .heated style="--hotness: #{boolHeat (stmt /= ASExists)}">
+                          <div .table__td-content>
+                            _{stmt}
+      $else
+        ^{notification NotificationBroad =<< messageIconI Error IconSubmissionNoUsers MsgSubmissionNoUsers}
 
   <section>
     $case sheetSubmissionMode