chore(lms): fix #93

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
+LmsActReset: E‑Learning Fehlversuche zurücksetzen und entsperren
-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.
+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.
-LmsActRestartFeedback n@Int m@Int: #{n}/#{m} E-Learning wurden neu gestartet.
+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"}.

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
+LmsActReset: Reset and unlock 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.
+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"}.

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 
+          isReset   = isResetAct action
-        when (lmsActRestartUnblock == Just True) $ do
+          actRestartExtend  = action & lmsActRestartExtend  
-          oks <- qualificationUserBlocking qid usersList True Nothing (Left "Manueller LMS Neustart") (fromMaybe True lmsActRestartNotify)
+          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 ->
+      unless isReset $ 
-        queueJob' $ JobLmsEnqueueUser { jQualification = qid, jUser = uid }
+        forM_ selectedUsers $ \uid ->
-      let mStatus  = bool Success Warning $ delUsers < numUsers
+          queueJob' $ JobLmsEnqueueUser { jQualification = qid, jUser = uid }
-      addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers      
+
+      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      

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 && 
+lmsUserToResetTries LmsUser{..} = lmsUserResetTries && lmsUserLocked &&
-                                  (lmsUserStatus == Just LmsBlocked || lmsUserStatus == Just LmsExpired) 
+                                  (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} =
+lmsUserStatusWidget isAdmin luser
-  [whamlet|$newline never
+    | isAdmin   = lmsUserStatusWidgetAux isAdmin luser <> toWidget lockIcon <> toWidget resetIcon
-    ^{formatTimeW SelFormatDate aday}
+    | otherwise = lmsUserStatusWidgetAux isAdmin luser
-    \ ^{icon (lmsStatusIcon lStat)}
+  where
-  |]
+    lmsUserStatusWidgetAux _ LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=Just aday} =
--- previously: IconWaitingForUser for lmsUserStatus==Nothing
+      [whamlet|$newline never
-lmsUserStatusWidget _ LmsUser{lmsUserNotified=Just d} =
+        ^{formatTimeW SelFormatDate aday}
-  [whamlet|$newline never
+        \ ^{icon (lmsStatusIcon lStat)}
-    ^{formatTimeW SelFormatDate d}
+      |]
-    \ ^{icon IconNotificationSent}
+    -- previously: IconWaitingForUser for lmsUserStatus==Nothing
-  |]
+    lmsUserStatusWidgetAux _ LmsUser{lmsUserNotified=Just d} =
-lmsUserStatusWidget True LmsUser{lmsUserStarted} =  -- E-Learning started, but not yet notified; only intended for Admins
+      [whamlet|$newline never
-  [whamlet|$newline never
+        ^{formatTimeW SelFormatDate d}
-    ^{formatTimeW SelFormatDate lmsUserStarted}
+        \ ^{icon IconNotificationSent}
-    \ ^{icon IconPlanned}
+      |]
-  |]
+    lmsUserStatusWidgetAux True LmsUser{lmsUserStarted} =  -- E-Learning started, but not yet notified; only intended for Admins
-lmsUserStatusWidget _ _ = mempty
+      [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
+

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