From 875d79bf01fca05bdc8e317c854c0c74408c965b Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 5 Sep 2023 15:17:04 +0000 Subject: [PATCH] chore(lms): improve audit log for start and reset --- src/Audit/Types.hs | 19 ++++++++++++++++--- src/Handler/LMS.hs | 10 ++++++++++ src/Jobs/Handler/LMS.hs | 19 ++++++++++++++----- src/Utils/Print/RenewQualification.hs | 1 + 4 files changed, 41 insertions(+), 8 deletions(-) diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index 63455c081..39824393b 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -180,12 +180,25 @@ data Transaction { transactionOldUserIdent , transactionNewUserIdent :: UserIdent } - + | TransactionLmsStart + { transactionQualification :: QualificationId + , transactionLmsIdent :: LmsIdent + , transactionLmsUser :: UserId + , transactionLmsUserKey :: LmsUserId + } + | TransactionLmsReset + { transactionQualification :: QualificationId + , transactionLmsUser :: UserId + , transactionLmsReset :: Bool + , transactionLmsResetExtend :: Maybe Integer + , transactionLmsResetUnblock :: Maybe Bool + , transactionLmsResetNotify :: Maybe Bool + } | TransactionLmsBlocked { transactionQualification :: QualificationId , transactionLmsIdent :: LmsIdent , transactionLmsDay :: Day - , transactionLmsUser :: Maybe UserId + , transactionLmsUser :: UserId , transactionNote :: Maybe Text , transactionReceived :: UTCTime -- when was the csv file received? } @@ -193,7 +206,7 @@ data Transaction { transactionQualification :: QualificationId , transactionLmsIdent :: LmsIdent , transactionLmsDay :: Day - , transactionLmsUser :: Maybe UserId + , transactionLmsUser :: UserId , transactionNote :: Maybe Text , transactionReceived :: UTCTime -- when was the csv file received? } diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index dda184d81..6a580c03a 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -739,6 +739,16 @@ postLmsR sid qsh = do forM_ selectedUsers $ \uid -> queueJob' $ JobLmsEnqueueUser { jQualification = qid, jUser = uid } + runDB $ forM_ selectedUsers $ \uid -> + audit $ TransactionLmsReset + { transactionQualification = qid + , transactionLmsUser = uid + , transactionLmsReset = isReset + , transactionLmsResetExtend = actRestartExtend + , transactionLmsResetUnblock = actRestartUnblock + , transactionLmsResetNotify = actRestartNotify + } + let mStatus = bool Success Warning $ chgUsers < numUsers addMessageI mStatus $ bool MsgLmsActRestartFeedback MsgLmsActResetFeedback isReset chgUsers numUsers reloadKeepGetParams $ LmsR sid qsh diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index de8fbcaaa..db614caef 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -154,14 +154,23 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act } -- startLmsUser :: YesodJobDB UniWorX (Maybe (Entity LmsUser)) startLmsUser = do - pw <- randomLMSpw - maybeM (pure Nothing) (E.insertUniqueEntity . mkLmsUser pw) (randomLMSIdentBut identsInUse) + lpw <- randomLMSpw + maybeM (pure Nothing) (E.insertUniqueEntity . mkLmsUser lpw) (randomLMSIdentBut identsInUse) + -- runMaybeT $ do + -- lid <- MaybeT $ randomLMSIdentBut identsInUse + -- MaybeT $ E.insertUniqueEntity $ mkLmsUser lpw lid inserted <- untilJustMaxM maxLmsUserIdentRetries startLmsUser case inserted of Nothing -> do uuid :: CryptoUUIDUser <- encrypt uid $logErrorS "LMS" $ "Generating and inserting fresh LmsIdent failed for uuid " <> tshow uuid <> " and qid " <> tshow qid <> "!" - (Just _) -> return () -- lmsUser started, but not yet notified + (Just (Entity{entityKey=lkey, entityVal=LmsUser{lmsUserIdent=lid, lmsUserUser=luid, lmsUserQualification=lqid}})) -> -- lmsUser started, but not yet notified + audit $ TransactionLmsStart + { transactionQualification = lqid + , transactionLmsIdent = lid + , transactionLmsUser = luid + , transactionLmsUserKey = lkey + } -- purge LmsIdent after QualificationAuditDuration expired @@ -413,7 +422,7 @@ dispatchJobLmsResults qid = JobHandlerAtomic act { transactionQualification = qid , transactionLmsIdent = lmsUserIdent , transactionLmsDay = lmsResultSuccess - , transactionLmsUser = Just lmsUserUser + , transactionLmsUser = lmsUserUser , transactionNote = note , transactionReceived = lmsResultTimestamp } @@ -468,7 +477,7 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act { transactionQualification = qid , transactionLmsIdent = lmsUserIdent luser , transactionLmsDay = lmsMsgDay - , transactionLmsUser = Just $ lmsUserUser luser + , transactionLmsUser = lmsUserUser luser , transactionNote = Just $ "Old status was " <> tshow oldStatus , transactionReceived = lReceived } diff --git a/src/Utils/Print/RenewQualification.hs b/src/Utils/Print/RenewQualification.hs index 55d24c5cc..db417b9b6 100644 --- a/src/Utils/Print/RenewQualification.hs +++ b/src/Utils/Print/RenewQualification.hs @@ -74,6 +74,7 @@ instance MDLetter LetterRenewQualificationF where , toMeta "login" lmsIdent , toMeta "pin" lmsPin , toMeta "examinee" qualHolderDN + , toMeta "subject-meta" qualHolderDN , toMeta "expiry" (format SelFormatDate qualExpiry) , mbMeta "validduration" (show <$> qualDuration) , toMeta "url-text" lmsUrl