fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: submission download token generation broke viewing

Browse Source
This commit is contained in:
Gregor Kleen 2020-12-05 22:24:25 +01:00
parent 8fdd7977f6
commit e1b60844cb
1 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
src/Handler/Submission/Download.hs
View File

@ -17,18 +17,18 @@ import qualified Data.Conduit.Combinators as Conduit
subDownloadSource :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> ConduitT () SubmissionFile (YesodDB UniWorX) () subDownloadSource :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> ConduitT () SubmissionFile (YesodDB UniWorX) ()
subDownloadSource tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = do subDownloadSource tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = maybeT (return ()) $ do
(submissionID, isRating) <- lift $ do (submissionID, isRating) <- hoist lift $ do
submissionID <- submissionMatchesSheet tid ssh csh shn cID submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
isRating <- (== Just submissionID) <$> isRatingFile path isRating <- lift $ (== Just submissionID) <$> isRatingFile path
when (isUpdate || isRating) $ when (isUpdate || isRating) $
guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False guardM . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
return (submissionID, isRating) return (submissionID, isRating)
unless isRating $ (.| Conduit.map entityVal) . E.selectSource . E.from $ \sf -> do lift . unless isRating $ (.| Conduit.map entityVal) . E.selectSource . E.from $ \sf -> do
E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
E.&&. sf E.^. SubmissionFileTitle E.==. E.val path E.&&. sf E.^. SubmissionFileTitle E.==. E.val path
E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion) E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
@ -57,22 +57,23 @@ getSubDownloadR tid ssh csh shn cID sft@(submissionFileTypeIsUpdate -> isUpdate)
subArchiveSource :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> ConduitT () (Either SubmissionFile DBFile) (YesodDB UniWorX) () subArchiveSource :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> ConduitT () (Either SubmissionFile DBFile) (YesodDB UniWorX) ()
subArchiveSource tid ssh csh shn cID sfType = do subArchiveSource tid ssh csh shn cID sfType = maybeT (return ()) $ do
when (sfType == SubmissionCorrected) $ when (sfType == SubmissionCorrected) $
guardAuthResult =<< evalAccess (CSubmissionR tid ssh csh shn cID CorrectionR) False guardM . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID lift $ do
rating <- lift $ getRating submissionID submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
rating <- lift $ getRating submissionID
case sfType of case sfType of
SubmissionOriginal -> (.| Conduit.map (Left . entityVal)) . E.selectSource . E.from $ \sf -> do SubmissionOriginal -> (.| Conduit.map (Left . entityVal)) . E.selectSource . E.from $ \sf -> do
E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False
return sf return sf
_other -> E.selectSource (E.from $ submissionFileQuery submissionID) .| Conduit.map (Left . entityVal) _other -> E.selectSource (E.from $ submissionFileQuery submissionID) .| Conduit.map (Left . entityVal)
when (sfType == SubmissionCorrected) $ when (sfType == SubmissionCorrected) $
maybe (return ()) (yieldM . fmap Right . ratingFile cID) rating maybe (return ()) (yieldM . fmap Right . ratingFile cID) rating
getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> Handler TypedContent getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> Handler TypedContent
getSubArchiveR tid ssh csh shn cID sfType = do getSubArchiveR tid ssh csh shn cID sfType = do