fix(submissions): don't leak info from corrected versions of files

This commit is contained in:
Gregor Kleen 2021-07-30 17:05:50 +02:00
parent 59c7c17665
commit 66f5e96eca

View File

@ -1,5 +1,3 @@
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
module Handler.Submission.Helper
( submissionHelper
) where
@ -554,11 +552,11 @@ submissionHelper tid ssh csh shn mcid = do
let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerFor UniWorX) ())
colonnadeFiles cid = mconcat $ catMaybes
[ Just . sortable (Just "path") (i18nCell MsgTableFileTitle) $ \(mOrig, mCorr) -> let
Just fileTitle' = submissionFileTitle . entityVal <$> (mOrig <|> mCorr)
fileTitle'' = submissionFileTitle . entityVal <$> (mOrig <|> mCorr)
origIsFile = fmap (isJust . submissionFileContent . entityVal) mOrig
corrIsFile = fmap (isJust . submissionFileContent . entityVal) mCorr
Just isFile = origIsFile <|> corrIsFile
in if
isFile' = origIsFile <|> corrIsFile
in maybeCell ((,) <$> fileTitle'' <*> isFile') $ \(fileTitle', isFile) -> if
| Just True <- origIsFile -> anchorCell (subDownloadLink cid SubmissionOriginal fileTitle') [whamlet|#{fileTitle'}|]
| otherwise -> textCell $ bool (<> "/") id isFile fileTitle'
, guardOn showCorrection . sortable (toNothing "state") (i18nCell MsgTableCorState) $ \(_, mCorr) -> case mCorr of
@ -569,8 +567,8 @@ submissionHelper tid ssh csh shn mcid = do
, Just . sortable (Just "time") (i18nCell MsgTableFileModified) $ \(mOrig, mCorr) -> let
origTime = submissionFileModified . entityVal <$> mOrig
corrTime = submissionFileModified . entityVal <$> mCorr
Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
in dateTimeCell fileTime
fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
in maybeCell fileTime dateTimeCell
]
subDownloadLink cid sft fileTitle' = CSubmissionR tid ssh csh shn cid $ SubDownloadR sft fileTitle'
submissionFiles :: _ -> _ -> E.SqlQuery _
@ -579,6 +577,7 @@ submissionHelper tid ssh csh shn mcid = do
E.&&. sf1 E.?. SubmissionFileSubmission E.==. sf2 E.?. SubmissionFileSubmission
E.&&. sf1 E.?. SubmissionFileId E.!=. sf2 E.?. SubmissionFileId
E.&&. sf2 E.?. SubmissionFileIsDeletion E.==. E.val (Just False)
E.&&. E.val showCorrection -- Do not correlate files if we don't show correction; together with `may-access` this treats corrected files like they literally don't exist
E.where_ $ (sf1 E.?. SubmissionFileIsUpdate E.==. E.val (Just False) E.||. E.isNothing (sf1 E.?. SubmissionFileIsUpdate))
E.&&. (sf2 E.?. SubmissionFileIsUpdate E.==. E.val (Just True) E.||. E.isNothing (sf2 E.?. SubmissionFileIsUpdate))