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

Merge branch 'master' into 'live'

Browse Source 
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
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Handler/Corrections.hs
View File

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