fraport/fradrive
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

79
src/Handler/Submission.hs
View File

@ -314,47 +314,48 @@ submissionHelper tid ssh csh shn mcid = do
csheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn
maySubmit <- (== Authorized) <$> evalAccessDB actionUrl True
isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True
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 uid
E.&&. submission E.^. SubmissionSheet E.==. E.val shid
return $ submission E.^. SubmissionId
case (msmid, submissions) of
(Nothing, E.Value smid : _) -> 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
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 uid
E.&&. submission E.^. SubmissionSheet E.==. E.val shid
return $ submission E.^. SubmissionId
-- logDebugS "Submission.DUPLICATENEW" (tshow submissions)
case submissions of
[] -> do
-- fetch buddies from previous submission in this course
buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` subUser `E.InnerJoin` submissionEdit) -> do
E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId)
E.on (subUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId)
E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheet)
E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
E.&&. sheet E.^. SheetCourse E.==. E.val sheetCourse
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
E.limit 1
return $ submission E.^. SubmissionId
E.where_ $ submissionUser E.^. SubmissionUserSubmission `E.in_` oldids
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
E.orderBy [E.asc $ user E.^. UserEmail]
return $ user E.^. UserId
return ( csheet
, buddies
& map (Right . E.unValue)
& Set.fromList
& assertM' ((<= maxBuddies) . fromIntegral . Set.size . bool id (Set.insert $ Right uid) (not isLecturer))
& fromMaybe Set.empty
, []
, maySubmit
, isLecturer
, not isLecturer
)
(E.Value smid:_) -> do
cID <- encrypt smid
addMessageI Info MsgSubmissionAlreadyExists
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
-- fetch buddies from previous submission in this course
buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` subUser `E.InnerJoin` submissionEdit) -> do
E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId)
E.on (subUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId)
E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheet)
E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
E.&&. sheet E.^. SheetCourse E.==. E.val sheetCourse
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
E.limit 1
return $ submission E.^. SubmissionId
E.where_ $ submissionUser E.^. SubmissionUserSubmission `E.in_` oldids
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
E.orderBy [E.asc $ user E.^. UserEmail]
return $ user E.^. UserId
return ( csheet
, buddies
& map (Right . E.unValue)
& Set.fromList
& assertM' ((<= maxBuddies) . fromIntegral . Set.size . bool id (Set.insert $ Right uid) (not isLecturer))
& fromMaybe Set.empty
, []
, maySubmit
, isLecturer
, not isLecturer
)
(Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer) -- TODO: Return registered group members
(Just smid, _) -> do
void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid)