Fixes #257

routes

@@ -99,6 +99,7 @@
   /ex/unassigned              SheetOldUnassignedR  GET
   /ex/#SheetName SheetR:
     /show                       SShowR         GET             !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor
+    /show/download              SArchiveR      GET             !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor
     /edit                       SEditR         GET POST
     /delete                     SDelR          GET POST
     /subs                       SSubsR         GET POST        -- for lecturer only

src/Handler/Sheet.hs

@@ -425,7 +425,8 @@ getSShowR tid ssh csh shn = do
 
   defaultLayout $ do
     setTitleI $ prependCourseTitle tid ssh csh $ SomeMessage shn
-    let visibleFrom =     visibleUTCTime SelFormatDateTime <$> sheetVisibleFrom  sheet
+    let zipLink = CSheetR tid ssh csh shn SArchiveR
+        visibleFrom =     visibleUTCTime SelFormatDateTime <$> sheetVisibleFrom  sheet
     sheetFrom    <-           formatTime SelFormatDateTime  $  sheetActiveFrom   sheet
     sheetTo      <-           formatTime SelFormatDateTime  $  sheetActiveTo     sheet
     hintsFrom    <- traverse (formatTime SelFormatDateTime) $  sheetHintFrom     sheet
@@ -433,6 +434,15 @@ getSShowR tid ssh csh shn = do
     markingText  <- runMaybeT $ assertM_ (Authorized ==) (evalAccessCorrector tid ssh csh) >> hoistMaybe (sheetMarkingText sheet)
     $(widgetFile "sheetShow")
 
+getSArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent
+getSArchiveR tid ssh csh shn = do
+  MsgRenderer mr <- getMsgRenderer
+  let archiveName = (unpack . stripAll $ mr (prependCourseTitle tid ssh csh $ SomeMessage shn)) <.> "zip"
+      sftArchive  = CSheetR tid ssh csh shn . SZipR    -- used to check access to SheetFileTypes
+  allowedSFTs <- filterM (hasReadAccessTo . sftArchive) [minBound..maxBound]
+  serveZipArchive archiveName $ sheetFilesSFTsQuery tid ssh csh shn allowedSFTs .| C.map entityVal
+
+
 getSPseudonymR, postSPseudonymR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent
 getSPseudonymR = postSPseudonymR
 postSPseudonymR tid ssh csh shn = do
@@ -462,8 +472,10 @@ getSFileR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType
 getSFileR tid ssh csh shn sft file = serveOneFile $ sheetFileQuery tid ssh csh shn sft file .| C.map entityVal
 
 getSZipR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> Handler TypedContent
-getSZipR tid ssh csh shn sft
-  = serveSomeFiles (unpack (toPathPiece sft) <.> "zip") $ sheetFilesAllQuery tid ssh csh shn sft .| C.map entityVal
+getSZipR tid ssh csh shn sft = do
+  MsgRenderer mr <- getMsgRenderer
+  let archiveName = (unpack . stripAll $ mr (prependCourseTitle tid ssh csh $ SomeMessage shn)) <> "_" <> (unpack $ toPathPiece sft) <.> "zip"
+  serveSomeFiles archiveName $ sheetFilesAllQuery tid ssh csh shn sft .| C.map entityVal
 
 
 getSheetNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html

src/Handler/Utils.hs

@@ -93,6 +93,23 @@ serveSomeFiles archiveName source = do
         let zipComment = T.encodeUtf8 $ pack archiveName
         source .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
 
+-- | Serve any number of files as a zip-archive of files, identified through a given DB query
+--
+-- Like `serveSomeFiles`, but always sends a zip-archive, even if a single file is returned
+serveZipArchive :: FilePath -> Source (YesodDB UniWorX) File -> Handler TypedContent
+serveZipArchive archiveName source = do
+  results <- runDB . runConduit $ source .| peekN 2
+
+  $logDebugS "serveZipArchive" . tshow $ length results
+
+  case results of
+    []         -> notFound
+    _moreFiles -> do
+      setContentDisposition' $ Just archiveName
+      respondSourceDB "application/zip" $ do
+        let zipComment = T.encodeUtf8 $ pack archiveName
+        source .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
+
 
 
 ---------

src/Utils.hs

@@ -204,6 +204,10 @@ boolSymbol False = fontAwesomeIcon "times"
 -- tickmark :: IsString a => a
 -- tickmark = fromString "✔"
 
+-- | remove all Whitespace from Text
+stripAll :: Text -> Text
+stripAll = Text.filter (not . isSpace)
+
 -- | Convert text as it is to Html, may prevent ambiguous types
 -- This function definition is mainly for documentation purposes
 text2Html :: Text -> Html
@@ -883,7 +887,7 @@ encodedSecretBoxOpen' :: (FromJSON a, MonadError EncodedSecretBoxException m)
                       => SecretBox.Key
                       -> Text -> m a
 encodedSecretBoxOpen' sKey chunked = do
-  let unchunked = Text.filter (not . isSpace) chunked
+  let unchunked = stripAll chunked
   decoded <- either (throwError . EncodedSecretBoxInvalidBase64) return . Base64.decode $ encodeUtf8 unchunked
 
   unless (BS.length decoded >= Saltine.secretBoxNonce + Saltine.secretBoxMac) $

src/Utils/Sheet.hs

@@ -74,11 +74,29 @@ sheetFilesAllQuery tid ssh csh shn sft = E.selectSource $ E.from $
   E.on (sFile E.^. SheetFileSheet E.==. sheet  E.^. SheetId)
   E.on (sheet E.^. SheetCourse    E.==. course E.^. CourseId)
   -- filter to requested file
-  E.where_ ((sFile  E.^. SheetFileType   E.==. E.val sft  )
-    E.&&.   (sheet  E.^. SheetName       E.==. E.val shn  )
+  E.where_ ((sheet  E.^. SheetName       E.==. E.val shn  )
     E.&&.   (course E.^. CourseShorthand E.==. E.val csh  )
     E.&&.   (course E.^. CourseSchool    E.==. E.val ssh  )
     E.&&.   (course E.^. CourseTerm      E.==. E.val tid  )
+    E.&&.   (sFile  E.^. SheetFileType   E.==. E.val sft  )
+    )
+  -- return file entity
+  return file
+
+-- | Return all files of certain `SheetFileTypes` for a `Sheet`
+sheetFilesSFTsQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> [SheetFileType] -> Source (SqlPersistT m) (Entity File)
+sheetFilesSFTsQuery tid ssh csh shn sfts = E.selectSource $ E.from $
+  \(course `E.InnerJoin` sheet `E.InnerJoin` sFile `E.InnerJoin` file) -> do
+  -- Restrict to consistent rows that correspond to each other
+  E.on (file  E.^. FileId         E.==. sFile  E.^. SheetFileFile)
+  E.on (sFile E.^. SheetFileSheet E.==. sheet  E.^. SheetId)
+  E.on (sheet E.^. SheetCourse    E.==. course E.^. CourseId)
+  -- filter to requested file
+  E.where_ ((sheet  E.^. SheetName       E.==.  E.val shn      )
+    E.&&.   (course E.^. CourseShorthand E.==.  E.val csh      )
+    E.&&.   (course E.^. CourseSchool    E.==.  E.val ssh      )
+    E.&&.   (course E.^. CourseTerm      E.==.  E.val tid      )
+    E.&&.   (sFile  E.^. SheetFileType  `E.in_` E.valList sfts )
     )
   -- return file entity
   return file

templates/sheetShow.hamlet

@@ -52,5 +52,5 @@ $maybe marktxt <- markingText
 
 $if hasFiles
   <section>
-    <h2>_{MsgSheetFiles}
+    <h2>^{simpleLinkI (SomeMessage MsgSheetFiles) zipLink}
     ^{fileTable}