Merge branch 'master' into 'live'

Fix check for existingSubUsers; no longer produces false positives

See merge request !111
This commit is contained in:
Gregor Kleen 2018-11-27 10:20:33 +01:00
commit dbb69e1817

View File

@ -654,7 +654,7 @@ postCorrectionsCreateR = do
known <- State.gets $ Map.member sheetPseudonymPseudonym
State.modify $ Map.insertWith (<>) sheetPseudonymPseudonym (Sum 1)
return $ bool (p :) id known ps
submission = Submission
submissionPrototype = Submission
{ submissionSheet = sid
, submissionRatingPoints = Nothing
, submissionRatingComment = Nothing
@ -664,8 +664,10 @@ postCorrectionsCreateR = do
}
unless (null duplicate)
$(addMessageFile Warning "templates/messages/submissionCreateDuplicates.hamlet")
existingSubUsers <- E.select . E.from $ \submissionUser -> do
existingSubUsers <- E.select . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
E.where_ $ submissionUser E.^. SubmissionUserUser `E.in_` E.valList (sheetPseudonymUser <$> concat sps')
E.&&. submission E.^. SubmissionSheet E.==. E.val sid
return submissionUser
unless (null existingSubUsers) $ do
(Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: DB CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers
@ -680,7 +682,7 @@ postCorrectionsCreateR = do
-> addMessageI Error $ MsgSheetGroupTooLarge sheetGroupDesc
| otherwise
-> do
subId <- insert submission
subId <- insert submissionPrototype
void . insert $ SubmissionEdit uid now subId
insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
{ submissionUserUser = sheetPseudonymUser
@ -694,7 +696,7 @@ postCorrectionsCreateR = do
if
| length (groups :: [E.Value SubmissionGroupId]) < 2
-> do
subId <- insert submission
subId <- insert submissionPrototype
void . insert $ SubmissionEdit uid now subId
insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
{ submissionUserUser = sheetPseudonymUser
@ -706,14 +708,14 @@ postCorrectionsCreateR = do
NoGroups
| [SheetPseudonym{sheetPseudonymUser}] <- spGroup
-> do
subId <- insert submission
subId <- insert submissionPrototype
void . insert $ SubmissionEdit uid now subId
insert_ SubmissionUser
{ submissionUserUser = sheetPseudonymUser
, submissionUserSubmission = subId
}
| otherwise -> do
subId <- insert submission
subId <- insert submissionPrototype
void . insert $ SubmissionEdit uid now subId
insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
{ submissionUserUser = sheetPseudonymUser