Archiv
$forall (name,time) <- lastEdits
last edited by #{name} at #{formatTimeGerDTlong time}
$maybe fileTable <- mFileTable
@@ -276,14 +278,12 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
|]
-getSubmissionDownloadSingleR :: TermId -> Text -> Text -> CryptoFileNameSubmission -> FilePath -> Handler TypedContent
-getSubmissionDownloadSingleR tid csh shn cID path = do
+getSubDownloadR :: TermId -> Text -> Text -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> Handler TypedContent
+getSubDownloadR tid csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = do
submissionID <- decrypt cID
runDB $ do
- shid <- fetchSheetId tid csh shn
- Submission{..} <- get404 submissionID
- when (shid /= submissionSheet) $ invalidArgsI [MsgSubmissionWrongSheet]
+ submissionMatchesSheet tid csh shn cID
isRating <- maybe False (== submissionID) <$> isRatingFile path
case isRating of
@@ -291,13 +291,13 @@ getSubmissionDownloadSingleR tid csh shn cID path = do
file <- runMaybeT $ lift . ratingFile cID =<< MaybeT (getRating submissionID)
maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file
False -> do
- results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
+ results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> do
E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
- E.where_ (sf E.^. SubmissionFileSubmission E.==. E.val submissionID)
- E.where_ (f E.^. FileTitle E.==. E.val path)
- E.where_ . E.not_ . E.isNothing $ f E.^. FileContent
- E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion
- E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
+ E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
+ E.&&. f E.^. FileTitle E.==. E.val path
+ E.&&. E.not_ (E.isNothing $ f E.^. FileContent)
+ E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
+ E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
return f
let fileName = Text.pack $ takeFileName path
@@ -305,15 +305,14 @@ getSubmissionDownloadSingleR tid csh shn cID path = do
[Entity _ File{ fileContent = Just c }] -> return $ TypedContent (defaultMimeLookup fileName <> "; charset=utf-8") (toContent c)
_ -> notFound
-getSubmissionDownloadArchiveR :: TermId -> Text -> Text -> ZIPArchiveName SubmissionId -> Handler TypedContent
-getSubmissionDownloadArchiveR tid csh shn (ZIPArchiveName cID) = do
+getSubArchiveR :: TermId -> Text -> Text -> CryptoFileNameSubmission -> Handler TypedContent
+getSubArchiveR tid csh shn cID@CryptoID{..} = do
submissionID <- decrypt cID
- cUUID <- encrypt submissionID
+
+ addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece cID}.zip"|]
+
respondSourceDB "application/zip" $ do
- lift $ do
- shid <- fetchSheetId tid csh shn
- Submission{..} <- get404 submissionID
- when (shid /= submissionSheet) $ invalidArgsI [MsgSubmissionWrongSheet]
+ lift $ submissionMatchesSheet tid csh shn cID
rating <- lift $ getRating submissionID
case rating of
@@ -321,5 +320,5 @@ getSubmissionDownloadArchiveR tid csh shn (ZIPArchiveName cID) = do
Just rating' -> do
let fileEntitySource' :: Source (YesodDB UniWorX) File
fileEntitySource' = submissionFileSource submissionID =$= Conduit.map entityVal >> yieldM (ratingFile cID rating')
- info = ZipInfo { zipComment = Text.encodeUtf8 . pack . CI.foldedCase $ ciphertext (cUUID :: CryptoFileNameSubmission) }
+ info = ZipInfo { zipComment = Text.encodeUtf8 . pack $ CI.foldedCase ciphertext }
fileEntitySource' =$= produceZip info =$= Conduit.map toFlushBuilder
diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index 8cf22e67d..10ac1f07f 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -19,6 +19,7 @@ module Handler.Utils.Submission
, submissionMultiArchive
, SubmissionSinkException(..)
, sinkSubmission
+ , submissionMatchesSheet
) where
import Import hiding ((.=), joinPath)
@@ -46,6 +47,7 @@ import Generics.Deriving.Monoid (memptydefault, mappenddefault)
import Handler.Utils.Rating
import Handler.Utils.Zip
+import Handler.Utils.Sheet
import qualified Database.Esqueleto as E
@@ -119,16 +121,16 @@ assignSubmissions sid restriction = do
submissionFileSource :: SubmissionId -> Source (YesodDB UniWorX) (Entity File)
-submissionFileSource = E.selectSource . E.from . submissionFileQuery
+submissionFileSource = E.selectSource . fmap snd . E.from . submissionFileQuery
submissionFileQuery :: SubmissionId -> E.SqlExpr (Entity SubmissionFile) `E.InnerJoin` E.SqlExpr (Entity File)
- -> E.SqlQuery (E.SqlExpr (Entity File))
+ -> E.SqlQuery (E.SqlExpr (Entity SubmissionFile), E.SqlExpr (Entity File))
submissionFileQuery submissionID (sf `E.InnerJoin` f) = E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion -- TODO@gk: won't work as intended! Fix with refactor
E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate] -- E.desc returns corrector updated data first
- return f
+ return (sf, f)
submissionMultiArchive :: Set SubmissionId -> Handler TypedContent
submissionMultiArchive (Set.toList -> ids) = do
@@ -378,6 +380,8 @@ sinkMultiSubmission :: UserId
-- ^ Expects all supplied 'SubmissionContent' to contain an encrypted 'SubmissionId' and replaces the currently saved files for the respective submissions (either corrected files or original ones, depending on arguments) with the supplied 'SubmissionContent'.
--
-- Files that don't occur in the 'SubmissionContent' but are in the database are deleted (or marked as deleted in the case of this being a correction).
+--
+-- In contrast to `sinkSubmission` this function does authorization-checks against `CorrectionR` -- TODO
sinkMultiSubmission userId isUpdate = do
let
feed :: SubmissionId
@@ -410,3 +414,10 @@ sinkMultiSubmission userId isUpdate = do
(msId, (joinPath -> fileTitle')) <- foldM acc (Nothing, []) $ splitDirectories fileTitle
lift . maybe (const $ return ()) feed msId $ Left f{ fileTitle = fileTitle' }
fmap Map.keysSet . lift $ mapM (void . closeResumableSink) sinks
+
+submissionMatchesSheet :: TermId -> Text -> Text -> CryptoFileNameSubmission -> DB ()
+submissionMatchesSheet tid csh shn cid = do
+ sid <- decrypt cid
+ shid <- fetchSheetId tid csh shn
+ Submission{..} <- get404 sid
+ when (shid /= submissionSheet) $ invalidArgsI [MsgSubmissionWrongSheet]
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index efa329e4a..526c88f7b 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -73,6 +73,9 @@ data SheetGroup
deriveJSON defaultOptions ''SheetGroup
derivePersistFieldJSON "SheetGroup"
+enumFromPathPiece :: (PathPiece a, Enum a, Bounded a) => Text -> Maybe a
+enumFromPathPiece t = lookup (CI.mk t) [(CI.mk $ toPathPiece ty,ty) | ty <- [minBound..maxBound]]
+
data SheetFileType = SheetExercise | SheetHint | SheetSolution | SheetMarking
deriving (Show, Read, Eq, Ord, Enum, Bounded)
derivePersistField "SheetFileType"
@@ -82,8 +85,7 @@ instance PathPiece SheetFileType where
toPathPiece SheetHint = "hint"
toPathPiece SheetSolution = "solution"
toPathPiece SheetMarking = "marking"
- fromPathPiece t =
- lookup (CI.mk t) [(CI.mk $ toPathPiece ty,ty) | ty <- [minBound..maxBound]]
+ fromPathPiece = enumFromPathPiece
-- $(deriveSimpleWith ''DisplayAble 'display (drop 17) ''SheetFileType)
instance DisplayAble SheetFileType where -- deprecated, see RenderMessage instance in Foundation
@@ -92,6 +94,26 @@ instance DisplayAble SheetFileType where -- deprecated, see RenderMessage instan
display SheetSolution = "Musterlösung"
display SheetMarking = "Korrekturhinweise"
+data SubmissionFileType = SubmissionOriginal | SubmissionCorrected
+ deriving (Show, Read, Eq, Ord, Enum, Bounded)
+
+submissionFileTypeIsUpdate :: SubmissionFileType -> Bool
+submissionFileTypeIsUpdate SubmissionOriginal = False
+submissionFileTypeIsUpdate SubmissionCorrected = True
+
+isUpdateSubmissionFileType :: Bool -> SubmissionFileType
+isUpdateSubmissionFileType False = SubmissionOriginal
+isUpdateSubmissionFileType True = SubmissionCorrected
+
+instance PathPiece SubmissionFileType where
+ toPathPiece SubmissionOriginal = "file"
+ toPathPiece SubmissionCorrected = "corrected"
+ fromPathPiece = enumFromPathPiece
+
+instance DisplayAble SubmissionFileType where
+ display SubmissionOriginal = "Abgabe"
+ display SubmissionCorrected = "Korrektur"
+
{-
data DA = forall a . (DisplayAble a) => DA a