diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index 22d636fb1..a4e80d6e7 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -14,6 +14,7 @@ data Transaction = TransactionTermEdit { transactionTerm :: TermId } + | TransactionExamRegister { transactionExam :: ExamId , transactionUser :: UserId @@ -22,6 +23,7 @@ data Transaction { transactionExam :: ExamId , transactionUser :: UserId } + | TransactionExamResultEdit { transactionExam :: ExamId , transactionUser :: UserId @@ -30,6 +32,7 @@ data Transaction { transactionExam :: ExamId , transactionUser :: UserId } + | TransactionCourseParticipantEdit { transactionCourse :: CourseId , transactionUser :: UserId @@ -38,6 +41,7 @@ data Transaction { transactionCourse :: CourseId , transactionUser :: UserId } + | TransactionCourseApplicationEdit { transactionCourse :: CourseId , transactionUser :: UserId @@ -48,17 +52,55 @@ data Transaction , transactionUser :: UserId , transactionCourseApplication :: CourseApplicationId } - | TransactionSubmissionUser + + -- TODO: audit work in progress + | TransactionSubmissionEdit + { transactionSubmission :: SubmissionId + , transactionSheet :: SheetId + } + | TransactionSubmissionDelete + { transactionSubmission :: SubmissionId + , transactionSheet :: SheetId + } + + -- TODO: audit work in progress + | TransactionSubmissionUserEdit { transactionSubmission :: SubmissionId , transactionUser :: UserId } - | TransactionSubmissionCorrectorAssigned + | TransactionSubmissionUserDelete { transactionSubmission :: SubmissionId - , transactionMbUser :: Maybe UserId + , transactionUser :: UserId } - | TransactionSubmissionCorrectionDeleted - { transactionSubmission :: SubmissionId + + -- TODO: not yet audited + | TransactionSubmissionFileEdit + { transactionSubmissionFile :: SubmissionFileId + , transactionSubmission :: SubmissionId + , transactionFile :: FileId } + | TransactionSubmissionFileDelete + { transactionSubmissionFile :: SubmissionFileId + , transactionSubmission :: SubmissionId + , transactionFile :: FileId + } + + -- TODO: not yet audited + | TransactionUserEdit + { transactionUser :: UserId + } + | TransactionUserDelete + { transactionUser :: UserId + } + + -- TODO: not yet audited + | TransactionFileEdit + { transactionFile :: FileId + } + | TransactionFileDelete + { transactionFile :: FileId + } + deriving (Eq, Ord, Read, Show, Generic, Typeable) deriveJSON defaultOptions diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index f185eef9e..e9a7b3401 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -465,7 +465,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do , SubmissionRatingAssigned =. Just now -- save, since only applies to unassigned ] addMessageI Success $ MsgUpdatedAssignedCorrectorSingle num - mapM_ (\sId -> audit $ TransactionSubmissionCorrectorAssigned sId $ Just uid) sIds + mapM_ (\sId -> getJust sId >>= \sub -> audit $ TransactionSubmissionEdit sId $ sub ^. _submissionSheet) 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 +484,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do -- , SubmissionRatingComment =. Nothing -- Kept for easy reassignment by 2nd corrector ] addMessageI Success $ MsgRemovedCorrections num - mapM_ (audit . TransactionSubmissionCorrectionDeleted) subs + mapM_ (\subId -> getJust subId >>= \submission -> audit $ TransactionSubmissionEdit subId $ submission ^. _submissionSheet) subs redirect currentRoute FormSuccess (CorrAutoSetCorrectorData shid, subs') -> do subs <- mapM decrypt $ Set.toList subs' @@ -948,7 +948,7 @@ postCorrectionsCreateR = do { submissionUserUser = sheetUser , submissionUserSubmission = subId } - audit $ TransactionSubmissionUser subId uid + audit $ TransactionSubmissionUserEdit subId uid when (null groups) $ addMessageI Warning $ MsgSheetNoRegisteredGroup sheetGroupDesc | length groups < 2 @@ -965,7 +965,7 @@ postCorrectionsCreateR = do { submissionUserUser = sheetPseudonymUser , submissionUserSubmission = subId } - audit $ TransactionSubmissionUser subId uid + audit $ TransactionSubmissionUserEdit subId uid when (length spGroup > 1) $ addMessageI Warning $ MsgSheetNoGroupSubmission sheetGroupDesc when allDone $ diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 9abb60dbb..b73981bfe 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -622,7 +622,8 @@ postSubAssignR tid ssh csh shn cID = do , SubmissionRatingAssigned =. (now <$ mbUserId) ] addMessageI Success MsgCorrectorUpdated - audit $ TransactionSubmissionCorrectorAssigned sId mbUserId + sub <- getJust sId + audit $ TransactionSubmissionEdit sId $ sub ^. _submissionSheet redirect actionUrl let corrForm = wrapForm' BtnSave corrForm' def { formAction = Just $ SomeRoute actionUrl diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 272a9793a..7e3f43a36 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -78,10 +78,11 @@ writeSubmissionPlan newSubmissionData = do now <- liftIO getCurrentTime execWriterT . forM_ (Map.toList newSubmissionData) $ \(subId, mCorrector) -> case mCorrector of Just _ -> do + sub <- lift $ getJust subId lift $ update subId [ SubmissionRatingBy =. mCorrector , SubmissionRatingAssigned =. Just now ] - lift $ audit $ TransactionSubmissionCorrectorAssigned subId mCorrector + lift $ audit $ TransactionSubmissionEdit subId $ sub ^. _submissionSheet tell (Set.singleton subId, mempty) Nothing -> tell (mempty, Set.singleton subId) diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index d72fdac3e..690360591 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -167,6 +167,8 @@ makeLenses_ ''Allocation makeLenses_ ''File +makeLenses_ ''Submission + -- makeClassy_ ''Load