fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(audit): replace lms audit table with Transaction log entries

Browse Source
This commit is contained in:
Sarah Vaupel 2022-12-13 19:58:56 +01:00
parent 8dc7d18bf1
commit 71cde92a1a
3 changed files with 39 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
models/lms.model
View File

@ -134,13 +134,3 @@ LmsResult
timestamp UTCTime default=now() timestamp UTCTime default=now()
UniqueLmsResult qualification ident -- required by DBTable UniqueLmsResult qualification ident -- required by DBTable
deriving Generic 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

33
src/Audit/Types.hs
View File

@ -64,17 +64,6 @@ data Transaction
, transactionUser :: UserId , transactionUser :: UserId
} }
| TransactionCourseApplicationEdit
{ transactionCourse :: CourseId
, transactionUser :: UserId
, transactionCourseApplication :: CourseApplicationId
}
| TransactionCourseApplicationDeleted
{ transactionCourse :: CourseId
, transactionUser :: UserId
, transactionCourseApplication :: CourseApplicationId
}
| TransactionSubmissionEdit | TransactionSubmissionEdit
{ transactionSubmission :: SubmissionId { transactionSubmission :: SubmissionId
, transactionSheet :: SheetId , transactionSheet :: SheetId
@ -181,14 +170,24 @@ data Transaction
, transactionNewUserIdent :: UserIdent , transactionNewUserIdent :: UserIdent
} }
| TransactionAllocationUserEdited | TransactionLmsBlocked
{ transactionUser :: UserId { transactionQualification :: QualificationId
, transactionAllocation :: AllocationId , transactionLmsIdent :: LmsIdent
, transactionLmsDay :: Day
, transactionLmsUser :: Maybe UserId
, transactionNote :: Maybe Text
, transactionReceived :: UTCTime -- when was the csv file received?
} }
| TransactionAllocationUserDeleted | TransactionLmsSuccess
{ transactionUser :: UserId { transactionQualification :: QualificationId
, transactionAllocation :: AllocationId , 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) deriving (Eq, Ord, Read, Show, Generic, Typeable)

32
src/Jobs/Handler/LMS.hs
View File

@ -153,12 +153,12 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
E.&&. luser E.^. LmsUserEnded E.<. E.just (E.val auditCutoff) E.&&. luser E.^. LmsUserEnded E.<. E.just (E.val auditCutoff)
E.&&. E.isJust (luser E.^. LmsUserEnded) E.&&. E.isJust (luser E.^. LmsUserEnded)
E.&&. E.notExists (do -- E.&&. E.notExists (do
laudit <- E.from $ E.table @LmsAudit -- laudit <- E.from $ E.table @LmsAudit
E.where_ $ laudit E.^. LmsAuditQualification E.==. E.val qid -- E.where_ $ laudit E.^. LmsAuditQualification E.==. E.val qid
E.&&. laudit E.^. LmsAuditIdent E.==. luser E.^. LmsUserIdent -- E.&&. laudit E.^. LmsAuditIdent E.==. luser E.^. LmsUserIdent
E.&&. laudit E.^. LmsAuditProcessed E.>=. E.val auditCutoff -- E.&&. laudit E.^. LmsAuditProcessed E.>=. E.val auditCutoff
) -- )
pure (luser E.^. LmsUserIdent) pure (luser E.^. LmsUserIdent)
let delusers = E.unValue <$> delusersVals let delusers = E.unValue <$> delusersVals
numdel = length delusers numdel = length delusers
@ -167,7 +167,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
deleteWhere [LmsUserQualification ==. qid, LmsUserIdent <-. delusers] deleteWhere [LmsUserQualification ==. qid, LmsUserIdent <-. delusers]
deleteWhere [LmsUserlistQualification ==. qid, LmsUserlistIdent <-. delusers] deleteWhere [LmsUserlistQualification ==. qid, LmsUserlistIdent <-. delusers]
deleteWhere [LmsResultQualification ==. qid, LmsResultIdent <-. delusers] deleteWhere [LmsResultQualification ==. qid, LmsResultIdent <-. delusers]
deleteWhere [LmsAuditQualification ==. qid, LmsAuditIdent <-. delusers] -- deleteWhere [LmsAuditQualification ==. qid, LmsAuditIdent <-. delusers]
-- processes received results and lengthen qualifications, if applicable -- processes received results and lengthen qualifications, if applicable
dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX
@ -218,7 +218,14 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
$logErrorS "LmsResult" errmsg $logErrorS "LmsResult" errmsg
return $ Just 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 delete lrid
$logInfoS "LmsResult" [st|Processed #{tshow (length results)} LMS results|] $logInfoS "LmsResult" [st|Processed #{tshow (length results)} LMS results|]
@ -260,7 +267,14 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
let blockedDay = utctDay lReceived let blockedDay = utctDay lReceived
newStatus = LmsBlocked blockedDay newStatus = LmsBlocked blockedDay
oldStatus = lmsUserStatus luser 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)] update luid [LmsUserStatus =. (oldStatus <> Just newStatus)]
updateBy (UniqueQualificationUser qid (lmsUserUser luser)) [QualificationUserBlockedDue =. Just (QualificationBlockedLms blockedDay)] updateBy (UniqueQualificationUser qid (lmsUserUser luser)) [QualificationUserBlockedDue =. Just (QualificationBlockedLms blockedDay)]
queueDBJob JobSendNotification queueDBJob JobSendNotification