chore(audit): replace lms audit table with Transaction log entries
This commit is contained in:
Sarah Vaupel
parent
8dc7d18bf1
commit
71cde92a1a
@ -134,13 +134,3 @@ LmsResult
|
||||
timestamp UTCTime default=now()
|
||||
UniqueLmsResult qualification ident -- required by DBTable
|
||||
deriving Generic
|
||||
|
||||
-- Logs all processed rows from LmsUserlist and LmsResult
|
||||
LmsAudit
|
||||
qualification QualificationId OnDeleteCascade OnUpdateCascade
|
||||
ident LmsIdent
|
||||
notificationType LmsStatus -- LmsBlocked Day | LmsSuccess Day
|
||||
note Text Maybe
|
||||
received UTCTime -- timestamp from LmsUserlist/LmsResult
|
||||
processed UTCTime default=now()
|
||||
deriving Generic
|
||||
|
||||
@ -64,17 +64,6 @@ data Transaction
|
||||
, transactionUser :: UserId
|
||||
}
|
||||
|
||||
| TransactionCourseApplicationEdit
|
||||
{ transactionCourse :: CourseId
|
||||
, transactionUser :: UserId
|
||||
, transactionCourseApplication :: CourseApplicationId
|
||||
}
|
||||
| TransactionCourseApplicationDeleted
|
||||
{ transactionCourse :: CourseId
|
||||
, transactionUser :: UserId
|
||||
, transactionCourseApplication :: CourseApplicationId
|
||||
}
|
||||
|
||||
| TransactionSubmissionEdit
|
||||
{ transactionSubmission :: SubmissionId
|
||||
, transactionSheet :: SheetId
|
||||
@ -181,14 +170,24 @@ data Transaction
|
||||
, transactionNewUserIdent :: UserIdent
|
||||
}
|
||||
|
||||
| TransactionAllocationUserEdited
|
||||
{ transactionUser :: UserId
|
||||
, transactionAllocation :: AllocationId
|
||||
| TransactionLmsBlocked
|
||||
{ transactionQualification :: QualificationId
|
||||
, transactionLmsIdent :: LmsIdent
|
||||
, transactionLmsDay :: Day
|
||||
, transactionLmsUser :: Maybe UserId
|
||||
, transactionNote :: Maybe Text
|
||||
, transactionReceived :: UTCTime -- when was the csv file received?
|
||||
}
|
||||
| TransactionAllocationUserDeleted
|
||||
{ transactionUser :: UserId
|
||||
, transactionAllocation :: AllocationId
|
||||
| TransactionLmsSuccess
|
||||
{ transactionQualification :: QualificationId
|
||||
, transactionLmsIdent :: LmsIdent
|
||||
, transactionLmsDay :: Day
|
||||
, transactionLmsUser :: Maybe UserId
|
||||
, transactionNote :: Maybe Text
|
||||
, transactionReceived :: UTCTime -- when was the csv file received?
|
||||
}
|
||||
|
||||
-- TODO: SetQualification
|
||||
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
|
||||
@ -153,12 +153,12 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
|
||||
E.&&. luser E.^. LmsUserEnded E.<. E.just (E.val auditCutoff)
|
||||
E.&&. E.isJust (luser E.^. LmsUserEnded)
|
||||
E.&&. E.notExists (do
|
||||
laudit <- E.from $ E.table @LmsAudit
|
||||
E.where_ $ laudit E.^. LmsAuditQualification E.==. E.val qid
|
||||
E.&&. laudit E.^. LmsAuditIdent E.==. luser E.^. LmsUserIdent
|
||||
E.&&. laudit E.^. LmsAuditProcessed E.>=. E.val auditCutoff
|
||||
)
|
||||
-- E.&&. E.notExists (do
|
||||
-- laudit <- E.from $ E.table @LmsAudit
|
||||
-- E.where_ $ laudit E.^. LmsAuditQualification E.==. E.val qid
|
||||
-- E.&&. laudit E.^. LmsAuditIdent E.==. luser E.^. LmsUserIdent
|
||||
-- E.&&. laudit E.^. LmsAuditProcessed E.>=. E.val auditCutoff
|
||||
-- )
|
||||
pure (luser E.^. LmsUserIdent)
|
||||
let delusers = E.unValue <$> delusersVals
|
||||
numdel = length delusers
|
||||
@ -167,7 +167,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
deleteWhere [LmsUserQualification ==. qid, LmsUserIdent <-. delusers]
|
||||
deleteWhere [LmsUserlistQualification ==. qid, LmsUserlistIdent <-. delusers]
|
||||
deleteWhere [LmsResultQualification ==. qid, LmsResultIdent <-. delusers]
|
||||
deleteWhere [LmsAuditQualification ==. qid, LmsAuditIdent <-. delusers]
|
||||
-- deleteWhere [LmsAuditQualification ==. qid, LmsAuditIdent <-. delusers]
|
||||
|
||||
-- processes received results and lengthen qualifications, if applicable
|
||||
dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX
|
||||
@ -218,7 +218,14 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
|
||||
$logErrorS "LmsResult" errmsg
|
||||
return $ Just errmsg
|
||||
|
||||
insert_ $ LmsAudit qid lmsUserIdent newStatus note lmsResultTimestamp now -- always log success, since this is only transmitted once
|
||||
audit TransactionLmsSuccess -- always log success, since this is only transmitted once
|
||||
{ transactionQualification = qid
|
||||
, transactionLmsIdent = lmsUserIdent
|
||||
, transactionLmsDay = lmsResultSuccess
|
||||
, transactionLmsUser = Just lmsUserUser
|
||||
, transactionNote = note
|
||||
, transactionReceived = lmsResultTimestamp
|
||||
}
|
||||
delete lrid
|
||||
$logInfoS "LmsResult" [st|Processed #{tshow (length results)} LMS results|]
|
||||
|
||||
@ -260,7 +267,14 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
|
||||
let blockedDay = utctDay lReceived
|
||||
newStatus = LmsBlocked blockedDay
|
||||
oldStatus = lmsUserStatus luser
|
||||
insert_ $ LmsAudit qid (lmsUserIdent luser) newStatus (Just $ "Old Status was " <> tshow oldStatus) lReceived now
|
||||
audit TransactionLmsBlocked
|
||||
{ transactionQualification = qid
|
||||
, transactionLmsIdent = lmsUserIdent luser
|
||||
, transactionLmsDay = blockedDay
|
||||
, transactionLmsUser = Just $ lmsUserUser luser
|
||||
, transactionNote = Just $ "Old status was " <> tshow oldStatus
|
||||
, transactionReceived = lReceived
|
||||
}
|
||||
update luid [LmsUserStatus =. (oldStatus <> Just newStatus)]
|
||||
updateBy (UniqueQualificationUser qid (lmsUserUser luser)) [QualificationUserBlockedDue =. Just (QualificationBlockedLms blockedDay)]
|
||||
queueDBJob JobSendNotification
|
||||
|
||||
Reference in New Issue
Block a user