fix(submission-create): ensure number of buddies is acceptable
This commit is contained in:
parent
77ae311935
commit
ec24a04c9b
@ -305,8 +305,8 @@ 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 of
|
case (msmid, sheetGrouping) of
|
||||||
Nothing -> do
|
(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
|
||||||
@ -331,12 +331,23 @@ submissionHelper tid ssh csh shn mcid = do
|
|||||||
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
|
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
|
||||||
E.orderBy [E.asc $ user E.^. UserEmail]
|
E.orderBy [E.asc $ user E.^. UserEmail]
|
||||||
return $ user E.^. UserId
|
return $ user E.^. UserId
|
||||||
return (csheet, Set.fromList $ map (Right . E.unValue) buddies, [], maySubmit, isLecturer, not isLecturer)
|
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
|
(E.Value smid:_) -> do
|
||||||
cID <- encrypt smid
|
cID <- encrypt smid
|
||||||
addMessageI Info MsgSubmissionAlreadyExists
|
addMessageI Info MsgSubmissionAlreadyExists
|
||||||
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
|
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
|
||||||
(Just smid) -> do
|
(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)
|
void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid)
|
||||||
|
|
||||||
shid' <- submissionSheet <$> get404 smid
|
shid' <- submissionSheet <$> get404 smid
|
||||||
|
|||||||
Reference in New Issue
Block a user