103 lines
6.0 KiB
Haskell
103 lines
6.0 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.Sheet.Download
|
|
( getSArchiveR, getSFileR, getSZipR
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Utils.Sheet
|
|
import Handler.Utils
|
|
|
|
import qualified Data.Conduit.Combinators as C
|
|
|
|
import qualified Database.Esqueleto.Legacy as E
|
|
import qualified Database.Esqueleto.Utils as E
|
|
|
|
|
|
getSArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent
|
|
getSArchiveR tid ssh csh shn = do
|
|
shId <- runDB $ fetchSheetId tid ssh csh shn
|
|
muid <- maybeAuthId
|
|
|
|
MsgRenderer mr <- getMsgRenderer
|
|
let archiveName = flip addExtension (unpack extensionZip) . unpack . mr $ MsgSheetArchiveName tid ssh csh shn
|
|
let sftArchive = CSheetR tid ssh csh shn . SZipR -- used to check access to SheetFileTypes
|
|
allowedSFTs <- filterM (hasReadAccessTo . sftArchive) universeF
|
|
multipleSFTs <- if
|
|
| length allowedSFTs < 2 -> return False
|
|
| otherwise -> runDB . E.selectExists . E.from $ \(sheet `E.InnerJoin` ((psFile1 `E.FullOuterJoin` sFile1) `E.InnerJoin` (psFile2 `E.FullOuterJoin` sFile2))) -> do
|
|
E.on $ sFile2 E.?. SheetFileSheet E.==. psFile2 E.?. PersonalisedSheetFileSheet
|
|
E.&&. sFile2 E.?. SheetFileType E.==. psFile2 E.?. PersonalisedSheetFileType
|
|
E.&&. sFile2 E.?. SheetFileTitle E.==. psFile2 E.?. PersonalisedSheetFileTitle
|
|
E.&&. psFile2 E.?. PersonalisedSheetFileUser E.==. E.val muid
|
|
|
|
E.on $ ( sFile1 E.?. SheetFileType E.!=. sFile2 E.?. SheetFileType
|
|
E.||. psFile1 E.?. PersonalisedSheetFileType E.!=. psFile2 E.?. PersonalisedSheetFileType
|
|
E.||. sFile1 E.?. SheetFileType E.!=. psFile2 E.?. PersonalisedSheetFileType
|
|
E.||. sFile2 E.?. SheetFileType E.!=. psFile1 E.?. PersonalisedSheetFileType
|
|
)
|
|
E.&&. ( sFile1 E.?. SheetFileTitle E.==. sFile2 E.?. SheetFileTitle
|
|
E.||. psFile1 E.?. PersonalisedSheetFileTitle E.==. psFile2 E.?. PersonalisedSheetFileTitle
|
|
E.||. sFile1 E.?. SheetFileTitle E.==. psFile2 E.?. PersonalisedSheetFileTitle
|
|
E.||. sFile2 E.?. SheetFileTitle E.==. psFile1 E.?. PersonalisedSheetFileTitle
|
|
)
|
|
|
|
E.on $ sFile1 E.?. SheetFileSheet E.==. psFile1 E.?. PersonalisedSheetFileSheet
|
|
E.&&. sFile1 E.?. SheetFileType E.==. psFile1 E.?. PersonalisedSheetFileType
|
|
E.&&. sFile1 E.?. SheetFileTitle E.==. psFile1 E.?. PersonalisedSheetFileTitle
|
|
E.&&. psFile1 E.?. PersonalisedSheetFileUser E.==. E.val muid
|
|
|
|
|
|
E.on $ (E.just (sheet E.^. SheetId) E.==. sFile1 E.?. SheetFileSheet E.||. E.just (sheet E.^. SheetId) E.==. psFile1 E.?. PersonalisedSheetFileSheet)
|
|
E.&&. (E.just (sheet E.^. SheetId) E.==. sFile2 E.?. SheetFileSheet E.||. E.just (sheet E.^. SheetId) E.==. psFile2 E.?. PersonalisedSheetFileSheet)
|
|
E.where_ $ sheet E.^. SheetId E.==. E.val shId
|
|
E.&&. (sFile1 E.?. SheetFileType `E.in_` E.justValList allowedSFTs E.||. psFile1 E.?. PersonalisedSheetFileType `E.in_` E.justValList allowedSFTs)
|
|
E.&&. (sFile2 E.?. SheetFileType `E.in_` E.justValList allowedSFTs E.||. psFile2 E.?. PersonalisedSheetFileType `E.in_` E.justValList allowedSFTs)
|
|
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile1 E.?. PersonalisedSheetFileUser)
|
|
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile2 E.?. PersonalisedSheetFileUser)
|
|
|
|
let
|
|
modifyTitles :: forall record. HasFileReference record => (record -> SheetFileType) -> record -> record
|
|
modifyTitles sft f
|
|
| not multipleSFTs = f
|
|
| otherwise = f & _FileReference . _1 . _fileReferenceTitle %~ (unpack (mr $ SheetArchiveFileTypeDirectory (sft f)) <//>)
|
|
sftDirectories <- if
|
|
| not multipleSFTs -> return mempty
|
|
| otherwise -> runDB . fmap (mapMaybe $ \(sft, mTime) -> (sft, ) <$> mTime) . forM allowedSFTs $ \sft -> fmap ((sft, ) . (=<<) E.unValue) . E.selectMaybe . E.from $ \(sFile `E.FullOuterJoin` psFile) -> do
|
|
E.on $ sFile E.?. SheetFileSheet E.==. psFile E.?. PersonalisedSheetFileSheet
|
|
E.&&. sFile E.?. SheetFileType E.==. psFile E.?. PersonalisedSheetFileType
|
|
E.&&. sFile E.?. SheetFileTitle E.==. psFile E.?. PersonalisedSheetFileTitle
|
|
E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
|
|
E.where_ $ (sFile E.?. SheetFileSheet E.==. E.justVal shId E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.justVal shId)
|
|
E.&&. (sFile E.?. SheetFileType E.==. E.justVal sft E.||. psFile E.?. PersonalisedSheetFileType E.==. E.justVal sft)
|
|
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
|
|
return . E.max_ $ E.unsafeCoalesce
|
|
[ sFile E.?. SheetFileModified
|
|
, psFile E.?. PersonalisedSheetFileModified
|
|
]
|
|
|
|
serveZipArchive archiveName $ do
|
|
forM_ sftDirectories $ \(sft, mTime) -> yield . Left $ SheetFile
|
|
{ sheetFileType = sft
|
|
, sheetFileTitle = unpack . mr $ SheetArchiveFileTypeDirectory sft
|
|
, sheetFileModified = mTime
|
|
, sheetFileContent = Nothing
|
|
, sheetFileSheet = shId
|
|
}
|
|
sheetFilesSFTsQuery tid ssh csh shn muid allowedSFTs .| C.map (entityVal `bimap` entityVal) .| C.map (modifyTitles sheetFileType `bimap` modifyTitles personalisedSheetFileType)
|
|
|
|
getSFileR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> FilePath -> Handler TypedContent
|
|
getSFileR tid ssh csh shn sft file = do
|
|
muid <- maybeAuthId
|
|
serveOneFile $ sheetFileQuery tid ssh csh shn muid sft file
|
|
|
|
getSZipR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> Handler TypedContent
|
|
getSZipR tid ssh csh shn sft = do
|
|
muid <- maybeAuthId
|
|
sft' <- ap getMessageRender $ pure sft
|
|
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack). ap getMessageRender . pure $ MsgSheetTypeArchiveName tid ssh csh shn sft'
|
|
serveSomeFiles archiveName $ sheetFilesAllQuery tid ssh csh shn muid sft
|