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

fix(submissions): only notify submittors if rating changes doneness

Browse Source
This commit is contained in:
Gregor Kleen 2019-07-17 17:35:12 +02:00
parent ddda584b08
commit 4f1162c363
1 changed files with 20 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
src/Handler/Utils/Submission.hs
View File

@ -491,17 +491,20 @@ sinkSubmission userId mExists isUpdate = do
alreadySeen <- gets $ is (_Wrapped . _Just) . sinkSeenRating alreadySeen <- gets $ is (_Wrapped . _Just) . sinkSeenRating
when alreadySeen $ throwM DuplicateRating when alreadySeen $ throwM DuplicateRating
Submission{..} <- lift $ getJust submissionId submission <- lift $ getJust submissionId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let let
rated = submissionRatingBy == Just userId -- FIXME: This behaviour is unintuitive and needs to be replaced with an "isDone"-Field in rating files rated = submissionRatingBy submission == Just userId -- FIXME: This behaviour is unintuitive and needs to be replaced with an "isDone"-Field in rating files
r' = let Rating'{..} = r r'@Rating'{..} = r
in Rating' { ratingTime = now <$ guard rated -- Ignore `ratingTime` from result @r@ of `parseRating` to ensure plausible timestamps (`parseRating` returns file modification time for consistency with `ratingFile`)
{ ratingTime = now <$ guard rated }
, .. submission' = submission
} { submissionRatingPoints = ratingPoints
let Rating'{..} = r' , submissionRatingComment = ratingComment
, submissionRatingTime = ratingTime
, submissionRatingBy = userId <$ guard rated -- This is never an update due to the definition of rated; this is done so idempotency of uploads is maintained (FIXME: when "isDone"-Field is introduced, set this to `Just userId`)
}
tellSt $ mempty{ sinkSeenRating = Last $ Just r' } tellSt $ mempty{ sinkSeenRating = Last $ Just r' }
unless isUpdate $ throwM RatingWithoutUpdate unless isUpdate $ throwM RatingWithoutUpdate
@ -510,25 +513,23 @@ sinkSubmission userId mExists isUpdate = do
-- --
-- 'fileModified' is simply stored and never inspected while -- 'fileModified' is simply stored and never inspected while
-- 'submissionChanged' is always set to @now@. -- 'submissionChanged' is always set to @now@.
let anyChanges = or $ let anyChanges = any (\f -> f submission submission') $
[ submissionRatingPoints /= ratingPoints [ (/=) `on` submissionRatingPoints
, submissionRatingComment /= ratingComment , (/=) `on` submissionRatingComment
, (/=) `on` submissionRatingDone
, (/=) `on` submissionRatingBy
] ]
when anyChanges $ do when anyChanges $ do
touchSubmission touchSubmission
Sheet{..} <- lift $ getJust submissionSheet Sheet{..} <- lift . getJust $ submissionSheet submission'
mapM_ throwM $ validateRating sheetType r' mapM_ throwM $ validateRating sheetType r'
when (submissionRatingDone r') $ tellSt mempty { sinkSubmissionNotifyRating = Any True } when (submissionRatingDone submission' && not (submissionRatingDone submission)) $
lift $ update submissionId tellSt mempty { sinkSubmissionNotifyRating = Any True }
[ SubmissionRatingPoints =. ratingPoints lift $ replace submissionId submission'
, SubmissionRatingComment =. ratingComment
, SubmissionRatingTime =. ratingTime
, SubmissionRatingBy =. (userId <$ guard rated) -- This is never an update due to the definition of rated; this is done so idempotency of uploads is maintained (FIXME: when "isDone"-Field is introduced, set this to `Just userId`)
]
where where
a /~ b = not $ a ~~ b a /~ b = not $ a ~~ b