diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index e9a7b3401..5f60de86e 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -432,6 +432,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do let actionRes = actionRes' & mapped._2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False) & mapped._1 %~ fromMaybe (error "By consctruction the form should always return an action") . getLast + auditAllSubEdit = mapM_ $ \sId -> getJust sId >>= \sub -> audit $ TransactionSubmissionEdit sId $ sub ^. _submissionSheet case actionRes of FormFailure errs -> mapM_ (addMessage Warning . toHtml) errs @@ -465,7 +466,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do , SubmissionRatingAssigned =. Just now -- save, since only applies to unassigned ] addMessageI Success $ MsgUpdatedAssignedCorrectorSingle num - mapM_ (\sId -> getJust sId >>= \sub -> audit $ TransactionSubmissionEdit sId $ sub ^. _submissionSheet) sIds + auditAllSubEdit sIds (E.Value selfCorrectors:_) <- E.select . E.from $ \(submission `E.InnerJoin` subuser) -> do E.on $ submission E.^. SubmissionId E.==. subuser E.^. SubmissionUserSubmission E.where_ $ submission E.^. SubmissionId `E.in_` E.valList subs @@ -484,7 +485,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do -- , SubmissionRatingComment =. Nothing -- Kept for easy reassignment by 2nd corrector ] addMessageI Success $ MsgRemovedCorrections num - mapM_ (\subId -> getJust subId >>= \submission -> audit $ TransactionSubmissionEdit subId $ submission ^. _submissionSheet) subs + auditAllSubEdit subs redirect currentRoute FormSuccess (CorrAutoSetCorrectorData shid, subs') -> do subs <- mapM decrypt $ Set.toList subs' @@ -1029,7 +1030,8 @@ postCorrectionsGradeR = do s@Submission{..} <- get404 subId if | submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s - -> Just subId <$ update subId [ SubmissionRatingPoints =. mPoints + -> do audit $ TransactionSubmissionEdit subId $ s ^. _submissionSheet + Just subId <$ update subId [ SubmissionRatingPoints =. mPoints , SubmissionRatingComment =. mComment , SubmissionRatingBy =. Just uid , SubmissionRatingTime =. now <$ guard rated diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 025b0c9bc..b3a7f8c72 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -355,6 +355,7 @@ postMDelR tid ssh csh mnm = do , drSuccessMessage = SomeMessage $ MsgMaterialDeleted mnm , drSuccess = SomeRoute $ CourseR tid ssh csh MaterialListR , drAbort = SomeRoute $ CourseR tid ssh csh $ MaterialR mnm MShowR + , drDelete = \_ -> id -- TODO: audit } -- | Serve all material-files diff --git a/src/Handler/Tutorial.hs b/src/Handler/Tutorial.hs index ae2c26ea0..4cfc64503 100644 --- a/src/Handler/Tutorial.hs +++ b/src/Handler/Tutorial.hs @@ -147,6 +147,7 @@ postTDeleteR tid ssh csh tutn = do , drSuccessMessage = SomeMessage MsgTutorialDeleted , drAbort = SomeRoute $ CTutorialR tid ssh csh tutn TUsersR , drSuccess = SomeRoute $ CourseR tid ssh csh CTutorialListR + , drDelete = \_ -> id -- TODO: audit } getTCommR, postTCommR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html diff --git a/src/Handler/Utils/Course.hs b/src/Handler/Utils/Course.hs index c95df004e..0b54617f7 100644 --- a/src/Handler/Utils/Course.hs +++ b/src/Handler/Utils/Course.hs @@ -24,4 +24,5 @@ courseDeleteRoute drRecords = DeleteRoute , drSuccessMessage = SomeMessage MsgCourseDeleted , drAbort = error "drAbort undefined" , drSuccess = error "drSuccess undefined" + , drDelete = \_ -> id -- TODO: audit } diff --git a/src/Handler/Utils/Delete.hs b/src/Handler/Utils/Delete.hs index 8a268ac2c..65c312fe0 100644 --- a/src/Handler/Utils/Delete.hs +++ b/src/Handler/Utils/Delete.hs @@ -39,6 +39,7 @@ data DeleteRoute record = forall tables infoExpr info. (E.SqlSelect infoExpr inf , drSuccessMessage :: SomeMessage UniWorX , drAbort , drSuccess :: SomeRoute UniWorX + , drDelete :: forall a. Key record -> DB a -> DB a } confirmForm :: ( MonadHandler m, HandlerSite m ~ UniWorX ) @@ -82,7 +83,7 @@ postDeleteR mkRoute = do formResult confirmRes $ \case True -> do runDB $ do - forM_ drRecords deleteCascade + forM_ drRecords $ \k -> drDelete k $ deleteCascade k addMessageI Success drSuccessMessage redirect drSuccess False -> diff --git a/src/Handler/Utils/Sheet.hs b/src/Handler/Utils/Sheet.hs index 9909f0e7d..c3f16c18d 100644 --- a/src/Handler/Utils/Sheet.hs +++ b/src/Handler/Utils/Sheet.hs @@ -79,4 +79,5 @@ sheetDeleteRoute drRecords = DeleteRoute , drSuccessMessage = SomeMessage MsgSheetDeleted , drAbort = error "drAbort undefined" , drSuccess = error "drSuccess undefined" + , drDelete = \_ -> id -- TODO: audit } diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 7e3f43a36..6cc14a327 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -730,4 +730,5 @@ submissionDeleteRoute drRecords = DeleteRoute , drSuccessMessage = SomeMessage $ MsgSubmissionsDeleted 1 , drAbort = error "drAbort undefined" , drSuccess = error "drSuccess undefined" + , drDelete = \subId del -> getJust subId >>= \sub -> audit (TransactionSubmissionDelete subId $ sub ^. _submissionSheet) >> del }