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

fix(submissions): fix ambiguity with multiple past co-submissions

Browse Source
This commit is contained in:
Gregor Kleen 2019-12-03 14:24:00 +01:00
parent 88bcde6f30
commit 6e4f469023
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/Utils/Form.hs
View File

@ -1136,7 +1136,7 @@ multiUserField onlySuggested suggestions = Field{..}
|] |]
whenIsJust suggestions $ \suggestions' -> do whenIsJust suggestions $ \suggestions' -> do
suggestedEmails <- fmap (Set.fromList . map (over _2 E.unValue . over _1 E.unValue)) . liftHandler . runDB . E.select $ do suggestedEmails <- fmap (Map.assocs . Map.fromListWith min . map (over _2 E.unValue . over _1 E.unValue)) . liftHandler . runDB . E.select $ do
user <- suggestions' user <- suggestions'
return $ (user E.^. UserEmail, user E.^. UserDisplayName) return $ (user E.^. UserEmail, user E.^. UserDisplayName)
[whamlet| [whamlet|
@ -1153,14 +1153,16 @@ multiUserField onlySuggested suggestions = Field{..}
fmap Set.fromList . forM emails $ \(CI.mk -> email) -> case lookupExpr of fmap Set.fromList . forM emails $ \(CI.mk -> email) -> case lookupExpr of
Nothing -> return $ Left email Nothing -> return $ Left email
Just lookupExpr' -> do Just lookupExpr' -> do
dbRes <- liftHandler . runDB . E.select $ do dbRes <- fmap (setOf $ folded . _Value). liftHandler . runDB . E.select $ do
user <- lookupExpr' user <- lookupExpr'
E.where_ $ user E.^. UserEmail E.==. E.val email E.where_ $ user E.^. UserEmail E.==. E.val email
return $ user E.^. UserId return $ user E.^. UserId
case dbRes of if | Set.null dbRes
[] -> return $ Left email -> return $ Left email
[E.Value uid] -> return $ Right uid | [uid] <- Set.toList dbRes
_other -> throwE $ SomeMessage MsgAmbiguousEmail -> return $ Right uid
| otherwise
-> throwE $ SomeMessage MsgAmbiguousEmail
examResultField :: forall m res. examResultField :: forall m res.
( MonadHandler m ( MonadHandler m