fix(submission-create): ensure number of buddies is acceptable

This commit is contained in:
Gregor Kleen 2019-11-27 16:05:29 +01:00
parent 77ae311935
commit ec24a04c9b

View File

@ -305,8 +305,8 @@ 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
case msmid of
Nothing -> do
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
@ -331,12 +331,23 @@ submissionHelper tid ssh csh shn mcid = do
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
E.orderBy [E.asc $ user E.^. UserEmail]
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
cID <- encrypt smid
addMessageI Info MsgSubmissionAlreadyExists
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)
shid' <- submissionSheet <$> get404 smid