module Handler.Sheet.Show ( getSShowR ) where import Import hiding (link) import Handler.Utils import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E import qualified Data.Map as Map import Handler.Sheet.Pseudonym import Utils.Sheet getSShowR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html getSShowR tid ssh csh shn = do now <- liftIO getCurrentTime muid <- maybeAuthId Entity sid sheet <- runDB $ fetchSheet tid ssh csh shn seeAllModificationTimestamps <- hasReadAccessTo $ CSheetR tid ssh csh shn SIsCorrR -- ordinary users should not see modification dates older than visibility let sftVisible :: IsDBTable m a => SheetFileType -> DBCell m a sftVisible sft | Just dts <- sheetFileTypeDates sheet sft = dateTimeCellVisible now dts | otherwise = isVisibleCell False sftModification :: IsDBTable m a => SheetFileType -> UTCTime -> DBCell m a sftModification sft mtime | seeAllModificationTimestamps = dateTimeCell mtime | NTop (Just mtime) > NTop (sheetFileTypeDates sheet sft) = dateTimeCell mtime | otherwise = mempty let fileData (sheetFile `E.FullOuterJoin` psFile) = do E.on $ sheetFile E.?. SheetFileTitle E.==. psFile E.?. PersonalisedSheetFileTitle E.&&. sheetFile E.?. SheetFileType E.==. psFile E.?. PersonalisedSheetFileType E.&&. sheetFile E.?. SheetFileSheet E.==. psFile E.?. PersonalisedSheetFileSheet E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid -- filter to requested file E.where_ $ (sheetFile E.?. SheetFileSheet E.==. E.justVal sid E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.justVal sid) E.&&. E.maybe (E.isJust . E.joinV $ sheetFile E.?. SheetFileContent) E.isJust (psFile E.?. PersonalisedSheetFileContent) -- don't show directories E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser) -- return desired columns return ( E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileTitle, sheetFile E.?. SheetFileTitle] , E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileModified, sheetFile E.?. SheetFileModified] , E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileType, sheetFile E.?. SheetFileType] , E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileContent, sheetFile E.?. SheetFileContent] ) let colonnadeFiles = widgetColonnade $ mconcat [ sortable (Just "type") (i18nCell MsgSheetFileTypeHeader) $ \(_,_, E.Value ftype, _) -> let link = CSheetR tid ssh csh shn $ SZipR ftype in tellCell (Any True) $ anchorCell link [whamlet|#{sheetFile2markup ftype} _{ftype}|] -- i18nCell ftype & cellContents %~ (\act -> act <* tell (Any True)) -- , colFilePath (view _1) (\row -> let fType = view _3 row in let fName = view _1 row in (CSheetR tid ssh csh shn (SFileR (E.unValue fType) (E.unValue fName)))) , sortable (Just "path") (i18nCell MsgTableFileTitle) $ \(E.Value fName, _, E.Value fType, _) -> anchorCell (CSheetR tid ssh csh shn $ SFileR fType fName) (str2widget fName) , sortable (toNothing "visible") (i18nCell MsgSheetVisibleFrom) $ \(_, _ , E.Value ftype, _) -> sftVisible ftype , sortable (Just "time") (i18nCell MsgTableFileModified) $ \(_,E.Value modified, E.Value ftype, _) -> sftModification ftype modified -- , colFileModification (view _2) ] let psValidator = def & defaultSorting [SortAscBy "type", SortAscBy "path"] & forceFilter "may-access" (Any True) (Any hasFiles, fileTable) <- runDB $ dbTable psValidator DBTable { dbtSQLQuery = fileData , dbtRowKey = \(sheetFile `E.FullOuterJoin` psFile) -> (sheetFile E.?. SheetFileId, psFile E.?. PersonalisedSheetFileId) , dbtColonnade = colonnadeFiles , dbtProj = (dbrOutput :: _ -> (E.Value FilePath, E.Value UTCTime, E.Value SheetFileType, E.Value (Maybe FileContentReference))) <$> dbtProjFilteredPostId , dbtStyle = def , dbtFilter = mconcat [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) DBRow{ dbrOutput = (E.Value fName, _ :: E.Value UTCTime, E.Value fType, _ :: E.Value (Maybe FileContentReference)) } -> (==b) <$> hasReadAccessTo (CSheetR tid ssh csh shn $ SFileR fType fName) :: DB Bool ] , dbtFilterUI = mempty , dbtIdent = "files" :: Text , dbtSorting = Map.fromList [ ( "type" , SortColumn $ \(sheetFile `E.FullOuterJoin` psFile) -> E.orderByEnum $ E.unsafeCoalesce [sheetFile E.?. SheetFileType, psFile E.?. PersonalisedSheetFileType] ) , ( "path" , SortColumn $ \(sheetFile `E.FullOuterJoin` psFile) -> E.unsafeCoalesce [sheetFile E.?. SheetFileTitle, psFile E.?. PersonalisedSheetFileTitle] ) -- , ( "visible" -- , SortColumn $ \(sheetFile `E.InnerJoin` _file) -> sheetFileTypeDates sheet $ sheetFile E.^. SheetFileType -- not possible without another join for the sheet -- ) , ( "time" , SortColumn $ \(sheetFile `E.FullOuterJoin` psFile) -> E.unsafeCoalesce [sheetFile E.?. SheetFileModified, psFile E.?. PersonalisedSheetFileModified] ) ] , dbtParams = def , dbtCsvEncode = noCsvEncode , dbtCsvDecode = Nothing , dbtExtraReps = [] } (hasHints, hasSolution) <- runDB $ do hasHints <- E.selectExists . E.from $ \sheet' -> E.where_ $ hasSheetFileQuery sheet' (E.val muid) SheetHint E.&&. sheet' E.^. SheetId E.==. E.val sid hasSolution <- E.selectExists . E.from $ \sheet' -> E.where_ $ hasSheetFileQuery sheet' (E.val muid) SheetSolution E.&&. sheet' E.^. SheetId E.==. E.val sid return (hasHints, hasSolution) mPseudonym <- runMaybeT $ do uid <- MaybeT maybeAuthId Entity _ SheetPseudonym{sheetPseudonymPseudonym} <- MaybeT . runDB . getBy $ UniqueSheetPseudonymUser sid uid return $ review _PseudonymText sheetPseudonymPseudonym (generateWidget, generateEnctype) <- generateFormPost $ \csrf -> over _2 ((toWidget csrf <>) . fvWidget) <$> mreq (buttonField BtnGenerate) "" Nothing let generateForm = wrapForm generateWidget def { formAction = Just . SomeRoute $ CSheetR tid ssh csh shn SPseudonymR , formEncoding = generateEnctype , formSubmit = FormNoSubmit } checkExamRegistration <- orM [ wouldHaveWriteAccessToIff [(AuthExamRegistered, True)] $ CSheetR tid ssh csh shn SubmissionNewR , wouldHaveReadAccessToIff [(AuthExamRegistered, True)] $ CSheetR tid ssh csh shn SArchiveR ] mRequiredExam <- fmap join . for (guardOnM checkExamRegistration $ sheetRequireExamRegistration sheet) $ \eId -> fmap (fmap $(E.unValueN 4)) . runDB . E.selectMaybe . E.from $ \(exam `E.InnerJoin` course) -> do E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId E.where_ $ exam E.^. ExamId E.==. E.val eId return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand, exam E.^. ExamName) mRequiredExamLink <- runMaybeT $ do (etid, essh, ecsh, examn) <- hoistMaybe mRequiredExam let eUrl = CExamR etid essh ecsh examn EShowR guardM . lift $ hasReadAccessTo eUrl return eUrl mMissingExamRegistration <- for (guardOnM checkExamRegistration $ sheetRequireExamRegistration sheet) $ \eId -> maybeT (return True) $ do uid <- MaybeT maybeAuthId lift . fmap not . runDB $ exists [ ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid ] checkPersonalisedFiles <- andM [ return . not $ sheetAllowNonPersonalisedSubmission sheet , return $ NTop (sheetActiveFrom sheet) <= NTop (Just now), return $ NTop (Just now) <= NTop (sheetActiveTo sheet) , wouldHaveWriteAccessToIff [(AuthPersonalisedSheetFiles, True)] $ CSheetR tid ssh csh shn SubmissionNewR ] mMissingPersonalisedFiles <- for (guardOnM checkPersonalisedFiles muid) $ \uid -> runDB $ fmap not . E.selectExists . E.from $ \psFile -> E.where_ $ psFile E.^. PersonalisedSheetFileUser E.==. E.val uid E.&&. psFile E.^. PersonalisedSheetFileSheet E.==. E.val sid submissionModeNoneWithoutNotGradedWarning <- runMaybeT $ do guard $ classifySubmissionMode (sheetSubmissionMode sheet) == SubmissionModeNone && sheetType sheet /= NotGraded guardM . lift . hasWriteAccessTo $ CSheetR tid ssh csh shn SEditR return $ notification NotificationBroad =<< messageI Warning MsgSheetSubmissionModeNoneWithoutNotGraded sTypeDesc <- runDB $ sheetTypeDescription (sheetCourse sheet) (sheetType sheet) defaultLayout $ do setTitleI $ prependCourseTitle tid ssh csh $ SomeMessage shn let zipLink = CSheetR tid ssh csh shn SArchiveR visibleFrom = visibleUTCTime SelFormatDateTime <$> sheetVisibleFrom sheet hasSubmission = classifySubmissionMode (sheetSubmissionMode sheet) /= SubmissionModeNone sheetFrom <- traverse (formatTime SelFormatDateTime) $ sheetActiveFrom sheet sheetTo <- traverse (formatTime SelFormatDateTime) $ sheetActiveTo sheet hintsFrom <- traverse (formatTime SelFormatDateTime) $ sheetHintFrom sheet solutionFrom <- traverse (formatTime SelFormatDateTime) $ sheetSolutionFrom sheet markingText <- runMaybeT $ assertM_ (Authorized ==) (lift $ evalAccessCorrector tid ssh csh) >> hoistMaybe (sheetMarkingText sheet) submissionTip <- messageI Info MsgSheetCorrectorSubmissionsTip tr <- getTranslate $(widgetFile "sheetShow")