Permit downloading original archives

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

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"

src/Handler/Submission.hs

@@ -252,8 +252,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
               | otherwise               -> textCell $ bool (<> "/") id isFile fileTitle'
         , sortable Nothing (cell mempty) $ \(coalesce -> (_, mCorr)) -> case mCorr of
             Nothing -> cell mempty
-            Just (Entity _ SubmissionFile{..}, Entity _ File{..})
-              | submissionFileIsDeletion -> textCell MsgFileCorrectedDeleted
+            Just (_, Entity _ File{..})
               | isJust fileContent -> anchorCell (\() -> CSubmissionR tid csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
                                                  (\() -> [whamlet|_{MsgFileCorrected}|])
                                                  ()
@@ -327,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

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"

templates/submission.hamlet

@@ -1,7 +1,7 @@
 $maybe cID <- mcid
   <section style="padding-bottom:1em; margin-bottom:1em; border-bottom:1px solid black;">
     <h2>
-      <a href=@{CSubmissionR tid csh shn cID SubArchiveR}>Archiv
+      <a href=@{CSubmissionR tid csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))}>Archiv
     $forall (name,time) <- lastEdits
       <div>last edited by #{name} at #{formatTimeGerDTlong time}
     $maybe fileTable <- mFileTable