feat(external-exams): auditing

src/Audit/Types.hs

@@ -139,6 +139,36 @@ data Transaction
     { transactionTutorial :: TutorialId
     }
 
+  | TransactionExternalExamEdit
+    { transactionExternalExam :: ExternalExamId
+    }
+
+  | TransactionExternalExamOfficeSchoolEdit
+    { transactionExternalExam :: ExternalExamId
+    , transactionSchool       :: SchoolId
+    }
+  | TransactionExternalExamOfficeSchoolDelete
+    { transactionExternalExam :: ExternalExamId
+    , transactionSchool       :: SchoolId
+    }
+  
+  | TransactionExternalExamStaffEdit
+    { transactionExternalExam :: ExternalExamId
+    , transactionUser         :: UserId
+    }
+  | TransactionExternalExamStaffDelete
+    { transactionExternalExam :: ExternalExamId
+    , transactionUser         :: UserId
+    }
+  | TransactionExternalExamStaffInviteEdit
+    { transactionExternalExam :: ExternalExamId
+    , transactionEmail        :: UserEmail
+    }
+  | TransactionExternalExamStaffInviteDelete
+    { transactionExternalExam :: ExternalExamId
+    , transactionEmail        :: UserEmail
+    }
+
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 deriveJSON defaultOptions

src/Handler/Course/LecturerInvite.hs

@@ -75,7 +75,7 @@ lecturerInvitationConfig = InvitationConfig{..}
       where
         toJunction jLecturerType = (JunctionLecturer{..}, ())
         lFs = fslI MsgLecturerType & setTooltip MsgCourseLecturerRightsIdentical
-    invitationInsertHook _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = id
     invitationSuccessMsg (Entity _ Course{..}) (Entity _ Lecturer{..}) = do
       MsgRenderer mr <- getMsgRenderer
       return . SomeMessage $ MsgLecturerInvitationAccepted (mr lecturerType) courseShorthand

src/Handler/Course/ParticipantInvite.hs

@@ -91,7 +91,7 @@ participantInvitationConfig = InvitationConfig{..}
       studyFeatures <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid)
           (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) Nothing
       return . fmap (, ()) $ JunctionParticipant <$> pure now <*> studyFeatures <*> pure Nothing
-    invitationInsertHook _ _ CourseParticipant{..} _ act = do
+    invitationInsertHook _ _ _ CourseParticipant{..} _ act = do
       res <- act
       audit $ TransactionCourseParticipantEdit courseParticipantCourse courseParticipantUser
       return res

src/Handler/Exam/CorrectorInvite.hs

@@ -71,7 +71,7 @@ examCorrectorInvitationConfig = InvitationConfig{..}
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionExamCorrector, ())
-    invitationInsertHook _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = id
     invitationSuccessMsg (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInvitationAccepted examName
     invitationUltDest (Entity _ Exam{..}) _ = do
       Course{..} <- get404 examCourse

src/Handler/Exam/RegistrationInvite.hs

@@ -97,7 +97,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
           fieldRes <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid) (fslI MsgCourseStudyFeature) Nothing
           return $ (JunctionExamRegistration invDBExamRegistrationOccurrence now, ) . Just <$> fieldRes
         (True , _    ) -> return $ pure (JunctionExamRegistration invDBExamRegistrationOccurrence now, Nothing) 
-    invitationInsertHook (Entity eid Exam{..}) _ ExamRegistration{..} mField act = do
+    invitationInsertHook _ (Entity eid Exam{..}) _ ExamRegistration{..} mField act = do
       whenIsJust mField $ \cpField -> do
         insert_ $ CourseParticipant examCourse examRegistrationUser examRegistrationTime cpField Nothing
         queueDBJob . JobQueueNotification $ NotificationCourseRegistered examRegistrationUser examCourse

src/Handler/ExamOffice/Users.hs

@@ -74,7 +74,7 @@ examOfficeUserInvitationConfig = InvitationConfig{..}
       return InvitationTokenConfig{..}
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionExamOfficeUser, ())
-    invitationInsertHook _ _ ExamOfficeUser{..} _ act = do
+    invitationInsertHook _ _ _ ExamOfficeUser{..} _ act = do
       res <- act
       audit $ TransactionExamOfficeUserAdd examOfficeUserOffice examOfficeUserUser
       return res

src/Handler/ExternalExam/Edit.hs

@@ -53,23 +53,31 @@ postEEEditR tid ssh coursen examn = do
         , externalExamShowGrades  = eefShowGrades
         }
       when (is _Nothing replaceRes) $ do
+        audit $ TransactionExternalExamEdit eeId
+        
         forM_ (eefStaff `setSymmDiff` staff) $ \change -> if
           | change `Set.member` eefStaff -> case change of
-              Left invEmail ->
+              Left invEmail -> do
+                audit $ TransactionExternalExamStaffInviteEdit eeId invEmail
                 sinkInvitationsF externalExamStaffInvitationConfig
                   [(invEmail, eeId, (InvDBDataExternalExamStaff, InvTokenDataExternalExamStaff))]
-              Right staffUid ->
+              Right staffUid -> do
-                  insert_ $ ExternalExamStaff staffUid eeId
+                audit $ TransactionExternalExamStaffEdit eeId staffUid
+                insert_ $ ExternalExamStaff staffUid eeId
           | otherwise -> case change of
-              Left invEmail ->
+              Left invEmail -> do
+                audit $ TransactionExternalExamStaffInviteDelete eeId invEmail
                 deleteInvitation @ExternalExamStaff eeId invEmail
-              Right staffUid ->
+              Right staffUid -> do
+                audit $ TransactionExternalExamStaffDelete eeId staffUid
                 deleteBy $ UniqueExternalExamStaff eeId staffUid
 
         forM_ (eefOfficeSchools `setSymmDiff` schools) $ \change -> if
-          | change `Set.member` eefOfficeSchools ->
+          | change `Set.member` eefOfficeSchools -> do
+              audit $ TransactionExternalExamOfficeSchoolEdit eeId change
               insert_ $ ExternalExamOfficeSchool change eeId
-          | otherwise ->
+          | otherwise -> do
+              audit $ TransactionExternalExamOfficeSchoolDelete eeId change
               deleteBy $ UniqueExternalExamOfficeSchool eeId change
       return replaceRes
 

src/Handler/ExternalExam/New.hs

@@ -31,19 +31,29 @@ postEExamNewR = do
         , externalExamShowGrades  = eefShowGrades
         }
       whenIsJust insertRes $ \eeId -> do
-        insertMany_
+        audit $ TransactionExternalExamEdit eeId
-          [ ExternalExamOfficeSchool{..}
+        
-          | externalExamOfficeSchoolSchool <- Set.toList eefOfficeSchools
+        let eefOfficeSchools' = do
-          , externalExamOfficeSchoolSchool /= eefSchool
+              externalExamOfficeSchoolSchool <- Set.toList eefOfficeSchools
-          , let externalExamOfficeSchoolExam = eeId
+              guard $ externalExamOfficeSchoolSchool /= eefSchool
-          ]
+              let externalExamOfficeSchoolExam = eeId
+              return ExternalExamOfficeSchool{..}
+        insertMany_ eefOfficeSchools'
+        forM_ eefOfficeSchools' $ \ExternalExamOfficeSchool{..} ->
+          audit $ TransactionExternalExamOfficeSchoolEdit eeId externalExamOfficeSchoolSchool
         
         let (invites, adds) = partitionEithers $ Set.toList eefStaff
-        insertMany_ [ ExternalExamStaff{..}
+            eefStaff' = do
-                    | externalExamStaffUser <- adds
+              externalExamStaffUser <- adds
-                    , let externalExamStaffExam = eeId
+              let externalExamStaffExam = eeId
-                    ]
+              return ExternalExamStaff{..}
+        insertMany_ eefStaff'
+        forM_ eefStaff' $ \ExternalExamStaff{..} ->
+          audit $ TransactionExternalExamStaffEdit eeId externalExamStaffUser
+        
         sinkInvitationsF externalExamStaffInvitationConfig $ map (, eeId, (InvDBDataExternalExamStaff, InvTokenDataExternalExamStaff)) invites
+        forM_ invites $ \invEmail ->
+          audit $ TransactionExternalExamStaffInviteEdit eeId invEmail
       return insertRes
 
     case insertRes of

src/Handler/ExternalExam/StaffInvite.hs

@@ -63,7 +63,12 @@ externalExamStaffInvitationConfig = InvitationConfig{..}
       return $ InvitationTokenConfig itAuthority Nothing (Just Nothing) Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ (InvDBDataExternalExamStaff, _) _ = pure (JunctionExternalExamStaff, ())
-    invitationInsertHook _ _ _ _ = id
+    invitationInsertHook invEmail _ _ ExternalExamStaff{..} _ act = do
+      res <- act
+
+      audit $ TransactionExternalExamStaffInviteDelete externalExamStaffExam invEmail
+      audit $ TransactionExternalExamStaffEdit externalExamStaffExam externalExamStaffUser
+      return res
     invitationSuccessMsg (Entity _ ExternalExam{..}) (Entity _ ExternalExamStaff{})
       = return . SomeMessage $ MsgExternalExamStaffInvitationAccepted externalExamCourseName externalExamExamName
     invitationUltDest (Entity _ ExternalExam{..}) _ = return . SomeRoute $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEShowR

src/Handler/Sheet.hs

@@ -892,7 +892,7 @@ correctorInvitationConfig = InvitationConfig{..}
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ (InvDBDataSheetCorrector cLoad cState, _) _ = pure $ (JunctionSheetCorrector cLoad cState, ())
-    invitationInsertHook _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = id
     invitationSuccessMsg (Entity _ Sheet{..}) _ = return . SomeMessage $ MsgCorrectorInvitationAccepted sheetName
     invitationUltDest (Entity _ Sheet{..}) _ = do
       Course{..} <- get404 sheetCourse

src/Handler/Submission.hs

@@ -114,7 +114,7 @@ submissionUserInvitationConfig = InvitationConfig{..}
       return InvitationTokenConfig{..}
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionSubmissionUser, ())
-    invitationInsertHook _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = id
     invitationSuccessMsg (Entity _ Submission{..}) _ = do
       Sheet{..} <- getJust submissionSheet
       return . SomeMessage $ MsgSubmissionUserInvitationAccepted sheetName

src/Handler/Tutorial/TutorInvite.hs

@@ -68,7 +68,7 @@ tutorInvitationConfig = InvitationConfig{..}
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionTutor, ())
-    invitationInsertHook _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = id
     invitationSuccessMsg (Entity _ Tutorial{..}) _ = return . SomeMessage $ MsgCorrectorInvitationAccepted tutorialName
     invitationUltDest (Entity _ Tutorial{..}) _ = do
       Course{..} <- get404 tutorialCourse

src/Handler/Users.hs

@@ -579,7 +579,7 @@ functionInvitationConfig = InvitationConfig{..}
       return InvitationTokenConfig{..}
     invitationRestriction _ _ = return Authorized
     invitationForm _ (_, InvTokenDataUserFunction{..}) _ = pure $ (JunctionUserFunction invTokenUserFunctionFunction, ())
-    invitationInsertHook _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = id
     invitationSuccessMsg (Entity _ School{..}) (Entity _ UserFunction{..}) = do
       MsgRenderer mr <- getMsgRenderer
       return . SomeMessage . MsgSchoolFunctionInvitationAccepted schoolName $ mr userFunctionFunction

src/Handler/Utils/Invitations.hs

@@ -134,7 +134,7 @@ data InvitationConfig junction = forall formCtx. InvitationConfig
     -- ^ Additional restrictions to check before allowing an user to redeem an invitation token
   , invitationForm        :: Entity (InvitationFor junction) -> InvitationData junction -> Key User -> AForm (YesodDB UniWorX) (InvitableJunction junction, formCtx)
     -- ^ Assimilate the additional data entered by the redeeming user
-  , invitationInsertHook  :: forall a. Entity (InvitationFor junction) -> InvitationData junction -> junction -> formCtx -> (YesodJobDB UniWorX a -> YesodJobDB UniWorX a)
+  , invitationInsertHook  :: forall a. UserEmail -> Entity (InvitationFor junction) -> InvitationData junction -> junction -> formCtx -> (YesodJobDB UniWorX a -> YesodJobDB UniWorX a)
     -- ^ Perform additional actions before or after insertion of the junction into the database
   , invitationSuccessMsg  :: Entity (InvitationFor junction) -> Entity junction         -> DB (SomeMessage UniWorX)
     -- ^ What to tell the redeeming user after accepting the invitation
@@ -402,7 +402,7 @@ invitationR' InvitationConfig{..} = liftHandler $ do
         return . Just $ SomeRoute HomeR
       Just (jData, formCtx) -> do
         let junction = review _InvitableJunction (invitee, fid, jData)
-        mResult <- invitationInsertHook fEnt iData junction formCtx $ insertUniqueEntity junction
+        mResult <- invitationInsertHook itEmail fEnt iData junction formCtx $ insertUniqueEntity junction
         case mResult of
           Nothing -> invalidArgsI [MsgInvitationCollision]
           Just res -> do