diff --git a/messages/de.msg b/messages/de.msg index 691a139d1..c1be8c45e 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -170,6 +170,7 @@ FileTitle: Dateiname FileModified: Letzte Änderung FileCorrected: Korrigiert +FileCorrectedDeleted: Korrigiert (gelöscht) RatingUpdated: Korrektur gespeichert RatingDeleted: Korrektur zurückgesetzt RatingFilesUpdated: Korrigierte Dateien überschrieben \ No newline at end of file diff --git a/routes b/routes index 80b2e5857..74b845e0c 100644 --- a/routes +++ b/routes @@ -64,7 +64,7 @@ /subs/own SubmissionOwnR GET !free -- just redirect /sub/#CryptoFileNameSubmission SubmissionR !corrector: / SubShowR GET POST !ownerANDtime !ownerANDisRead - /archive SubArchiveR GET !owner + /archive/#{ZIPArchiveName SubmissionFileType} SubArchiveR GET !owner /correction CorrectionR GET POST !ownerANDisRead !/#SubmissionFileType/*FilePath SubDownloadR GET !owner /correctors SCorrR GET POST diff --git a/src/CryptoID.hs b/src/CryptoID.hs index 28fb616d1..b8b4b2eed 100644 --- a/src/CryptoID.hs +++ b/src/CryptoID.hs @@ -75,12 +75,3 @@ instance PathPiece SubmissionMode where toPathPiece (SubmissionMode (Just x)) = toPathPiece x -newtype ZIPArchiveName objID = ZIPArchiveName (CryptoID (CI FilePath) objID) - deriving (Show, Read, Eq) - -instance PathPiece (ZIPArchiveName objID) where - fromPathPiece (map CI.mk . unpack -> s) - | Just s' <- stripSuffix (map CI.mk ".zip") s = Just . ZIPArchiveName . CryptoID . CI.mk $ map CI.original s' - | otherwise = Nothing - - toPathPiece (ZIPArchiveName CryptoID{..}) = pack (CI.foldedCase ciphertext) <> ".zip" diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index d5ab0d592..714f5b617 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -270,7 +270,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do E.on $ f2 E.?. FileId E.==. sf2 E.?. SubmissionFileFile E.on $ f1 E.?. FileTitle E.==. f2 E.?. FileTitle E.&&. sf1 E.?. SubmissionFileSubmission E.==. sf2 E.?. SubmissionFileSubmission - E.&&. f1 E.?. FileId E.!=. f2 E.?. FileId + E.&&. sf1 E.?. SubmissionFileId E.!=. sf2 E.?. SubmissionFileId E.on $ f1 E.?. FileId E.==. sf1 E.?. SubmissionFileFile E.where_ $ (sf1 E.?. SubmissionFileIsUpdate E.==. E.val (Just False) E.||. E.isNothing (sf1 E.?. SubmissionFileIsUpdate)) @@ -326,20 +326,30 @@ getSubDownloadR tid csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = [Entity _ File{ fileContent = Just c }] -> return $ TypedContent (defaultMimeLookup fileName <> "; charset=utf-8") (toContent c) _ -> notFound -getSubArchiveR :: TermId -> Text -> Text -> CryptoFileNameSubmission -> Handler TypedContent -getSubArchiveR tid csh shn cID@CryptoID{..} = do +getSubArchiveR :: TermId -> Text -> Text -> CryptoFileNameSubmission -> ZIPArchiveName SubmissionFileType -> Handler TypedContent +getSubArchiveR tid csh shn cID@CryptoID{..} (ZIPArchiveName sfType) = do submissionID <- decrypt cID - addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece cID}.zip"|] + addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece cID}-#{toPathPiece sfType}.zip"|] respondSourceDB "application/zip" $ do lift $ submissionMatchesSheet tid csh shn cID rating <- lift $ getRating submissionID - case rating of - Nothing -> lift notFound - 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 } - fileEntitySource' =$= produceZip info =$= Conduit.map toFlushBuilder + + let + fileSource = case sfType of + SubmissionOriginal -> E.selectSource . 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.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False + return f + _ -> submissionFileSource submissionID + + fileSource' = do + fileSource .| Conduit.map entityVal + maybe (return ()) (yieldM . ratingFile cID) rating + + zipComment = Text.encodeUtf8 . pack $ CI.foldedCase ciphertext + + fileSource' .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder diff --git a/src/Model/Types.hs b/src/Model/Types.hs index b19a851f1..f202f6eb9 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -5,6 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ViewPatterns #-} {-- # LANGUAGE ExistentialQuantification #-} -- for DA type module Model.Types where @@ -106,7 +107,7 @@ isUpdateSubmissionFileType False = SubmissionOriginal isUpdateSubmissionFileType True = SubmissionCorrected instance PathPiece SubmissionFileType where - toPathPiece SubmissionOriginal = "file" + toPathPiece SubmissionOriginal = "original" toPathPiece SubmissionCorrected = "corrected" fromPathPiece = enumFromPathPiece @@ -281,3 +282,14 @@ instance Default Theme where -} derivePersistField "Theme" + + +newtype ZIPArchiveName obj = ZIPArchiveName obj + deriving (Show, Read, Eq) + +instance PathPiece obj => PathPiece (ZIPArchiveName obj) where + fromPathPiece (map CI.mk . unpack -> s) + | Just s' <- stripSuffix (map CI.mk ".zip") s = fromPathPiece . pack $ map CI.original s' + | otherwise = Nothing + + toPathPiece (ZIPArchiveName obj) = toPathPiece obj <> ".zip" diff --git a/templates/submission.hamlet b/templates/submission.hamlet index 78f449800..476ee179a 100644 --- a/templates/submission.hamlet +++ b/templates/submission.hamlet @@ -1,7 +1,7 @@ $maybe cID <- mcid

- Archiv + Archiv $forall (name,time) <- lastEdits
last edited by #{name} at #{formatTimeGerDTlong time} $maybe fileTable <- mFileTable