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

refactor(submission-own-r): add comment explaining behaviour

Browse Source
This commit is contained in:
Gregor Kleen 2020-08-10 12:08:18 +02:00
parent 65c85e7607
commit 99c810b82e
2 changed files with 24 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
routes
View File

@ -153,7 +153,7 @@
/delete SDelR GET POST
/subs SSubsR GET POST -- for lecturer only
!/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissionsANDsubmission-groupANDexam-registered
!/subs/own SubmissionOwnR GET !free
!/subs/own SubmissionOwnR GET !free
!/subs/assign SAssignR GET POST !lecturerANDtime
/subs/#CryptoFileNameSubmission SubmissionR:
/ SubShowR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registered !ownerANDread !correctorANDread

35
src/Handler/Submission.hs
View File

@ -28,23 +28,34 @@ import Handler.Submission.Upload
import Import
import Handler.Utils
import qualified Database.Esqueleto as E
getSubmissionOwnR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
-- For security reasons (unauthorized users not being allowed to have
-- guesses about which sheets/courses exist confirmed) this handlers
-- behaviour may not allow users to distinguish between:
-- - course does not exist (answers 404)
-- - course exists but sheet does not (answers 404)
-- - course and sheet exist but user has no submission (answers 404)
-- - course and sheet exist, user has submission, but is not
-- authorized to know course/sheet/submission exists (impossible,
-- because @!ownerANDread@ is sufficient for access to `SubShowR`;
-- having access to `SubShowR` allows user to determine
-- course/sheet from url)
getSubmissionOwnR tid ssh csh shn = do
authId <- requireAuthId
sid <- runDB $ do
shid <- fetchSheetId tid ssh csh shn
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val authId
E.&&. submission E.^. SubmissionSheet E.==. E.val shid
sid <- runDB . maybeT notFound $ do
submissions <- lift . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) -> do
E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val authId
E.&&. 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
return $ submission E.^. SubmissionId
case submissions of
(E.Value sid : _) -> return sid
[] -> notFound
hoistMaybe $ submissions ^? _head . _Value
cID <- encrypt sid
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
redirectAccess $ CSubmissionR tid ssh csh shn cID SubShowR