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

Merge branch 'master' into 'live'

Browse Source 
Fix #235

Closes #235

See merge request !99
This commit is contained in:
Gregor Kleen 2018-11-19 14:38:38 +01:00
commit 2ec32ddce9
1 changed files with 22 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/Handler/Corrections.hs
View File

@ -517,31 +517,32 @@ postCorrectionR tid ssh csh shn cid = do
case corrResult of case corrResult of
FormMissing -> return () FormMissing -> return ()
FormFailure errs -> mapM_ (addMessage Error . toHtml) errs FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
FormSuccess (rated, ratingPoints', ratingComment') FormSuccess (rated, ratingPoints', ratingComment') -> do
| errs <- validateRating sheetType Rating' uid <- liftHandlerT requireAuthId
{ ratingPoints=ratingPoints' now <- liftIO getCurrentTime
, ratingComment=ratingComment'
, ratingTime=Nothing
}
-> mapM_ (addMessageI Error) errs
| otherwise -> do
runDBJobs $ do
uid <- liftHandlerT requireAuthId
now <- liftIO getCurrentTime
update sub [ SubmissionRatingBy =. Just uid if
, SubmissionRatingTime =. (now <$ guard rated) | errs <- validateRating sheetType Rating'
, SubmissionRatingPoints =. ratingPoints' { ratingPoints = ratingPoints'
, SubmissionRatingComment =. ratingComment' , ratingComment = ratingComment'
] , ratingTime = (now <$ guard rated)
}
, not $ null errs
-> mapM_ (addMessageI Error) errs
| otherwise -> runDBJobs $ do
update sub [ SubmissionRatingBy =. Just uid
, SubmissionRatingTime =. (now <$ guard rated)
, SubmissionRatingPoints =. ratingPoints'
, SubmissionRatingComment =. ratingComment'
]
addMessageI Success $ bool MsgRatingDeleted MsgRatingUpdated rated addMessageI Success $ bool MsgRatingDeleted MsgRatingUpdated rated
when (rated && isNothing submissionRatingTime) $ do when (rated && isNothing submissionRatingTime) $ do
$logDebugS "CorrectionR" [st|Rated #{tshow sub}|] $logDebugS "CorrectionR" [st|Rated #{tshow sub}|]
queueDBJob . JobQueueNotification $ NotificationSubmissionRated sub queueDBJob . JobQueueNotification $ NotificationSubmissionRated sub
redirect $ CSubmissionR tid ssh csh shn cid CorrectionR redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
case uploadResult of case uploadResult of
FormMissing -> return () FormMissing -> return ()