diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 65d951414..efd71068d 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -325,7 +325,7 @@ 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) +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 SheetFormTimes: Zeiten @@ -572,7 +572,11 @@ 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 +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 CorrUpload: Korrekturen hochladen CorrSetCorrector: Korrektor zuweisen diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index c2e266aae..683d024d1 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -324,7 +324,7 @@ 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) +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 SheetFormTimes: Times @@ -570,7 +570,7 @@ 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 +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 CorrUpload: Upload corrections CorrSetCorrector: Assign corrector diff --git a/src/Handler/Allocation/Accept.hs b/src/Handler/Allocation/Accept.hs index 2418d7be3..db9e14512 100644 --- a/src/Handler/Allocation/Accept.hs +++ b/src/Handler/Allocation/Accept.hs @@ -15,8 +15,6 @@ import qualified Data.Map as Map import qualified Database.Esqueleto as E import qualified Control.Monad.State.Class as State -import Data.Semigroup (Dual(..)) - import Data.Sequence (Seq((:|>))) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index fdea529a2..73d8ba5c3 100644 --- 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, 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 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 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 = $(sqlIJproj 3 3) . $(sqlLOJproj 2 1) @@ -155,7 +158,7 @@ colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DB tid = course ^. _3 ssh = course ^. _4 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 Nothing -> nameWidget userDisplayName userSurname 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 = 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")] | 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 = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _, _, _) } -> 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 = 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}|] 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.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId 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 - 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 (return $ not sheetAnonymousCorrection) (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 ) , ( "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" - , 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 , 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.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" , 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) @@ -424,7 +451,7 @@ instance Finite ActionCorrections nullaryPathPiece ''ActionCorrections $ camelToPathPiece' 1 embedRenderMessage ''UniWorX ''ActionCorrections id -data ActionCorrectionsData = CorrDownloadData Bool {- Not anonymized? -} +data ActionCorrectionsData = CorrDownloadData SubmissionDownloadAnonymous | CorrSetCorrectorData (Maybe UserId) | CorrAutoSetCorrectorData SheetId | CorrDeleteData @@ -582,11 +609,22 @@ correctionsR' whereClause displayColumns dbtFilterUI psValidator actions = do let route = CSubmissionR tid ssh csh shn cID SubAssignR (== 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) downloadAction, deleteAction :: ActionCorrections' 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 , pure CorrDeleteData @@ -630,6 +668,7 @@ postCorrectionsR = do , colSheet , colSMatrikel , colSubmittors + , colSGroups , colPseudonyms , colSubmissionLink , colAssigned @@ -655,8 +694,8 @@ postCorrectionsR = do optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses psValidator = def - & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information - & restrictSorting (\name _ -> name /= "corrector") + & restrictCorrector + & restrictAnonymous & defaultSorting [SortAscBy "israted", SortDescBy "ratingTime", SortAscBy "assignedtime" ] -- & defaultFilter (Map.fromList [("israted",[toPathPiece False])]) -- DEPENDS ON ISSUE #371 UNCOMMENT THEN correctionsR whereClause colonnade filterUI psValidator $ Map.fromList @@ -673,6 +712,7 @@ postCCorrectionsR tid ssh csh = do , colSheet , colSMatrikel , colSubmittors + , colSGroups , colSubmissionLink , colLastEdit , colRating @@ -688,6 +728,7 @@ postCCorrectionsR tid ssh csh = do , 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 "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) ] 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 "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 "submission-group") mPrev $ aopt textField (fslI MsgSubmissionGroup) , prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission) -- "pseudonym" TODO DB only stores Word24 ] @@ -1052,6 +1094,7 @@ postCorrectionsGradeR = do , colSheet , colSMatrikel , colSubmittors + , colSGroups , colPseudonyms , colSubmissionLink , colRated @@ -1080,6 +1123,8 @@ postCorrectionsGradeR = do courses <- selectList [] [Asc CourseSchool] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand) optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses psValidator = def + & restrictAnonymous + & restrictCorrector & 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) diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index bb652625c..dbede33a1 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -719,7 +719,7 @@ getCorrectionsDownloadR = do -- download all assigned and open submissions when (null subs) $ do addMessageI Info MsgNoOpenSubmissions 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 diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index ca8192ae6..32ba42074 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -3,6 +3,7 @@ module Handler.Utils.Submission , assignSubmissions, writeSubmissionPlan, planSubmissions , submissionBlacklist, filterSubmission, extractRatings, extractRatingsMsg , submissionFileSource, submissionFileQuery + , SubmissionDownloadAnonymous(..) , submissionMultiArchive , SubmissionSinkException(..) , 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 return (sf, f) -submissionMultiArchive :: Bool -> Set SubmissionId -> Handler TypedContent -submissionMultiArchive notAnonymized (Set.toList -> ids) = do +data SubmissionDownloadAnonymous = SubmissionDownloadAnonymous + | 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 ratedSubmissions <- runDBRunner dbrunner $ do @@ -299,16 +311,33 @@ submissionMultiArchive notAnonymized (Set.toList -> ids) = do dirFrag :: PathPiece p => p -> FilePath dirFrag = Text.unpack . toPathPiece - 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 + userFeature :: SubmissionDownloadAnonymous -> Maybe (E.SqlExpr (Entity User) -> E.SqlExpr (E.Value (Maybe Text))) + userFeature SubmissionDownloadSurnames = Just $ E.just . (E.^. UserSurname) + userFeature SubmissionDownloadMatriculations = Just $ E.castString . (E.^. UserMatrikelnummer) + userFeature _ = Nothing + + withNames fp + | 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 - (return notAnonymized) + (return $ isn't _SubmissionDownloadAnonymous anonymous) (or2M (return $ not sheetAnonymous) (hasReadAccessTo $ CourseR tid ssh csh CCorrectionsR)) submissionDirectory <- bool return withNames notAnonymized' $ dirFrag (cID :: CryptoFileNameSubmission) @@ -707,7 +736,7 @@ sinkMultiSubmission userId isUpdate = do sId <- decrypt (cID :: CryptoFileNameSubmission) Just sId <$ get404 sId | 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) (msId, (joinPath -> fileTitle')) <- foldM acc (Nothing, []) $ splitDirectories fileTitle case msId of diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs index e4b0dd6b5..4103d5595 100644 --- a/src/Import/NoModel.hs +++ b/src/Import/NoModel.hs @@ -59,7 +59,7 @@ import Data.Hashable as Import import Data.List.NonEmpty as Import (NonEmpty(..), nonEmpty) import Data.Text.Encoding.Error as Import(UnicodeException(..)) 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.Instances as Import ()