chore(lms): fix #93
This commit is contained in:
parent
d9a6eab833
commit
69d689fe90
@ -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"}.
|
||||
|
||||
@ -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"}.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 =
|
||||
<dd>_{MsgLmsStatusExpired}
|
||||
<dt>^{icon IconOK}
|
||||
<dd>_{MsgLmsStatusSuccess}
|
||||
$if extendedInfo
|
||||
<dt>^{icon IconLocked}
|
||||
<dd>_{MsgLmsStatusLocked}
|
||||
<dt>^{icon IconUnlocked}
|
||||
<dd>_{MsgLmsStatusUnlocked}
|
||||
<dt>^{icon IconUndo}
|
||||
<dd>_{MsgLmsStatusResetTries}
|
||||
<p>
|
||||
_{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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user