chore(audit): add audit hook to DeleteRoute
This commit is contained in:
parent
24b97ef28e
commit
7a0efbb5ca
@ -432,6 +432,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
|
|||||||
|
|
||||||
let actionRes = actionRes' & mapped._2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False)
|
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
|
& 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
|
case actionRes of
|
||||||
FormFailure errs -> mapM_ (addMessage Warning . toHtml) errs
|
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
|
, SubmissionRatingAssigned =. Just now -- save, since only applies to unassigned
|
||||||
]
|
]
|
||||||
addMessageI Success $ MsgUpdatedAssignedCorrectorSingle num
|
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.Value selfCorrectors:_) <- E.select . E.from $ \(submission `E.InnerJoin` subuser) -> do
|
||||||
E.on $ submission E.^. SubmissionId E.==. subuser E.^. SubmissionUserSubmission
|
E.on $ submission E.^. SubmissionId E.==. subuser E.^. SubmissionUserSubmission
|
||||||
E.where_ $ submission E.^. SubmissionId `E.in_` E.valList subs
|
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
|
-- , SubmissionRatingComment =. Nothing -- Kept for easy reassignment by 2nd corrector
|
||||||
]
|
]
|
||||||
addMessageI Success $ MsgRemovedCorrections num
|
addMessageI Success $ MsgRemovedCorrections num
|
||||||
mapM_ (\subId -> getJust subId >>= \submission -> audit $ TransactionSubmissionEdit subId $ submission ^. _submissionSheet) subs
|
auditAllSubEdit subs
|
||||||
redirect currentRoute
|
redirect currentRoute
|
||||||
FormSuccess (CorrAutoSetCorrectorData shid, subs') -> do
|
FormSuccess (CorrAutoSetCorrectorData shid, subs') -> do
|
||||||
subs <- mapM decrypt $ Set.toList subs'
|
subs <- mapM decrypt $ Set.toList subs'
|
||||||
@ -1029,7 +1030,8 @@ postCorrectionsGradeR = do
|
|||||||
s@Submission{..} <- get404 subId
|
s@Submission{..} <- get404 subId
|
||||||
if
|
if
|
||||||
| submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s
|
| 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
|
, SubmissionRatingComment =. mComment
|
||||||
, SubmissionRatingBy =. Just uid
|
, SubmissionRatingBy =. Just uid
|
||||||
, SubmissionRatingTime =. now <$ guard rated
|
, SubmissionRatingTime =. now <$ guard rated
|
||||||
|
|||||||
@ -355,6 +355,7 @@ postMDelR tid ssh csh mnm = do
|
|||||||
, drSuccessMessage = SomeMessage $ MsgMaterialDeleted mnm
|
, drSuccessMessage = SomeMessage $ MsgMaterialDeleted mnm
|
||||||
, drSuccess = SomeRoute $ CourseR tid ssh csh MaterialListR
|
, drSuccess = SomeRoute $ CourseR tid ssh csh MaterialListR
|
||||||
, drAbort = SomeRoute $ CourseR tid ssh csh $ MaterialR mnm MShowR
|
, drAbort = SomeRoute $ CourseR tid ssh csh $ MaterialR mnm MShowR
|
||||||
|
, drDelete = \_ -> id -- TODO: audit
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Serve all material-files
|
-- | Serve all material-files
|
||||||
|
|||||||
@ -147,6 +147,7 @@ postTDeleteR tid ssh csh tutn = do
|
|||||||
, drSuccessMessage = SomeMessage MsgTutorialDeleted
|
, drSuccessMessage = SomeMessage MsgTutorialDeleted
|
||||||
, drAbort = SomeRoute $ CTutorialR tid ssh csh tutn TUsersR
|
, drAbort = SomeRoute $ CTutorialR tid ssh csh tutn TUsersR
|
||||||
, drSuccess = SomeRoute $ CourseR tid ssh csh CTutorialListR
|
, drSuccess = SomeRoute $ CourseR tid ssh csh CTutorialListR
|
||||||
|
, drDelete = \_ -> id -- TODO: audit
|
||||||
}
|
}
|
||||||
|
|
||||||
getTCommR, postTCommR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
|
getTCommR, postTCommR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
|
||||||
|
|||||||
@ -24,4 +24,5 @@ courseDeleteRoute drRecords = DeleteRoute
|
|||||||
, drSuccessMessage = SomeMessage MsgCourseDeleted
|
, drSuccessMessage = SomeMessage MsgCourseDeleted
|
||||||
, drAbort = error "drAbort undefined"
|
, drAbort = error "drAbort undefined"
|
||||||
, drSuccess = error "drSuccess undefined"
|
, drSuccess = error "drSuccess undefined"
|
||||||
|
, drDelete = \_ -> id -- TODO: audit
|
||||||
}
|
}
|
||||||
|
|||||||
@ -39,6 +39,7 @@ data DeleteRoute record = forall tables infoExpr info. (E.SqlSelect infoExpr inf
|
|||||||
, drSuccessMessage :: SomeMessage UniWorX
|
, drSuccessMessage :: SomeMessage UniWorX
|
||||||
, drAbort
|
, drAbort
|
||||||
, drSuccess :: SomeRoute UniWorX
|
, drSuccess :: SomeRoute UniWorX
|
||||||
|
, drDelete :: forall a. Key record -> DB a -> DB a
|
||||||
}
|
}
|
||||||
|
|
||||||
confirmForm :: ( MonadHandler m, HandlerSite m ~ UniWorX )
|
confirmForm :: ( MonadHandler m, HandlerSite m ~ UniWorX )
|
||||||
@ -82,7 +83,7 @@ postDeleteR mkRoute = do
|
|||||||
formResult confirmRes $ \case
|
formResult confirmRes $ \case
|
||||||
True -> do
|
True -> do
|
||||||
runDB $ do
|
runDB $ do
|
||||||
forM_ drRecords deleteCascade
|
forM_ drRecords $ \k -> drDelete k $ deleteCascade k
|
||||||
addMessageI Success drSuccessMessage
|
addMessageI Success drSuccessMessage
|
||||||
redirect drSuccess
|
redirect drSuccess
|
||||||
False ->
|
False ->
|
||||||
|
|||||||
@ -79,4 +79,5 @@ sheetDeleteRoute drRecords = DeleteRoute
|
|||||||
, drSuccessMessage = SomeMessage MsgSheetDeleted
|
, drSuccessMessage = SomeMessage MsgSheetDeleted
|
||||||
, drAbort = error "drAbort undefined"
|
, drAbort = error "drAbort undefined"
|
||||||
, drSuccess = error "drSuccess undefined"
|
, drSuccess = error "drSuccess undefined"
|
||||||
|
, drDelete = \_ -> id -- TODO: audit
|
||||||
}
|
}
|
||||||
|
|||||||
@ -730,4 +730,5 @@ submissionDeleteRoute drRecords = DeleteRoute
|
|||||||
, drSuccessMessage = SomeMessage $ MsgSubmissionsDeleted 1
|
, drSuccessMessage = SomeMessage $ MsgSubmissionsDeleted 1
|
||||||
, drAbort = error "drAbort undefined"
|
, drAbort = error "drAbort undefined"
|
||||||
, drSuccess = error "drSuccess undefined"
|
, drSuccess = error "drSuccess undefined"
|
||||||
|
, drDelete = \subId del -> getJust subId >>= \sub -> audit (TransactionSubmissionDelete subId $ sub ^. _submissionSheet) >> del
|
||||||
}
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user