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

fix(submission): allow not modifying submissionUsers

Browse Source
This commit is contained in:
Gregor Kleen 2019-12-06 12:09:14 +01:00
parent 98c0d6919e
commit 030fd7abf1
1 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Handler/Submission.hs
View File

@ -265,6 +265,9 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
postProcess :: Map ListPosition (Either UserEmail UserId, ()) -> Set (Either UserEmail UserId) postProcess :: Map ListPosition (Either UserEmail UserId, ()) -> Set (Either UserEmail UserId)
postProcess valMap postProcess valMap
| is _Just msmid
, resultUsers == prefillUsers
= resultUsers
| Just maxSize' <- maxSize | Just maxSize' <- maxSize
, fromIntegral maxSize' >= Set.size resultUsers , fromIntegral maxSize' >= Set.size resultUsers
= resultUsers = resultUsers
@ -399,11 +402,19 @@ submissionHelper tid ssh csh shn mcid = do
} }
mCID <- fmap join . msgSubmissionErrors . runDBJobs $ do mCID <- fmap join . msgSubmissionErrors . runDBJobs $ do
-- Determine old submission users
subUsersOld <- if
| Just smid <- msmid -> Set.union
<$> (setOf (folded . _entityVal . _submissionUserUser . to Right) <$> selectList [SubmissionUserSubmission ==. smid] [])
<*> (sourceInvitationsF smid <&> Set.fromList . map (\(email, InvDBDataSubmissionUser) -> Left email))
| otherwise -> return Set.empty
res' <- case res of res' <- case res of
FormMissing -> return FormMissing FormMissing -> return FormMissing
(FormFailure failmsgs) -> return $ FormFailure failmsgs (FormFailure failmsgs) -> return $ FormFailure failmsgs
-- #227 Part II: no longer ignore submitter, if the user is lecturer or admin (allow lecturers to submit for their students) -- #227 Part II: no longer ignore submitter, if the user is lecturer or admin (allow lecturers to submit for their students)
(FormSuccess res'@(_, groupMembers)) (FormSuccess res'@(_, groupMembers))
| groupMembers == subUsersOld -> return $ FormSuccess res'
| Arbitrary{..} <- sheetGrouping -> do -- Validate AdHoc Group Members | Arbitrary{..} <- sheetGrouping -> do -- Validate AdHoc Group Members
-- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for -- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
let (gEMails, gIds) = partitionEithers $ Set.toList groupMembers let (gEMails, gIds) = partitionEithers $ Set.toList groupMembers
@ -479,13 +490,6 @@ submissionHelper tid ssh csh shn mcid = do
-- SubmissionUser for all group members (pre-registered & ad-hoc) -- SubmissionUser for all group members (pre-registered & ad-hoc)
return $ groupUids `Set.union` adhocMembers return $ groupUids `Set.union` adhocMembers
-- Determine old submission users
subUsersOld <- if
| isJust msmid -> Set.union
<$> (setOf (folded . _entityVal . _submissionUserUser . to Right) <$> selectList [SubmissionUserSubmission ==. smid] [])
<*> (sourceInvitationsF smid <&> Set.fromList . map (\(email, InvDBDataSubmissionUser) -> Left email))
| otherwise -> return Set.empty -- optimization (do not perform selection if submission was freshly created)
-- Since invitations carry no data we only need to consider changes to -- Since invitations carry no data we only need to consider changes to
-- the set of users/invited emails -- the set of users/invited emails
-- Otherwise we would have to update old invitations (via -- Otherwise we would have to update old invitations (via