fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

avoid single file zip for material as well

Browse Source
This commit is contained in:
Steffen Jost 2019-05-10 12:51:00 +02:00
parent 08d5d818ef
commit 0129e6d534
2 changed files with 25 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
routes
View File

@ -122,8 +122,8 @@
/delete MDelR GET POST
/show MShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
/load/*FilePath MFileR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
-- Besser wäre #{ZIPArchiveName MaterialName} auf höherer Ebene, aber dann muss evalAccess angepasst werden um beide Top-Level routen zu behandeln
/zip MArchiveR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
/download MArchiveR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
/zip MZipR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
/tuts CTutorialListR GET !tutor
/tuts/new CTutorialNewR GET POST
/tuts/#TutorialName TutorialR:

29
src/Handler/Material.hs
View File

@ -94,8 +94,8 @@ getMaterialListR tid ssh csh = do
let matLink :: MaterialName -> Route UniWorX
matLink = CourseR tid ssh csh . flip MaterialR MShowR
zipLink :: MaterialName -> Route UniWorX
zipLink = CourseR tid ssh csh . flip MaterialR MArchiveR
filesLink :: MaterialName -> Route UniWorX
filesLink = CourseR tid ssh csh . flip MaterialR MArchiveR
materialModDateCell :: IsDBTable m a => Material -> DBCell m a
materialModDateCell Material{materialVisibleFrom, materialLastEdit}
@ -128,7 +128,7 @@ getMaterialListR tid ssh csh = do
, sortable (toNothingS "description") mempty
$ foldMap modalCell . materialDescription . row2material
, sortable (toNothingS "zip-archive") mempty -- TODO: don't show if there are no files!
$ zipCell . zipLink . materialName . row2material
$ fileCell . filesLink . materialName . row2material
, sortable (Just "visible-from") (i18nCell MsgAccessibleSince)
$ foldMap (dateTimeCellVisible now) . materialVisibleFrom . row2material
, sortable (Just "last-edit") (i18nCell MsgFileModified)
@ -180,7 +180,7 @@ getMShowR tid ssh csh mnm = do
matLink = CourseR tid ssh csh . MaterialR mnm . MFileR
zipLink :: Route UniWorX
zipLink = CMaterialR tid ssh csh mnm MArchiveR
zipLink = CMaterialR tid ssh csh mnm MZipR
seeAllModificationTimestamps <- hasReadAccessTo $ CourseR tid ssh csh CNotesR -- ordinary users should not see modification dates older than visibility
@ -350,8 +350,9 @@ postMDelR tid ssh csh mnm = do
, drAbort = SomeRoute $ CourseR tid ssh csh $ MaterialR mnm MShowR
}
getMArchiveR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler TypedContent
getMArchiveR tid ssh csh mnm = do
-- | Variant of getMArchiveR that always serves a Zip Archive, even for single files. Kept, since we might change this according to UX feedback.
getMZipR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler TypedContent
getMZipR tid ssh csh mnm = do
let filename = ZIPArchiveName mnm
addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece filename}"|]
respondSourceDB "application/zip" $ do
@ -364,3 +365,19 @@ getMArchiveR tid ssh csh mnm = do
return file
zipComment = Text.encodeUtf8 $ termToText (unTermKey tid) <> "-" <> toPathPiece (unSchoolKey ssh <> "-" <> csh <> ":" <> mnm)
fileSelect .| C.map entityVal .| produceZip ZipInfo{..} .| C.map toFlushBuilder
-- | Variant of getMZipR that does not serve single file Zip Archives. Maybe confusing to users.
getMArchiveR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler TypedContent
getMArchiveR tid ssh csh mnm = serveSomeFiles archivename getMatQuery
where
archivename = termToText (unTermKey tid) <> "-" <> toPathPiece (unSchoolKey ssh <> "-" <> csh <> "-" <> mnm)
getMatQuery = E.select . E.from $
\(course `E.InnerJoin` material `E.InnerJoin` materialFile `E.InnerJoin` file) -> do
E.on $ file E.^. FileId E.==. materialFile E.^. MaterialFileFile
E.on $ material E.^. MaterialId E.==. materialFile E.^. MaterialFileMaterial
E.on $ material E.^. MaterialCourse E.==. course E.^. CourseId
E.where_ $ course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
E.&&. material E.^. MaterialName E.==. E.val mnm
return file