chore(lms): improve audit log for start and reset

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?
     }

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

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
               }

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