100 lines
4.3 KiB
Haskell
100 lines
4.3 KiB
Haskell
module Handler.Submission.Download
|
|
( getSubDownloadR, subDownloadSource
|
|
, getSubArchiveR, subArchiveSource
|
|
, getCorrectionsDownloadR
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Handler.Utils.Submission
|
|
|
|
import qualified Data.Set as Set
|
|
|
|
import qualified Database.Esqueleto as E
|
|
|
|
import qualified Data.Conduit.Combinators as Conduit
|
|
|
|
|
|
subDownloadSource :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> ConduitT () SubmissionFile (YesodDB UniWorX) ()
|
|
subDownloadSource tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = maybeT_ $ do
|
|
(submissionID, isRating) <- hoist lift $ do
|
|
submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
|
|
|
|
isRating <- lift $ (== Just submissionID) <$> isRatingFile path
|
|
|
|
when (isUpdate || isRating) $
|
|
guardM . lift . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
|
|
|
|
return (submissionID, isRating)
|
|
|
|
lift . unless isRating $ (.| Conduit.map entityVal) . E.selectSource . E.from $ \sf -> do
|
|
E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
|
|
E.&&. sf E.^. SubmissionFileTitle E.==. E.val path
|
|
E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
|
|
E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
|
|
-- E.&&. E.not_ (E.isNothing $ f E.^. FileContent) -- This is fine, we just return 204
|
|
return sf
|
|
|
|
getSubDownloadR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> Handler TypedContent
|
|
getSubDownloadR tid ssh csh shn cID sft@(submissionFileTypeIsUpdate -> isUpdate) path = do
|
|
(submissionID, isRating) <- runDB $ do
|
|
submissionID <- submissionMatchesSheet tid ssh csh shn cID
|
|
|
|
isRating <- (== Just submissionID) <$> isRatingFile path
|
|
|
|
when (isUpdate || isRating) $
|
|
guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False
|
|
|
|
return (submissionID, isRating)
|
|
|
|
case isRating of
|
|
True
|
|
| isUpdate -> maybe notFound sendThisFile <=< runDB . runMaybeT $
|
|
lift . ratingFile cID =<< MaybeT (getRating submissionID)
|
|
| otherwise -> notFound
|
|
False -> serveOneFile $ subDownloadSource tid ssh csh shn cID sft path
|
|
|
|
|
|
subArchiveSource :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> ConduitT () (Either SubmissionFile DBFile) (YesodDB UniWorX) ()
|
|
subArchiveSource tid ssh csh shn cID sfType = maybeT_ $ do
|
|
when (sfType == SubmissionCorrected) $
|
|
guardM . lift . lift . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
|
|
|
|
lift $ do
|
|
submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
|
|
rating <- lift $ getRating submissionID
|
|
|
|
case sfType of
|
|
SubmissionOriginal -> (.| Conduit.map (Left . entityVal)) . E.selectSource . E.from $ \sf -> do
|
|
E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
|
|
E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False
|
|
return sf
|
|
_other -> E.selectSource (E.from $ submissionFileQuery submissionID) .| Conduit.map (Left . entityVal)
|
|
|
|
when (sfType == SubmissionCorrected) $
|
|
maybe (return ()) (yieldM . fmap Right . ratingFile cID) rating
|
|
|
|
getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> Handler TypedContent
|
|
getSubArchiveR tid ssh csh shn cID sfType = do
|
|
when (sfType == SubmissionCorrected) $
|
|
guardAuthResult =<< evalAccess (CSubmissionR tid ssh csh shn cID CorrectionR) False
|
|
|
|
sfType' <- ap getMessageRender $ pure sfType
|
|
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgSubmissionTypeArchiveName tid ssh csh shn cID sfType'
|
|
|
|
serveSomeFiles' archiveName $ subArchiveSource tid ssh csh shn cID sfType
|
|
|
|
|
|
getCorrectionsDownloadR :: Handler TypedContent
|
|
getCorrectionsDownloadR = do -- download all assigned and open submissions
|
|
uid <- requireAuthId
|
|
subs <- runDB $ selectKeysList
|
|
[ SubmissionRatingBy ==. Just uid
|
|
, SubmissionRatingTime ==. Nothing
|
|
] []
|
|
when (null subs) $ do
|
|
addMessageI Info MsgNoOpenSubmissions
|
|
redirect CorrectionsR
|
|
submissionMultiArchive SubmissionDownloadAnonymous $ Set.fromList subs
|