fraport/fradrive
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
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.
TooManyParticipants: Es wurden zu viele Mitabgebende angegeben
AddCorrector: Zusätzlicher Korrektor
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
(FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change
(FormSuccess (mFiles, (map CI.mk -> gEMails@(_:_)))) -- Validate AdHoc Group Members
| (Arbitrary {..}) <- sheetGrouping
, length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
| (Arbitrary {..}) <- sheetGrouping -> do
-- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
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 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
E.where_ $ (E.lower_ $ user E.^. UserEmail) `E.in_` E.valList gemails
let
@ -186,20 +186,29 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
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 (user E.^. UserEmail, (user E.^. UserId, isParticipant, hasSubmitted))
$logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants
mr <- getMessageRender
let failmsgs = flip Map.foldMapWithKey participants $ \email -> \case
Nothing -> [mr $ MsgEMailUnknown $ CI.original email]
(Just (_,False,_)) -> [mr $ MsgNotAParticipant (CI.original email) tid csh]
(Just (_,_, True)) -> [mr $ MsgSubmissionAlreadyExistsFor (CI.original email)]
$logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants
mr <- getMessageRender
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
, case length participants `compare` maxParticipants of
LT -> mempty
_ -> pure $ mr MsgTooManyParticipants
]
return $ if null failmsgs
then FormSuccess (mFiles, foldMap (\(Just (i,_,_)) -> [i]) participants)
else FormFailure failmsgs
| otherwise -> return $ FormFailure ["Mismatching number of group participants"]