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

Cleanup AdHoc-Group logic

Browse Source 
- Submitting user is no longer checked during validity checks for participants
  - Better error message if too many participants are submitted
  - Having submitted the focused submission is no longer counted as already
    having a submission during updates
This commit is contained in:
Gregor Kleen 2018-07-06 17:24:23 +02:00
parent a6bf547902
commit 25112a5f67
2 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/de.msg
View File

@ -99,6 +99,7 @@ UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung
EMail: E-Mail EMail: E-Mail
EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer. EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer.
NotAParticipant user@Text tid@TermId csh@Text: #{user} ist nicht im Kurs #{display tid}-#{csh} angemeldet. NotAParticipant user@Text tid@TermId csh@Text: #{user} ist nicht im Kurs #{display tid}-#{csh} angemeldet.
TooManyParticipants: Es wurden zu viele Mitabgebende angegeben
AddCorrector: Zusätzlicher Korrektor AddCorrector: Zusätzlicher Korrektor
CorrectorExists user@Text: #{user} ist bereits als Korrektor eingetragen CorrectorExists user@Text: #{user} ist bereits als Korrektor eingetragen

29
src/Handler/Submission.hs
View File

@ -170,11 +170,11 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
(FormFailure failmsgs) -> return $ FormFailure failmsgs (FormFailure failmsgs) -> return $ FormFailure failmsgs
(FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change (FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change
(FormSuccess (mFiles, (map CI.mk -> gEMails@(_:_)))) -- Validate AdHoc Group Members (FormSuccess (mFiles, (map CI.mk -> gEMails@(_:_)))) -- Validate AdHoc Group Members
| (Arbitrary {..}) <- sheetGrouping | (Arbitrary {..}) <- sheetGrouping -> do
, length gEMails < maxParticipants -> do -- < since submitting user is already accounted for -- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
let gemails = map CI.foldedCase gEMails let gemails = map CI.foldedCase gEMails
prep :: [(E.Value Text, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map (CI Text) (Maybe (UserId, Bool, Bool)) prep :: [(E.Value Text, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map (CI Text) (Maybe (UserId, Bool, Bool))
prep ps = Map.fromList $ map (, Nothing) gEMails ++ [(CI.mk m, Just (i,p,s))|(E.Value m, (E.Value i, E.Value p, E.Value s)) <- ps] prep ps = Map.filter (maybe True $ \(i,_,_) -> i /= uid) . Map.fromList $ map (, Nothing) gEMails ++ [(CI.mk m, Just (i,p,s))|(E.Value m, (E.Value i, E.Value p, E.Value s)) <- ps]
participants <- fmap prep . E.select . E.from $ \user -> do participants <- fmap prep . E.select . E.from $ \user -> do
E.where_ $ (E.lower_ $ user E.^. UserEmail) `E.in_` E.valList gemails E.where_ $ (E.lower_ $ user E.^. UserEmail) `E.in_` E.valList gemails
let let
@ -186,20 +186,29 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
E.&&. submission E.^. SubmissionSheet E.==. E.val shid E.&&. submission E.^. SubmissionSheet E.==. E.val shid
case msmid of -- Multiple `E.where_`-Statements are merged with `&&` in esqueleto 2.5.3
Nothing -> return ()
Just smid -> E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
return $ E.countRows E.>. E.val (0 :: Int64) return $ E.countRows E.>. E.val (0 :: Int64)
return (user E.^. UserEmail, (user E.^. UserId, isParticipant, hasSubmitted)) return (user E.^. UserEmail, (user E.^. UserId, isParticipant, hasSubmitted))
$logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants
mr <- getMessageRender
let failmsgs = flip Map.foldMapWithKey participants $ \email -> \case $logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants
Nothing -> [mr $ MsgEMailUnknown $ CI.original email]
(Just (_,False,_)) -> [mr $ MsgNotAParticipant (CI.original email) tid csh] mr <- getMessageRender
(Just (_,_, True)) -> [mr $ MsgSubmissionAlreadyExistsFor (CI.original email)] let
failmsgs = (concat :: [[Text]] -> [Text])
[ flip Map.foldMapWithKey participants $ \email -> \case
Nothing -> pure . mr $ MsgEMailUnknown $ CI.original email
(Just (_,False,_)) -> pure . mr $ MsgNotAParticipant (CI.original email) tid csh
(Just (_,_, True)) -> pure . mr $ MsgSubmissionAlreadyExistsFor (CI.original email)
_other -> mempty _other -> mempty
, case length participants `compare` maxParticipants of
LT -> mempty
_ -> pure $ mr MsgTooManyParticipants
]
return $ if null failmsgs return $ if null failmsgs
then FormSuccess (mFiles, foldMap (\(Just (i,_,_)) -> [i]) participants) then FormSuccess (mFiles, foldMap (\(Just (i,_,_)) -> [i]) participants)
else FormFailure failmsgs else FormFailure failmsgs
| otherwise -> return $ FormFailure ["Mismatching number of group participants"] | otherwise -> return $ FormFailure ["Mismatching number of group participants"]