feat(corrections): non-anonymous download w/ registered groups
This commit is contained in:
parent
7f10d44aee
commit
9032f80f59
@ -325,7 +325,7 @@ SheetMarkingTip: Hinweise zur Korrektur, sichtbar nur für Korrektoren
|
|||||||
SheetPseudonym: Persönliches Abgabe-Pseudonym
|
SheetPseudonym: Persönliches Abgabe-Pseudonym
|
||||||
SheetGeneratePseudonym: Generieren
|
SheetGeneratePseudonym: Generieren
|
||||||
SheetAnonymousCorrection: Anonymisierte Korrektur
|
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)
|
SheetAnonymousCorrectionTip: Wenn die Korrektur anonymisiert erfolgt, können Korrektoren die ihnen zugeteilten Abgaben nicht bestimmten Studierenden zuordnen (Name, Matrikelnummer und feste Abgabegruppe der Abgebenden werden versteckt)
|
||||||
|
|
||||||
SheetFormType: Wertung & Abgabe
|
SheetFormType: Wertung & Abgabe
|
||||||
SheetFormTimes: Zeiten
|
SheetFormTimes: Zeiten
|
||||||
@ -572,7 +572,11 @@ DBTablePagesizeAll: Alle
|
|||||||
|
|
||||||
CorrDownload: Herunterladen
|
CorrDownload: Herunterladen
|
||||||
CorrDownloadAnonymous: Anonymisiert
|
CorrDownloadAnonymous: Anonymisiert
|
||||||
CorrDownloadAnonymousTip: Wenn Abgaben nicht-anonymisiert heruntergeladen werden, werden an die Verzeichnisnamen der einzelnen Abgaben die Nachnamen der Abgeber angehängt, sofern erlaubt
|
CorrDownloadAnonymousTip: Wenn Abgaben nicht-anonymisiert heruntergeladen werden, werden an die Verzeichnisnamen der einzelnen Abgaben das ausgewählte Merkmal der Abgeber angehängt, sofern erlaubt
|
||||||
|
SubmissionDownloadAnonymous: Anonymisiert
|
||||||
|
SubmissionDownloadSurnames: Mit Nachnamen
|
||||||
|
SubmissionDownloadMatriculations: Mit Matrikelnummern
|
||||||
|
SubmissionDownloadGroups: Mit festen Abgabegruppen
|
||||||
CorrUploadField: Korrekturen
|
CorrUploadField: Korrekturen
|
||||||
CorrUpload: Korrekturen hochladen
|
CorrUpload: Korrekturen hochladen
|
||||||
CorrSetCorrector: Korrektor zuweisen
|
CorrSetCorrector: Korrektor zuweisen
|
||||||
|
|||||||
@ -324,7 +324,7 @@ SheetMarkingTip: Instructions for correction, visible only to correctors
|
|||||||
SheetPseudonym: Personal pseudonym
|
SheetPseudonym: Personal pseudonym
|
||||||
SheetGeneratePseudonym: Generate
|
SheetGeneratePseudonym: Generate
|
||||||
SheetAnonymousCorrection: Anonymized correction
|
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)
|
SheetAnonymousCorrectionTip: If correction is anonymized, correctors cannot see which students are involved in submissions that are assigned to them (names, matriculation numbers, and registered submission groups are hidden)
|
||||||
|
|
||||||
SheetFormType: Valuation & submission
|
SheetFormType: Valuation & submission
|
||||||
SheetFormTimes: Times
|
SheetFormTimes: Times
|
||||||
@ -570,7 +570,7 @@ DBTablePagesizeAll: All
|
|||||||
|
|
||||||
CorrDownload: Download
|
CorrDownload: Download
|
||||||
CorrDownloadAnonymous: Anonymized
|
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
|
CorrDownloadAnonymousTip: If submissions are downloaded non-anonymized the selected feature of the submittors are appended to the name of the dirctory for each submission where permitted
|
||||||
CorrUploadField: Corrections
|
CorrUploadField: Corrections
|
||||||
CorrUpload: Upload corrections
|
CorrUpload: Upload corrections
|
||||||
CorrSetCorrector: Assign corrector
|
CorrSetCorrector: Assign corrector
|
||||||
|
|||||||
@ -15,8 +15,6 @@ import qualified Data.Map as Map
|
|||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
import qualified Control.Monad.State.Class as State
|
import qualified Control.Monad.State.Class as State
|
||||||
|
|
||||||
import Data.Semigroup (Dual(..))
|
|
||||||
|
|
||||||
import Data.Sequence (Seq((:|>)))
|
import Data.Sequence (Seq((:|>)))
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -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 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 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, Bool {- Access to non-anonymous submission data -})
|
type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym, Maybe SubmissionGroupName), CryptoFileNameSubmission, Bool {- Access to non-anonymous submission data -})
|
||||||
|
|
||||||
correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v
|
correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v
|
||||||
correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
|
correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
|
||||||
@ -83,6 +83,9 @@ lastEditQuery submission = E.subSelectMaybe $ E.from $ \edit -> do
|
|||||||
E.where_ $ edit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
|
E.where_ $ edit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
|
||||||
return $ E.max_ $ edit E.^. SubmissionEditTime
|
return $ E.max_ $ edit E.^. SubmissionEditTime
|
||||||
|
|
||||||
|
queryCourse :: CorrectionTableExpr -> E.SqlExpr (Entity Course)
|
||||||
|
queryCourse = $(sqlIJproj 3 1) . $(sqlLOJproj 2 1)
|
||||||
|
|
||||||
querySubmission :: CorrectionTableExpr -> E.SqlExpr (Entity Submission)
|
querySubmission :: CorrectionTableExpr -> E.SqlExpr (Entity Submission)
|
||||||
querySubmission = $(sqlIJproj 3 3) . $(sqlLOJproj 2 1)
|
querySubmission = $(sqlIJproj 3 3) . $(sqlLOJproj 2 1)
|
||||||
|
|
||||||
@ -155,7 +158,7 @@ colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DB
|
|||||||
tid = course ^. _3
|
tid = course ^. _3
|
||||||
ssh = course ^. _4
|
ssh = course ^. _4
|
||||||
link cid = CourseR tid ssh csh $ CUserR cid
|
link cid = CourseR tid ssh csh $ CUserR cid
|
||||||
protoCell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo)) ->
|
protoCell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo, _)) ->
|
||||||
anchorCellCM $cacheIdentHere (link <$> encrypt userId) $ case mPseudo of
|
anchorCellCM $cacheIdentHere (link <$> encrypt userId) $ case mPseudo of
|
||||||
Nothing -> nameWidget userDisplayName userSurname
|
Nothing -> nameWidget userDisplayName userSurname
|
||||||
Just p -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review _PseudonymText p})|]
|
Just p -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review _PseudonymText p})|]
|
||||||
@ -164,10 +167,19 @@ colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DB
|
|||||||
|
|
||||||
colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
|
colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
|
||||||
colSMatrikel = sortable (Just "submittors-matriculation") (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, (_, csh, tid, ssh), _, _, users, _, hasAccess) } ->
|
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)
|
let protoCell = listCell (Map.toList $ Map.mapMaybe (\x@(User{..}, _, _) -> (x,) <$> assertM (not . null) userMatrikelnummer) users) $ \(userId, ((User{..}, _, _), matr)) -> anchorCellCM $cacheIdentHere (CourseR tid ssh csh . CUserR <$> encrypt userId) matr
|
||||||
in if | hasAccess -> protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
in if | hasAccess -> protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
||||||
| otherwise -> mempty
|
| otherwise -> mempty
|
||||||
|
|
||||||
|
colSGroups :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
|
||||||
|
colSGroups = sortable (Just "submittors-group") (i18nCell MsgSubmissionGroup) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, _, _, _, users, _, hasAccess) } ->
|
||||||
|
let protoCell = listCell (nubOn (view _2) . Map.toList $ Map.mapMaybe (view _3) users) $ \(_, sGroup) -> cell $ toWidget sGroup
|
||||||
|
in if | hasAccess
|
||||||
|
, is _RegisteredGroups sheetGrouping
|
||||||
|
-> 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 :: 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
|
let csh = course ^. _2
|
||||||
@ -198,7 +210,7 @@ colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOu
|
|||||||
|
|
||||||
colPseudonyms :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
|
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 ->
|
lCell = listCell (catMaybes $ view (_2 . _2) <$> Map.toList users) $ \pseudo ->
|
||||||
cell [whamlet|#{review _PseudonymText pseudo}|]
|
cell [whamlet|#{review _PseudonymText pseudo}|]
|
||||||
in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
||||||
|
|
||||||
@ -249,9 +261,14 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
|
|||||||
E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
|
E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
|
||||||
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
|
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
|
||||||
E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
|
E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
|
||||||
return (user, pseudonym E.?. SheetPseudonymPseudonym)
|
let submissionGroup' = E.subSelectMaybe . E.from $ \(submissionGroup `E.InnerJoin` submissionGroupUser) -> do
|
||||||
|
E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
|
||||||
|
E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val sheetCourse
|
||||||
|
E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. user E.^. UserId
|
||||||
|
return . E.just $ submissionGroup E.^. SubmissionGroupName
|
||||||
|
return (user, pseudonym E.?. SheetPseudonymPseudonym, submissionGroup')
|
||||||
let
|
let
|
||||||
submittorMap = List.foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
|
submittorMap = List.foldr (\(Entity userId user, E.Value pseudo, E.Value sGroup) -> Map.insert userId (user, pseudo, sGroup)) Map.empty submittors
|
||||||
nonAnonymousAccess <- or2M
|
nonAnonymousAccess <- or2M
|
||||||
(return $ not sheetAnonymousCorrection)
|
(return $ not sheetAnonymousCorrection)
|
||||||
(hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR)
|
(hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR)
|
||||||
@ -298,10 +315,13 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
|
|||||||
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingAssigned
|
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingAssigned
|
||||||
)
|
)
|
||||||
, ( "submittors"
|
, ( "submittors"
|
||||||
, SortProjected . comparing $ \DBRow{ dbrOutput = (_, Entity _ Sheet{..}, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap ((userSurname &&& userDisplayName) . view _1) $ Map.elems submittors
|
, SortProjected . comparing $ \DBRow{ dbrOutput = (_, _, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap ((userSurname &&& userDisplayName) . view _1) $ Map.elems submittors
|
||||||
)
|
)
|
||||||
, ( "submittors-matriculation"
|
, ( "submittors-matriculation"
|
||||||
, SortProjected . comparing $ \DBRow{ dbrOutput = (_, Entity _ Sheet{..}, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap (view $ _1 . _userMatrikelnummer) $ Map.elems submittors
|
, SortProjected . comparing $ \DBRow{ dbrOutput = (_, _, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap (view $ _1 . _userMatrikelnummer) $ Map.elems submittors
|
||||||
|
)
|
||||||
|
, ( "submittors-group"
|
||||||
|
, SortProjected . comparing $ \DBRow{ dbrOutput = (_, _, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap (view _3) $ Map.elems submittors
|
||||||
)
|
)
|
||||||
, ( "comment" -- sorting by comment specifically requested by correctors to easily see submissions to be done
|
, ( "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
|
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingComment
|
||||||
@ -381,6 +401,13 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
|
|||||||
E.where_ $ (\f -> f user $ Set.singleton needle) $
|
E.where_ $ (\f -> f user $ Set.singleton needle) $
|
||||||
E.mkContainsFilter (E.^. UserMatrikelnummer)
|
E.mkContainsFilter (E.^. UserMatrikelnummer)
|
||||||
)
|
)
|
||||||
|
, ( "submission-group"
|
||||||
|
, FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(submissionGroup `E.InnerJoin` submissionGroupUser) -> do
|
||||||
|
E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
|
||||||
|
E.where_ $ queryCourse table E.^. CourseId E.==. submissionGroup E.^. SubmissionGroupCourse
|
||||||
|
E.where_ $ (\f -> f submissionGroup $ Set.singleton needle) $
|
||||||
|
E.mkContainsFilter (E.^. SubmissionGroupName)
|
||||||
|
)
|
||||||
, ( "rating-visible"
|
, ( "rating-visible"
|
||||||
, FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
|
, FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
|
||||||
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
|
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||||
@ -424,7 +451,7 @@ instance Finite ActionCorrections
|
|||||||
nullaryPathPiece ''ActionCorrections $ camelToPathPiece' 1
|
nullaryPathPiece ''ActionCorrections $ camelToPathPiece' 1
|
||||||
embedRenderMessage ''UniWorX ''ActionCorrections id
|
embedRenderMessage ''UniWorX ''ActionCorrections id
|
||||||
|
|
||||||
data ActionCorrectionsData = CorrDownloadData Bool {- Not anonymized? -}
|
data ActionCorrectionsData = CorrDownloadData SubmissionDownloadAnonymous
|
||||||
| CorrSetCorrectorData (Maybe UserId)
|
| CorrSetCorrectorData (Maybe UserId)
|
||||||
| CorrAutoSetCorrectorData SheetId
|
| CorrAutoSetCorrectorData SheetId
|
||||||
| CorrDeleteData
|
| CorrDeleteData
|
||||||
@ -582,11 +609,22 @@ correctionsR' whereClause displayColumns dbtFilterUI psValidator actions = do
|
|||||||
let route = CSubmissionR tid ssh csh shn cID SubAssignR
|
let route = CSubmissionR tid ssh csh shn cID SubAssignR
|
||||||
(== Authorized) <$> evalAccessDB route True
|
(== Authorized) <$> evalAccessDB route True
|
||||||
|
|
||||||
|
restrictAnonymous :: PSValidator m x -> PSValidator m x
|
||||||
|
restrictAnonymous = restrictFilter (\k _ -> k /= "user-matriclenumber")
|
||||||
|
. restrictFilter (\k _ -> k /= "user-name-email")
|
||||||
|
. restrictFilter (\k _ -> k /= "submission-group")
|
||||||
|
. restrictSorting (\k _ -> k /= "last-edit")
|
||||||
|
|
||||||
|
restrictCorrector :: PSValidator m x -> PSValidator m x
|
||||||
|
restrictCorrector = restrictFilter (\k _ -> k /= "corrector")
|
||||||
|
. restrictFilter (\k _ -> k /= "corrector-name-email")
|
||||||
|
. restrictSorting (\k _ -> k /= "corrector")
|
||||||
|
|
||||||
type ActionCorrections' = (ActionCorrections, AForm (HandlerFor UniWorX) ActionCorrectionsData)
|
type ActionCorrections' = (ActionCorrections, AForm (HandlerFor UniWorX) ActionCorrectionsData)
|
||||||
|
|
||||||
downloadAction, deleteAction :: ActionCorrections'
|
downloadAction, deleteAction :: ActionCorrections'
|
||||||
downloadAction = ( CorrDownload
|
downloadAction = ( CorrDownload
|
||||||
, CorrDownloadData <$> apopt (convertField not not checkBoxField) (fslI MsgCorrDownloadAnonymous & setTooltip MsgCorrDownloadAnonymousTip) (Just False)
|
, CorrDownloadData <$> apopt (selectField optionsFinite) (fslI MsgCorrDownloadAnonymous & setTooltip MsgCorrDownloadAnonymousTip) (Just SubmissionDownloadAnonymous)
|
||||||
)
|
)
|
||||||
deleteAction = ( CorrDelete
|
deleteAction = ( CorrDelete
|
||||||
, pure CorrDeleteData
|
, pure CorrDeleteData
|
||||||
@ -630,6 +668,7 @@ postCorrectionsR = do
|
|||||||
, colSheet
|
, colSheet
|
||||||
, colSMatrikel
|
, colSMatrikel
|
||||||
, colSubmittors
|
, colSubmittors
|
||||||
|
, colSGroups
|
||||||
, colPseudonyms
|
, colPseudonyms
|
||||||
, colSubmissionLink
|
, colSubmissionLink
|
||||||
, colAssigned
|
, colAssigned
|
||||||
@ -655,8 +694,8 @@ postCorrectionsR = do
|
|||||||
optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
|
optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
|
||||||
|
|
||||||
psValidator = def
|
psValidator = def
|
||||||
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
|
& restrictCorrector
|
||||||
& restrictSorting (\name _ -> name /= "corrector")
|
& restrictAnonymous
|
||||||
& defaultSorting [SortAscBy "israted", SortDescBy "ratingTime", SortAscBy "assignedtime" ]
|
& defaultSorting [SortAscBy "israted", SortDescBy "ratingTime", SortAscBy "assignedtime" ]
|
||||||
-- & defaultFilter (Map.fromList [("israted",[toPathPiece False])]) -- DEPENDS ON ISSUE #371 UNCOMMENT THEN
|
-- & defaultFilter (Map.fromList [("israted",[toPathPiece False])]) -- DEPENDS ON ISSUE #371 UNCOMMENT THEN
|
||||||
correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
|
correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
|
||||||
@ -673,6 +712,7 @@ postCCorrectionsR tid ssh csh = do
|
|||||||
, colSheet
|
, colSheet
|
||||||
, colSMatrikel
|
, colSMatrikel
|
||||||
, colSubmittors
|
, colSubmittors
|
||||||
|
, colSGroups
|
||||||
, colSubmissionLink
|
, colSubmissionLink
|
||||||
, colLastEdit
|
, colLastEdit
|
||||||
, colRating
|
, colRating
|
||||||
@ -688,6 +728,7 @@ postCCorrectionsR tid ssh csh = do
|
|||||||
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
|
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
|
||||||
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
|
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
|
||||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
|
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
|
||||||
|
, prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgSubmissionGroup)
|
||||||
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
|
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
|
||||||
]
|
]
|
||||||
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
|
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
|
||||||
@ -719,6 +760,7 @@ postSSubsR tid ssh csh shn = do
|
|||||||
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
|
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
|
||||||
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
|
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
|
||||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
|
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
|
||||||
|
, prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgSubmissionGroup)
|
||||||
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
|
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
|
||||||
-- "pseudonym" TODO DB only stores Word24
|
-- "pseudonym" TODO DB only stores Word24
|
||||||
]
|
]
|
||||||
@ -1052,6 +1094,7 @@ postCorrectionsGradeR = do
|
|||||||
, colSheet
|
, colSheet
|
||||||
, colSMatrikel
|
, colSMatrikel
|
||||||
, colSubmittors
|
, colSubmittors
|
||||||
|
, colSGroups
|
||||||
, colPseudonyms
|
, colPseudonyms
|
||||||
, colSubmissionLink
|
, colSubmissionLink
|
||||||
, colRated
|
, colRated
|
||||||
@ -1080,6 +1123,8 @@ postCorrectionsGradeR = do
|
|||||||
courses <- selectList [] [Asc CourseSchool] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
|
courses <- selectList [] [Asc CourseSchool] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
|
||||||
optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
|
optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
|
||||||
psValidator = def
|
psValidator = def
|
||||||
|
& restrictAnonymous
|
||||||
|
& restrictCorrector
|
||||||
& defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData))
|
& 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)
|
||||||
|
|
||||||
|
|||||||
@ -719,7 +719,7 @@ getCorrectionsDownloadR = do -- download all assigned and open submissions
|
|||||||
when (null subs) $ do
|
when (null subs) $ do
|
||||||
addMessageI Info MsgNoOpenSubmissions
|
addMessageI Info MsgNoOpenSubmissions
|
||||||
redirect CorrectionsR
|
redirect CorrectionsR
|
||||||
submissionMultiArchive True $ Set.fromList subs -- not anonymized, where permissable
|
submissionMultiArchive SubmissionDownloadAnonymous $ Set.fromList subs
|
||||||
|
|
||||||
|
|
||||||
getSubAssignR, postSubAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
|
getSubAssignR, postSubAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
|
||||||
|
|||||||
@ -3,6 +3,7 @@ module Handler.Utils.Submission
|
|||||||
, assignSubmissions, writeSubmissionPlan, planSubmissions
|
, assignSubmissions, writeSubmissionPlan, planSubmissions
|
||||||
, submissionBlacklist, filterSubmission, extractRatings, extractRatingsMsg
|
, submissionBlacklist, filterSubmission, extractRatings, extractRatingsMsg
|
||||||
, submissionFileSource, submissionFileQuery
|
, submissionFileSource, submissionFileQuery
|
||||||
|
, SubmissionDownloadAnonymous(..)
|
||||||
, submissionMultiArchive
|
, submissionMultiArchive
|
||||||
, SubmissionSinkException(..)
|
, SubmissionSinkException(..)
|
||||||
, msgSubmissionErrors -- wrap around sinkSubmission/sinkMultiSubmission, but outside of runDB!
|
, msgSubmissionErrors -- wrap around sinkSubmission/sinkMultiSubmission, but outside of runDB!
|
||||||
@ -270,8 +271,19 @@ submissionFileQuery submissionID (sf `E.InnerJoin` f) = E.distinctOnOrderBy [E.a
|
|||||||
E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate] -- E.desc returns corrector updated data first
|
E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate] -- E.desc returns corrector updated data first
|
||||||
return (sf, f)
|
return (sf, f)
|
||||||
|
|
||||||
submissionMultiArchive :: Bool -> Set SubmissionId -> Handler TypedContent
|
data SubmissionDownloadAnonymous = SubmissionDownloadAnonymous
|
||||||
submissionMultiArchive notAnonymized (Set.toList -> ids) = do
|
| SubmissionDownloadSurnames
|
||||||
|
| SubmissionDownloadMatriculations
|
||||||
|
| SubmissionDownloadGroups
|
||||||
|
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||||
|
deriving anyclass (Universe, Finite)
|
||||||
|
|
||||||
|
nullaryPathPiece ''SubmissionDownloadAnonymous $ camelToPathPiece' 2
|
||||||
|
embedRenderMessage ''UniWorX ''SubmissionDownloadAnonymous id
|
||||||
|
makePrisms ''SubmissionDownloadAnonymous
|
||||||
|
|
||||||
|
submissionMultiArchive :: SubmissionDownloadAnonymous -> Set SubmissionId -> Handler TypedContent
|
||||||
|
submissionMultiArchive anonymous (Set.toList -> ids) = do
|
||||||
(dbrunner, cleanup) <- getDBRunner
|
(dbrunner, cleanup) <- getDBRunner
|
||||||
|
|
||||||
ratedSubmissions <- runDBRunner dbrunner $ do
|
ratedSubmissions <- runDBRunner dbrunner $ do
|
||||||
@ -299,16 +311,33 @@ submissionMultiArchive notAnonymized (Set.toList -> ids) = do
|
|||||||
dirFrag :: PathPiece p => p -> FilePath
|
dirFrag :: PathPiece p => p -> FilePath
|
||||||
dirFrag = Text.unpack . toPathPiece
|
dirFrag = Text.unpack . toPathPiece
|
||||||
|
|
||||||
withNames fp = do
|
userFeature :: SubmissionDownloadAnonymous -> Maybe (E.SqlExpr (Entity User) -> E.SqlExpr (E.Value (Maybe Text)))
|
||||||
surnames <- lift . E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> do
|
userFeature SubmissionDownloadSurnames = Just $ E.just . (E.^. UserSurname)
|
||||||
E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
|
userFeature SubmissionDownloadMatriculations = Just $ E.castString . (E.^. UserMatrikelnummer)
|
||||||
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val submissionID
|
userFeature _ = Nothing
|
||||||
return $ user E.^. UserSurname
|
|
||||||
let asciiNames = sort $ map (filter isAlphaNum . foldMap unidecode . unpack . E.unValue) surnames
|
withNames fp
|
||||||
return . intercalate "_" $ fp : asciiNames
|
| is _SubmissionDownloadGroups anonymous = do
|
||||||
|
groups <- lift . E.select . E.from $ \(submissionGroup `E.InnerJoin` submissionGroupUser `E.InnerJoin` submissionUser) -> do
|
||||||
|
E.on $ submissionUser E.^. SubmissionUserUser E.==. submissionGroupUser E.^. SubmissionGroupUserUser
|
||||||
|
E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
|
||||||
|
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val submissionID
|
||||||
|
E.where_ $ E.subSelectForeign submissionUser SubmissionUserSubmission (\submission -> E.subSelectForeign submission SubmissionSheet (E.^. SheetGrouping)) E.==. E.val RegisteredGroups
|
||||||
|
return $ submissionGroup E.^. SubmissionGroupName
|
||||||
|
let asciiGroups = nub . sort $ map (filter isAlphaNum . foldMap unidecode . unpack . CI.original . E.unValue) groups
|
||||||
|
return . intercalate "_" $ asciiGroups `snoc` fp
|
||||||
|
| Just feature <- userFeature anonymous
|
||||||
|
= do
|
||||||
|
features <- 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 $ feature user
|
||||||
|
let asciiFeatures = sort $ mapMaybe (fmap (filter isAlphaNum . foldMap unidecode . unpack) . E.unValue) features
|
||||||
|
return . intercalate "_" $ asciiFeatures `snoc` fp
|
||||||
|
| otherwise = return fp
|
||||||
|
|
||||||
notAnonymized' <- and2M
|
notAnonymized' <- and2M
|
||||||
(return notAnonymized)
|
(return $ isn't _SubmissionDownloadAnonymous anonymous)
|
||||||
(or2M (return $ not sheetAnonymous) (hasReadAccessTo $ CourseR tid ssh csh CCorrectionsR))
|
(or2M (return $ not sheetAnonymous) (hasReadAccessTo $ CourseR tid ssh csh CCorrectionsR))
|
||||||
|
|
||||||
submissionDirectory <- bool return withNames notAnonymized' $ dirFrag (cID :: CryptoFileNameSubmission)
|
submissionDirectory <- bool return withNames notAnonymized' $ dirFrag (cID :: CryptoFileNameSubmission)
|
||||||
@ -707,7 +736,7 @@ sinkMultiSubmission userId isUpdate = do
|
|||||||
sId <- decrypt (cID :: CryptoFileNameSubmission)
|
sId <- decrypt (cID :: CryptoFileNameSubmission)
|
||||||
Just sId <$ get404 sId
|
Just sId <$ get404 sId
|
||||||
| otherwise = return Nothing
|
| otherwise = return Nothing
|
||||||
Alt msId <- lift . flip foldMapM segments' $ \seg -> Alt <$> lift (tryDecrypt seg) `catches` [ E.Handler handleCryptoID, E.Handler (handleHCError $ Right fileTitle) ]
|
Dual (Alt msId) <- lift . flip foldMapM segments' $ \seg -> Dual . Alt <$> lift (tryDecrypt seg) `catches` [ E.Handler handleCryptoID, E.Handler (handleHCError $ Right fileTitle) ]
|
||||||
return (msId, fp)
|
return (msId, fp)
|
||||||
(msId, (joinPath -> fileTitle')) <- foldM acc (Nothing, []) $ splitDirectories fileTitle
|
(msId, (joinPath -> fileTitle')) <- foldM acc (Nothing, []) $ splitDirectories fileTitle
|
||||||
case msId of
|
case msId of
|
||||||
|
|||||||
@ -59,7 +59,7 @@ import Data.Hashable as Import
|
|||||||
import Data.List.NonEmpty as Import (NonEmpty(..), nonEmpty)
|
import Data.List.NonEmpty as Import (NonEmpty(..), nonEmpty)
|
||||||
import Data.Text.Encoding.Error as Import(UnicodeException(..))
|
import Data.Text.Encoding.Error as Import(UnicodeException(..))
|
||||||
import Data.Semigroup as Import (Min(..), Max(..))
|
import Data.Semigroup as Import (Min(..), Max(..))
|
||||||
import Data.Monoid as Import (Last(..), First(..), Any(..), All(..), Sum(..), Endo(..), Alt(..))
|
import Data.Monoid as Import (Last(..), First(..), Any(..), All(..), Sum(..), Endo(..), Alt(..), Dual(..))
|
||||||
import Data.Binary as Import (Binary)
|
import Data.Binary as Import (Binary)
|
||||||
import Data.Binary.Instances as Import ()
|
import Data.Binary.Instances as Import ()
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user