From 69d689fe90bcef6bc7c6ae3ad5acd928882cd422 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 29 Aug 2023 11:27:35 +0000 Subject: [PATCH] chore(lms): fix #93 --- .../categories/qualification/de-de-formal.msg | 14 ++-- .../categories/qualification/en-eu.msg | 12 +++- src/Handler/LMS.hs | 56 ++++++++++++---- src/Handler/Utils/LMS.hs | 65 ++++++++++++------- src/Utils/Icon.hs | 4 ++ 5 files changed, 110 insertions(+), 41 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index b19a8eba5..522edafb9 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -74,7 +74,7 @@ FilterLmsNotified: Benachrichtigt FilterLmsNotificationDue: Benachrichtigung erforderlich CsvColumnLmsIdent: E‑Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer CsvColumnLmsPin: Passwort E#{nonBreakableDash}Learning Zugang -CsvColumnLmsResetPin: Wird das E-Learning Passwort bei der nächsten Synchronisation zurückgesetzt? +CsvColumnLmsResetPin: Wird das E‑Learning Passwort bei der nächsten Synchronisation zurückgesetzt? CsvColumnLmsDelete: Wird der Identifikator in der E‑Learning Plattform bei der nächsten Synchronisation gelöscht? CsvColumnLmsStaff: Handelt es sich um einen internen Mitarbeiter? (Aus historischen Gründen, wird momentan ignoriert.) CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme @@ -119,11 +119,17 @@ LmsRenewalReminder: Erinnerung LmsActNotify: Benachrichtigung E‑Learning erneut per Post oder E-Mail versenden LmsActRenewPin: Neues zufällige E‑Learning Passwort zuweisen LmsActRenewNotify: Neue zufällige E‑Learning Passwort zuweisen und Benachrichtigung per Post oder E-Mail versenden -LmsActRestart: E-Learning neu starten -LmsActRestartWarning: Das vorhandene E-Learning wird sofort komplett gelöscht! Für Inhaber einer gültigen Fahrlizenz werden später Benutzer und Passwort neu vergeben und es wird eine neue Benachrichtigung versendet werden. -LmsActRestartFeedback n@Int m@Int: #{n}/#{m} E-Learning wurden neu gestartet. +LmsActReset: E‑Learning Fehlversuche zurücksetzen und entsperren +LmsActResetInfo: E‑Learning Login und Passwort bleiben unverändert, eine neue Benachrichtigung ist nicht notwendig. Nur möglich für bereits gesperrte Lerner. Es kann bis zu 2 Stunden dauern, bis das LMS die Anfrage umgesetzt hat. +LmsActResetFeedback n@Int m@Int: Für #{n}/#{m} E‑Learning Nutzer wurden alle Fehlversuche zurückgesetzt. +LmsActRestart: E‑Learning komplett neu starten +LmsActRestartWarning: Das vorhandene E‑Learning wird komplett gelöscht! Für Inhaber einer gültigen Fahrlizenz werden später Benutzer und Passwort neu vergeben und es sollte eine neue Benachrichtigung versendet werden. Hinweis: Es kann mehrere Stunden dauern, bis das LMS diese Anfrage umgesetzt hat. +LmsActRestartFeedback n@Int m@Int: #{n}/#{m} E‑Learning Nutzer wurden komplett neu gestartet mit neuem Login und Passwort. LmsActRestartExtend: Gültig bis ggf. erhöhen für die nächsten # Tage LmsActRestartUnblock: Entzug ggf. aufheben +LmsStatusLocked: E‑Learning gesperrt, wird ggf. bald geöffnet +LmsStatusUnlocked: E‑Learning offen, wird ggf. bald gesperrt +LmsStatusResetTries: Fehlversuche werden demnächst zurückgesetzt LmsStatusNotificationSent: Anmeldedaten wurden an Prüfling oder Ansprechpartner per Post oder E#{nonBreakableDash}Mail versendet; E#{nonBreakableDash}Learning ist derzeit offen LmsNotificationSend n@Int: E‑Learning Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet. LmsPinRenewal n@Int: E‑Learning Passwort ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}. diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index f13dff6fd..6cdd9c8e8 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -119,11 +119,17 @@ LmsRenewalReminder: Reminder LmsActNotify: Resend e‑learning notification by post or email LmsActRenewPin: Randomly replace e‑learning password LmsActRenewNotify: Randomly replace e‑learning password and re-send notification by post or email -LmsActRestart: Restart e-learning -LmsActRestartWarning: The existing e-learning will be erased immediately! For drivers with a valid licence, user and password will later be generated anew and a notification will be queued as usual. +LmsActReset: Reset and unlock e‑learning +LmsActResetInfo: E‑learning login and password remain unchanged; a notification is thus not necessary. This is only possible for already failed learners. Note that the reset procedure may take up to 2 hours. +LmsActResetFeedback n@Int m@Int: For #{n}/#{m} learners all failures were erased, preserving login credentials. +LmsActRestart: Restart e‑learning +LmsActRestartWarning: The existing e‑learning will be erased immediately! For drivers with a valid licence, user and password will later be generated anew and a notification will be queued as usual, which may take several hours. LmsActRestartExtend: Ensure validity for the next # days LmsActRestartUnblock: Undo any revocations -LmsActRestartFeedback n@Int m@Int: #{n}/#{m} e-learnings were restarted. +LmsActRestartFeedback n@Int m@Int: #{n}/#{m} e-learnings were completely restarted with new login credentials. +LmsStatusLocked: E‑Learning locked, may be opened soon +LmsStatusUnlocked: E‑Learning still open, may be locked soon +LmsStatusResetTries: Failed attempts will be soon reset LmsStatusNotificationSent: E‑learning password has been sent to examinee or supervisor by letter post or by email; e‑learning is currently open LmsNotificationSend n: E‑learning notifications will be sent to #{n} #{pluralENs n "examinee"} by letter post or by email. LmsPinRenewal n: E‑learning password replaced randomly for #{n} #{pluralENs n "examinee"}. diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 11cc8af9a..935012e97 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -50,7 +50,7 @@ import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.PostgreSQL as E import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH -import Database.Persist.Sql (deleteWhereCount) +import Database.Persist.Sql (deleteWhereCount, updateWhereCount) -- V1 import Handler.LMS.Users as Handler.LMS import Handler.LMS.Userlist as Handler.LMS @@ -349,6 +349,7 @@ instance HasQualificationUser LmsTableData where data LmsTableAction = LmsActNotify | LmsActRenewNotify | LmsActRenewPin + | LmsActReset | LmsActRestart deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) @@ -360,6 +361,11 @@ embedRenderMessage ''UniWorX ''LmsTableAction id data LmsTableActionData = LmsActNotifyData | LmsActRenewNotifyData | LmsActRenewPinData -- no longer used + | LmsActResetData + { lmsActRestartExtend :: Maybe Integer + , lmsActRestartUnblock :: Maybe Bool + , lmsActRestartNotify :: Maybe Bool + } | LmsActRestartData { lmsActRestartExtend :: Maybe Integer , lmsActRestartUnblock :: Maybe Bool @@ -377,6 +383,15 @@ isRenewPinAct LmsActRenewNotifyData = True isRenewPinAct LmsActRenewPinData = True isRenewPinAct _ = False +isResetAct :: LmsTableActionData -> Bool +isResetAct LmsActResetData{} = True +isResetAct _ = False + +isRestartResetAct :: LmsTableActionData -> Bool +isRestartResetAct LmsActRestartData{} = True +isRestartResetAct other = isResetAct other + + lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser) , E.SqlExpr (Entity User) @@ -582,7 +597,9 @@ postLmsR sid qsh = do isAdmin <- hasReadAccessTo AdminR now <- liftIO getCurrentTime let nowaday = utctDay now - msgRestartWarning <- messageIconI Warning IconWarning MsgLmsActRestartWarning + msgResetInfo <- messageIconI Info IconNotificationNonactive MsgLmsActResetInfo + msgRestartWarning <- messageIconI Warning IconWarning MsgLmsActRestartWarning + ((lmsRes, lmsTable), Entity qid quali) <- runDB $ do qent <- getBy404 $ SchoolQualificationShort sid qsh let acts :: Map LmsTableAction (AForm Handler LmsTableActionData) @@ -590,6 +607,11 @@ postLmsR sid qsh = do [ singletonMap LmsActNotify $ pure LmsActNotifyData , singletonMap LmsActRenewNotify $ pure LmsActRenewNotifyData -- , singletonMap LmsActRenewPin $ pure LmsActRenewPinData + , singletonMap LmsActReset $ LmsActResetData + <$> aopt intField (fslI MsgLmsActRestartExtend) Nothing + <*> aopt checkBoxField (fslI MsgLmsActRestartUnblock) Nothing + <*> aopt checkBoxField (fslI MsgLmsActNotify) Nothing + <* aformMessage msgResetInfo , singletonMap LmsActRestart $ LmsActRestartData <$> aopt intField (fslI MsgLmsActRestartExtend) Nothing <*> aopt checkBoxField (fslI MsgLmsActRestartUnblock) Nothing @@ -681,15 +703,20 @@ postLmsR sid qsh = do formResult lmsRes $ \case _ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page - (LmsActRestartData{..}, selectedUsers) -> do + (action, selectedUsers) | isRestartResetAct action -> do let usersList = Set.toList selectedUsers numUsers = Set.size selectedUsers - delUsers <- runDB $ do - when (lmsActRestartUnblock == Just True) $ do - oks <- qualificationUserBlocking qid usersList True Nothing (Left "Manueller LMS Neustart") (fromMaybe True lmsActRestartNotify) + isReset = isResetAct action + actRestartExtend = action & lmsActRestartExtend + actRestartUnblock = action & lmsActRestartUnblock + actRestartNotify = action & lmsActRestartNotify + + chgUsers <- runDB $ do + when (actRestartUnblock == Just True) $ do + oks <- qualificationUserBlocking qid usersList True Nothing (Left $ bool "Manueller LMS Neustart" "Manuelle LMS Zurücksetzung" isReset) (fromMaybe True actRestartNotify) addMessageI Success $ MsgQualificationStatusUnblock qsh oks numUsers - whenIsJust lmsActRestartExtend $ \extDays -> do + whenIsJust actRestartExtend $ \extDays -> do let cutoff = addDays extDays nowaday shortUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList [ QualificationUserQualification ==. qid @@ -698,12 +725,17 @@ postLmsR sid qsh = do ] [] forM_ shortUsers $ upsertQualificationUser qid nowaday cutoff Nothing - fromIntegral <$> deleteWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. usersList] + fromIntegral <$> (if isReset + then updateWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. usersList] [LmsUserResetTries =. True] + else deleteWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. usersList] + ) - forM_ selectedUsers $ \uid -> - queueJob' $ JobLmsEnqueueUser { jQualification = qid, jUser = uid } - let mStatus = bool Success Warning $ delUsers < numUsers - addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers + unless isReset $ + forM_ selectedUsers $ \uid -> + queueJob' $ JobLmsEnqueueUser { jQualification = qid, jUser = uid } + + let mStatus = bool Success Warning $ chgUsers < numUsers + addMessageI mStatus $ bool MsgLmsActRestartFeedback MsgLmsActResetFeedback isReset chgUsers numUsers reloadKeepGetParams $ LmsR sid qsh (action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do diff --git a/src/Handler/Utils/LMS.hs b/src/Handler/Utils/LMS.hs index 68c5501a7..a7d8f7467 100644 --- a/src/Handler/Utils/LMS.hs +++ b/src/Handler/Utils/LMS.hs @@ -95,7 +95,7 @@ csvLmsLock = fromString "lock" -- Ist der Login derzeit gesperrt? V2 csvLmsBlocked :: IsString a => a csvLmsBlocked = fromString "blocked" -- "Sperrung" V1 --- for Result Table V1 +-- for Result Table V1 csvLmsSuccess :: IsString a => a csvLmsSuccess = fromString "success" -- "Datum" V1 @@ -143,7 +143,7 @@ lmsUserToDeleteExpr cutoff lmslist = E.isNothing (lmslist E.^. LmsUserEnded) E.&&. E.isJust (lmslist E.^. LmsUserStatus) E.&&. E.isJust (lmslist E.^. LmsUserStatusDay) E.&&. lmslist E.^. LmsUserStatusDay E.<=. E.justVal cutoff - + -- | Is everything since cutoff day or before? lmsUserToDelete :: Day -> LmsUser -> Bool lmsUserToDelete cutoff LmsUser{lmsUserEnded=Nothing, lmsUserStatusDay= Just lstat} = lstat < cutoff @@ -154,11 +154,11 @@ _lmsUserToDelete cutoff = to $ lmsUserToDelete cutoff lmsUserToResetTries :: LmsUser -> Bool -lmsUserToResetTries LmsUser{..} = lmsUserResetTries && lmsUserLocked && - (lmsUserStatus == Just LmsBlocked || lmsUserStatus == Just LmsExpired) +lmsUserToResetTries LmsUser{..} = lmsUserResetTries && lmsUserLocked && + (lmsUserStatus == Just LmsBlocked || lmsUserStatus == Just LmsExpired) -- only reset blocked learners --- | Answers "Should the LMS lock a user out?" +-- | Answers "Should the LMS lock a user out?" -- Note that LmsUserLocked only logs the current LMS state, not what it should be. lmsUserToLock :: LmsUser -> Bool lmsUserToLock LmsUser{..} = isNothing lmsUserStatus -- only open LMS should be accessible @@ -225,6 +225,13 @@ lmsStatusInfoCell extendedInfo auditMonths =
_{MsgLmsStatusExpired}
^{icon IconOK}
_{MsgLmsStatusSuccess} + $if extendedInfo +
^{icon IconLocked} +
_{MsgLmsStatusLocked} +
^{icon IconUnlocked} +
_{MsgLmsStatusUnlocked} +
^{icon IconUndo} +
_{MsgLmsStatusResetTries}

_{MsgLmsStatusDelay} |] @@ -235,20 +242,34 @@ lmsStatusIcon LmsExpired{} = IconExpired lmsStatusIcon _other = IconNotOK lmsUserStatusWidget :: Bool -> LmsUser -> Widget -lmsUserStatusWidget _ LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=Just aday} = - [whamlet|$newline never - ^{formatTimeW SelFormatDate aday} - \ ^{icon (lmsStatusIcon lStat)} - |] --- previously: IconWaitingForUser for lmsUserStatus==Nothing -lmsUserStatusWidget _ LmsUser{lmsUserNotified=Just d} = - [whamlet|$newline never - ^{formatTimeW SelFormatDate d} - \ ^{icon IconNotificationSent} - |] -lmsUserStatusWidget True LmsUser{lmsUserStarted} = -- E-Learning started, but not yet notified; only intended for Admins - [whamlet|$newline never - ^{formatTimeW SelFormatDate lmsUserStarted} - \ ^{icon IconPlanned} - |] -lmsUserStatusWidget _ _ = mempty +lmsUserStatusWidget isAdmin luser + | isAdmin = lmsUserStatusWidgetAux isAdmin luser <> toWidget lockIcon <> toWidget resetIcon + | otherwise = lmsUserStatusWidgetAux isAdmin luser + where + lmsUserStatusWidgetAux _ LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=Just aday} = + [whamlet|$newline never + ^{formatTimeW SelFormatDate aday} + \ ^{icon (lmsStatusIcon lStat)} + |] + -- previously: IconWaitingForUser for lmsUserStatus==Nothing + lmsUserStatusWidgetAux _ LmsUser{lmsUserNotified=Just d} = + [whamlet|$newline never + ^{formatTimeW SelFormatDate d} + \ ^{icon IconNotificationSent} + |] + lmsUserStatusWidgetAux True LmsUser{lmsUserStarted} = -- E-Learning started, but not yet notified; only intended for Admins + [whamlet|$newline never + ^{formatTimeW SelFormatDate lmsUserStarted} + \ ^{icon IconPlanned} + |] + lmsUserStatusWidgetAux _ _ = mempty + + lockIcon + | lmsUserLocked luser == lmsUserToLock luser = mempty + | lmsUserLocked luser = icon IconLocked + | otherwise = icon IconUnlocked + + resetIcon + | lmsUserResetTries luser = icon IconUndo + | otherwise = mempty + diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index b90fcdf9b..ec27e5c53 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -112,6 +112,8 @@ data Icon -- | IconWaitingForUser | IconExpired | IconLocked + | IconUnlocked + | IconUndo -- also see IconReset deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic) deriving anyclass (Universe, Finite, NFData) @@ -201,6 +203,8 @@ iconText = \case -- IconWaitingForUser -> "user-cog" -- Waiting on a user to do something IconExpired -> "hourglass-end" IconLocked -> "lock" + IconUnlocked -> "lock-open-alt" + IconUndo -> "trash-undo" nullaryPathPiece ''Icon $ camelToPathPiece' 1 deriveLift ''Icon