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 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
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 case (msmid, sheetGrouping) of
(Nothing, Arbitrary maxBuddies) -> do (Nothing, Arbitrary maxBuddies) -> do
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do -- fetch buddies from previous submission in this course
E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission) buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
E.&&. submission E.^. SubmissionSheet E.==. E.val shid let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` subUser `E.InnerJoin` submissionEdit) -> do
return $ submission E.^. SubmissionId E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId)
-- logDebugS "Submission.DUPLICATENEW" (tshow submissions) E.on (subUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId)
case submissions of E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheet)
[] -> do E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
-- fetch buddies from previous submission in this course E.&&. sheet E.^. SheetCourse E.==. E.val sheetCourse
buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId) E.limit 1
let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` subUser `E.InnerJoin` submissionEdit) -> do return $ submission E.^. SubmissionId
E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId) E.where_ $ submissionUser E.^. SubmissionUserSubmission `E.in_` oldids
E.on (subUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId) E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheet) E.orderBy [E.asc $ user E.^. UserEmail]
E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid return $ user E.^. UserId
E.&&. sheet E.^. SheetCourse E.==. E.val sheetCourse return ( csheet
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime] , buddies
E.limit 1 & map (Right . E.unValue)
return $ submission E.^. SubmissionId & Set.fromList
E.where_ $ submissionUser E.^. SubmissionUserSubmission `E.in_` oldids & assertM' ((<= maxBuddies) . fromIntegral . Set.size . bool id (Set.insert $ Right uid) (not isLecturer))
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid & fromMaybe Set.empty
E.orderBy [E.asc $ user E.^. UserEmail] , []
return $ user E.^. UserId , maySubmit
return ( csheet , isLecturer
, buddies , not isLecturer
& 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
(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)