Merge branch 'master' into 'live'
Fix check for existingSubUsers; no longer produces false positives See merge request !111
This commit is contained in:
commit
dbb69e1817
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user