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

fix(new-submissions): always check for existing sub

Browse Source
This commit is contained in:
Gregor Kleen 2019-12-02 11:15:16 +01:00
parent 1a4449cea9
commit c7d23e64ff
1 changed files with 40 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Handler/Submission.hs
View File

@ -314,16 +314,21 @@ submissionHelper tid ssh csh shn mcid = do
csheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn csheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn
maySubmit <- (== Authorized) <$> evalAccessDB actionUrl True maySubmit <- (== Authorized) <$> evalAccessDB actionUrl True
isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True
case (msmid, sheetGrouping) of
(Nothing, Arbitrary maxBuddies) -> do
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission) E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
E.&&. submission E.^. SubmissionSheet E.==. E.val shid E.&&. submission E.^. SubmissionSheet E.==. E.val shid
return $ submission E.^. SubmissionId return $ submission E.^. SubmissionId
-- logDebugS "Submission.DUPLICATENEW" (tshow submissions) case (msmid, submissions) of
case submissions of (Nothing, E.Value smid : _) -> do
[] -> do cID <- encrypt smid
addMessageI Info MsgSubmissionAlreadyExists
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
_other -> return ()
case (msmid, sheetGrouping) of
(Nothing, Arbitrary maxBuddies) -> do
-- fetch buddies from previous submission in this course -- fetch buddies from previous submission in this course
buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId) E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
@ -351,10 +356,6 @@ submissionHelper tid ssh csh shn mcid = do
, isLecturer , isLecturer
, not isLecturer , not isLecturer
) )
(E.Value smid:_) -> do
cID <- encrypt smid
addMessageI Info MsgSubmissionAlreadyExists
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
(Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer) -- TODO: Return registered group members (Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer) -- TODO: Return registered group members
(Just smid, _) -> do (Just smid, _) -> do
void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid) void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid)