diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg
index 203bd9c17..25b99e954 100644
--- a/messages/uniworx/categories/qualification/de-de-formal.msg
+++ b/messages/uniworx/categories/qualification/de-de-formal.msg
@@ -35,11 +35,11 @@ QualificationExpired: Ungültig seit
LmsUser: Inhaber
LmsURL: Link E‑Learning
TableLmsEmail: E‑Mail
-TableLmsIdent: LMS Identifikation
+TableLmsIdent: E-Learnung Benutzer
TableLmsElearning: E‑Learning
-TableLmsPin: E‑Learning Pin
-TableLmsResetPin: Pin zurücksetzen?
-TableLmsDatePin: Pin erstellt
+TableLmsPin: E‑Learning Passwort
+TableLmsResetPin: E-Learning Passwort zurücksetzen?
+TableLmsDatePin: E-Learning Passwort erstellt
TableLmsDelete: Löschen?
TableLmsStaff: Interner Mitarbeiter?
TableLmsStarted: Begonnen
@@ -61,8 +61,8 @@ FilterLmsValid: Aktuell gültig
FilterLmsRenewal: Erneuerung anstehend
FilterLmsNotified: Benachrichtigt
CsvColumnLmsIdent: E‑Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer
-CsvColumnLmsPin: PIN des E#{nonBreakableDash}Learning Zugangs
-CsvColumnLmsResetPin: Wird die PIN bei der nächsten Synchronisation zurückgesetzt?
+CsvColumnLmsPin: Passwort E#{nonBreakableDash}Learning Zugang
+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 (UTC)
@@ -95,11 +95,14 @@ QualificationStatusUnblock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l}
LmsRenewalInstructions: Weitere Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF mit dem im FRADrive hinterlegten PDF-Passwort des Prüflings verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort die Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach.
LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E‑Learning verlängert werden.
LmsActNotify: Benachrichtigung E‑Learning erneut per Post oder E-Mail versenden
-LmsActRenewPin: Neue zufällige E‑Learning PIN zuweisen
-LmsActRenewNotify: Neue zufällige E‑Learning PIN zuweisen und Benachrichtigung 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. Benutzer und Passwort werden neu vergeben und es wird eine neue Benachrichtigung versendet werden.
+LmsActRestartFeedback n@Int m@Int: #{n}/#{m} E-Learning wurden neu gestartet.
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 Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}.
+LmsPinRenewal n@Int: E‑Learning Passwort ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}.
LmsActionFailed n@Int: Aktion nicht durchgeführt für #{n} #{pluralDE n "Person" "Personen"}, da diese derzeit nicht an einer Prüfung teilnehmen.
LmsStarted: E‑Learning eröffnet
LmsAutomaticQueuing n@Natural: Die folgenden Funktionen werden normalerweise einmal pro Tag um #{show n} Uhr ausgeführt.
diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg
index 3c2037be0..8e7eea4b5 100644
--- a/messages/uniworx/categories/qualification/en-eu.msg
+++ b/messages/uniworx/categories/qualification/en-eu.msg
@@ -35,11 +35,11 @@ QualificationExpired: Expired on
LmsUser: Licensee
LmsURL: Link E-learning
TableLmsEmail: Email
-TableLmsIdent: LMS Identifier
-TableLmsPin: E‑learning pin
+TableLmsIdent: E-learning user
+TableLmsPin: E‑learning password
TableLmsElearning: E‑learning
-TableLmsResetPin: Reset pin?
-TableLmsDatePin: Pin created
+TableLmsResetPin: Reset E-learning password?
+TableLmsDatePin: E-learning password created
TableLmsDelete: Delete?
TableLmsStaff: Staff?
TableLmsStarted: Started
@@ -61,8 +61,8 @@ FilterLmsValid: Currently valid
FilterLmsRenewal: Renewal due
FilterLmsNotified: Notified
CsvColumnLmsIdent: E#{nonBreakableDash}learning identifier, unique for each qualification and user
-CsvColumnLmsPin: PIN for e#{nonBreakableDash}learning access
-CsvColumnLmsResetPin: Will the e#{nonBreakableDash}learning PIN be reset upon next synchronisation?
+CsvColumnLmsPin: Password e#{nonBreakableDash}learning access
+CsvColumnLmsResetPin: Will the e#{nonBreakableDash}learning password be reset upon next synchronisation?
CsvColumnLmsDelete: Will the identifier be deleted from the E-learning platfrom upon next synchronisation?
CsvColumnLmsStaff: Is the user an internal staff member? (Legacy, currently ignored)
CsvColumnLmsSuccess: Timestamp of successful completion (UTC)
@@ -95,11 +95,14 @@ QualificationStatusUnblock l n m: #{n}/#{m} #{l} reactivated
LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with the FRADrive PDF-password of the examinee. If no PDF-password had been chosen yet, then the password is the Fraport id card number of the examinee, including the punctuation mark and the digit thereafter.
LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only.
LmsActNotify: Resend e‑learning notification by post or email
-LmsActRenewPin: Randomly replace e‑learning PIN
-LmsActRenewNotify: Randomly replace e‑learning PIN and re-send notification by post or email
-LmsStatusNotificationSent: E-learning pin has been sent to examinee or supervisor by letter post or by email; e‑learning is currently open
+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. User and password will be generated anew and a notification will be queued as usual.
+LmsActRestartFeedback n@Int m@Int: #{n}/#{m} e-learnings were restarted.
+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 pin replaced randomly for #{n} #{pluralENs n "examinee"}.
+LmsPinRenewal n: E-learning password replaced randomly for #{n} #{pluralENs n "examinee"}.
LmsActionFailed n: No action for #{n} #{pluralENs n "person"}, since there was no ongoing examination.
LmsStarted: E-learning open since
LmsAutomaticQueuing n@Natural: The following functions are executed daily at #{show n} o'clock.
diff --git a/routes b/routes
index e8067afcf..32721396e 100644
--- a/routes
+++ b/routes
@@ -279,9 +279,11 @@
/lms/#SchoolId/#QualificationShorthand/result LmsResultR GET POST
/lms/#SchoolId/#QualificationShorthand/result/upload LmsResultUploadR GET POST !development
/lms/#SchoolId/#QualificationShorthand/result/direct LmsResultDirectR POST !token -- LMS
+/lms/#SchoolId/#QualificationShorthand/ident/#LmsIdent LmsIdentR GET -- redirect to LmsR with filter-parameter
/lmsuser/#CryptoUUIDUser LmsUserR GET
+
/api ApiDocsR GET !free
/swagger SwaggerR GET !free
/swagger.json SwaggerJsonR GET !free
diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs
index a4920014f..b889d5436 100644
--- a/src/Foundation/Navigation.hs
+++ b/src/Foundation/Navigation.hs
@@ -185,6 +185,7 @@ breadcrumb (LmsUserlistDirectR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Jus
breadcrumb (LmsResultR ssh qsh) = i18nCrumb MsgMenuLmsResult $ Just $ LmsR ssh qsh
breadcrumb (LmsResultUploadR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh
breadcrumb (LmsResultDirectR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh -- never displayed
+breadcrumb (LmsIdentR ssh qsh _ ) = breadcrumb $ LmsR ssh qsh -- just a redirect
breadcrumb (LmsUserR _) = i18nCrumb MsgMenuLmsUser $ Just LmsAllR
-- breadcrumb (LmsFakeR ssh qsh) = i18nCrumb MsgMenuLmsFake $ Just $ LmsR ssh qsh -- TODO: remove in production
diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs
index 4685994f0..8cfda0043 100644
--- a/src/Handler/LMS.hs
+++ b/src/Handler/LMS.hs
@@ -10,6 +10,7 @@ module Handler.LMS
( getLmsAllR , postLmsAllR
, getLmsSchoolR
, getLmsR , postLmsR
+ , getLmsIdentR
, getLmsEditR , postLmsEditR
, getLmsUsersR , getLmsUsersDirectR
, getLmsUserlistR , postLmsUserlistR
@@ -41,6 +42,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 Handler.LMS.Users as Handler.LMS
import Handler.LMS.Userlist as Handler.LMS
@@ -316,6 +318,7 @@ instance HasUser LmsTableData where
data LmsTableAction = LmsActNotify
| LmsActRenewNotify
| LmsActRenewPin
+ | LmsActRestart
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
instance Universe LmsTableAction
@@ -326,18 +329,19 @@ embedRenderMessage ''UniWorX ''LmsTableAction id
-- Not yet needed, since there is no additional data for now:
data LmsTableActionData = LmsActNotifyData
| LmsActRenewNotifyData
- | LmsActRenewPinData -- no longer used
+ | LmsActRenewPinData -- no longer used
+ | LmsActRestartData
deriving (Eq, Ord, Read, Show, Generic)
isNotifyAct :: LmsTableActionData -> Bool
isNotifyAct LmsActNotifyData = True
isNotifyAct LmsActRenewNotifyData = True
-isNotifyAct LmsActRenewPinData = False
+isNotifyAct _ = False
isRenewPinAct :: LmsTableActionData -> Bool
-isRenewPinAct LmsActNotifyData = False
isRenewPinAct LmsActRenewNotifyData = True
isRenewPinAct LmsActRenewPinData = True
+isRenewPinAct _ = False
lmsTableQuery :: QualificationId -> LmsTableExpr
-> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
@@ -385,7 +389,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
-- mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
dbtIdent :: Text
- dbtIdent = "qualification"
+ dbtIdent = "lms"
dbtSQLQuery = lmsTableQuery qid
dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjSimple $ \(qualUsr, usr, lmsUsr, printAcks) -> do
@@ -401,14 +405,14 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
, single ("first-held" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
, single ("blocked-due" , SortColumnNeverNull$ queryQualUser >>> (E.^. QualificationUserBlockedDue))
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))
- , single ("lms-ident" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserIdent))
- , single ("lms-pin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserPin))
- , single ("lms-status" , SortColumnNullsInv $ views (to queryLmsUser) (E.^. LmsUserStatus))
- , single ("lms-started" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserStarted))
- , single ("lms-datepin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserDatePin))
- , single ("lms-received" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserReceived))
- , single ("lms-notified" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserNotified)) -- cannot include printJob acknowledge date
- , single ("lms-ended" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserEnded))
+ , single ("ident" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserIdent))
+ , single ("pin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserPin))
+ , single ("status" , SortColumnNullsInv $ views (to queryLmsUser) (E.^. LmsUserStatus))
+ , single ("started" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserStarted))
+ , single ("datepin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserDatePin))
+ , single ("received" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserReceived))
+ , single ("notified" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserNotified)) -- cannot include printJob acknowledge date
+ , single ("ended" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserEnded))
, single ( "user-company" , SortColumn $ \row -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId
@@ -418,8 +422,8 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
]
dbtFilter = mconcat
[ single $ fltrUserNameEmail queryUser
- , single ("lms-ident" , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsUser) (E.^. LmsUserIdent))
- -- , single ("lms-status" , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB
+ , single ("ident" , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsUser) (E.^. LmsUserIdent))
+ -- , single ("status" , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB
-- , single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil)))
, single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) (validQualification nowaday))
-- , single ("renewal-due" , FilterColumn $ \(queryQualUser -> quser) criterion ->
@@ -428,7 +432,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
-- E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday
-- | otherwise -> E.true
-- )
- , single ("lms-notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.^. LmsUserNotified)))
+ , single ("notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.^. LmsUserNotified)))
, single ("avs-number" , FilterColumn . E.mkExistsFilter $ \row criterion ->
E.from $ \usrAvs -> -- do
E.where_ $ usrAvs E.^. UserAvsUser E.==. queryUser row E.^. UserId
@@ -461,10 +465,10 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
, prismAForm (singletonFilter "avs-card" ) mPrev $ aopt textField (fslI MsgAvsCardNo)
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
- , prismAForm (singletonFilter "lms-ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
+ , prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
- , prismAForm (singletonFilter "lms-notified" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsNotified)
- -- , prismAForm (singletonFilter "lms-status" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return (optionsPairs [(MsgTableLmsSuccess,"success"::Text),(MsgTableLmsFailed,"blocked")])) (fslI MsgTableLmsStatus)
+ , prismAForm (singletonFilter "notified" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsNotified)
+ -- , prismAForm (singletonFilter "status" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return (optionsPairs [(MsgTableLmsSuccess,"success"::Text),(MsgTableLmsFailed,"blocked")])) (fslI MsgTableLmsStatus)
-- , if isNothing mbRenewal then mempty
-- else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
]
@@ -538,7 +542,8 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
getLmsR, postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsR = postLmsR
postLmsR sid qsh = do
- isAdmin <- hasReadAccessTo AdminR
+ isAdmin <- hasReadAccessTo AdminR
+ msgRestartWarning <- messageIconI Warning IconWarning MsgLmsActRestartWarning
((lmsRes, lmsTable), Entity qid quali) <- runDB $ do
qent <- getBy404 $ SchoolQualificationShort sid qsh
let acts :: Map LmsTableAction (AForm Handler LmsTableActionData)
@@ -546,6 +551,8 @@ postLmsR sid qsh = do
[ singletonMap LmsActNotify $ pure LmsActNotifyData
, singletonMap LmsActRenewNotify $ pure LmsActRenewNotifyData
-- , singletonMap LmsActRenewPin $ pure LmsActRenewPinData
+ , singletonMap LmsActRestart $ LmsActRestartData <$ aformMessage msgRestartWarning
+ -- <*> aopt (commentField MsgQualificationActBlockSupervisor) (fslI MsgMessageWarning) Nothing
]
-- lmsStatusLink = toMaybe isAdmin LmsUserR
colChoices cmpMap = mconcat
@@ -569,15 +576,15 @@ postLmsR sid qsh = do
) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> qualificationBlockedCell b
, sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
- , sortable (Just "lms-ident") (i18nCell MsgTableLmsIdent) $ \(view $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> textCell lid
- , sortable (Just "lms-pin") (i18nCell MsgTableLmsPin & cellAttrs <>~ [("uw-hide-column-default-hidden",mempty)]
+ , sortable (Just "ident") (i18nCell MsgTableLmsIdent) $ \(view $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> textCell lid
+ , sortable (Just "pin") (i18nCell MsgTableLmsPin & cellAttrs <>~ [("uw-hide-column-default-hidden",mempty)]
) $ \(view $ resultLmsUser . _entityVal . _lmsUserPin -> pin) -> textCell pin
- , sortable (Just "lms-status") (i18nCell MsgTableLmsStatus) $ \(view $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell status
- , sortable (Just "lms-started") (i18nLms MsgTableLmsStarted) $ \(view $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> dateTimeCell d
- , sortable (Just "lms-datepin") (i18nLms MsgTableLmsDatePin) $ \(view $ resultLmsUser . _entityVal . _lmsUserDatePin -> d) -> dateTimeCell d
- , sortable (Just "lms-received") (i18nLms MsgTableLmsReceived) $ \(view $ resultLmsUser . _entityVal . _lmsUserReceived -> d) -> foldMap dateTimeCell d
- --, sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \(view $ resultLmsUser . _entityVal . _lmsUserNotified -> d) -> foldMap dateTimeCell $ join d
- , sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified & cellTooltip MsgTableLmsNotifiedTooltip) $ \row ->
+ , sortable (Just "status") (i18nCell MsgTableLmsStatus) $ \(view $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell status
+ , sortable (Just "started") (i18nLms MsgTableLmsStarted) $ \(view $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> dateTimeCell d
+ , sortable (Just "datepin") (i18nLms MsgTableLmsDatePin) $ \(view $ resultLmsUser . _entityVal . _lmsUserDatePin -> d) -> dateTimeCell d
+ , sortable (Just "received") (i18nLms MsgTableLmsReceived) $ \(view $ resultLmsUser . _entityVal . _lmsUserReceived -> d) -> foldMap dateTimeCell d
+ --, sortable (Just "notified") (i18nLms MsgTableLmsNotified) $ \(view $ resultLmsUser . _entityVal . _lmsUserNotified -> d) -> foldMap dateTimeCell $ join d
+ , sortable (Just "notified") (i18nLms MsgTableLmsNotified & cellTooltip MsgTableLmsNotifiedTooltip) $ \row ->
-- 4 Cases:
-- - No notification: LmsUserNotified == Nothing
-- - Email sent : LmsUserNotified == Just _ && PrintJobId == Nothing
@@ -617,19 +624,29 @@ postLmsR sid qsh = do
in if notNotified
then mempty
else cIcon <> spacerCell <> cDate <> cAckDates
- -- , sortable (Just "lms-notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> textCell (show d)
- , sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(view $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell d
+ -- , sortable (Just "notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> textCell (show d)
+ , sortable (Just "ended") (i18nLms MsgTableLmsEnded) $ \(view $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell d
]
where
-- i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
i18nLms msg = cell [whamlet|LMS #|] <> i18nCell msg
- psValidator = def & defaultSorting [SortDescBy "lms-started", SortDescBy "lms-status"]
+ psValidator = def & defaultSorting [SortDescBy "started", SortDescBy "status"]
tbl <- mkLmsTable isAdmin qent acts colChoices psValidator
return (tbl, qent)
formResult lmsRes $ \case
_ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page
- (action, selectedUsers) -> do -- | isRenewPinAct action || isNotifyAct action -> do
+
+ (LmsActRestartData, selectedUsers) -> do
+ delUsers <- runDB $ fromIntegral <$> deleteWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. Set.toList selectedUsers]
+ runDBJobs $ forM_ selectedUsers $ \uid ->
+ queueDBJob $ JobLmsEnqueueUser { jQualification = qid, jUser = uid }
+ let numUsers = length selectedUsers
+ mStatus = bool Success Warning $ delUsers < numUsers
+ addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers
+ reloadKeepGetParams $ LmsR sid qsh
+
+ (action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do
now <- liftIO getCurrentTime
numExaminees <- runDBJobs $ do
okUsers <- selectList [LmsUserUser <-. Set.toList selectedUsers, LmsUserQualification ==. qid] []
@@ -646,12 +663,16 @@ postLmsR sid qsh = do
when (isNotifyAct action) $ addMessageI Success $ MsgLmsNotificationSend numExaminees
when (diffSelected /= 0) $ addMessageI Warning $ MsgLmsActionFailed diffSelected
reloadKeepGetParams $ LmsR sid qsh
+ _ -> addMessageI Error MsgUnauthorized -- should not happen
let heading = citext2widget $ "LMS " <> qualificationName quali
siteLayout heading $ do
setTitle $ toHtml $ "LMS " <> unSchoolKey sid <> "-" <> qsh
$(widgetFile "lms")
+-- redirect to a specific lms user
+getLmsIdentR :: SchoolId -> QualificationShorthand -> LmsIdent -> Handler Html
+getLmsIdentR sid qid ident = redirect (LmsR sid qid, [("lms-ident", toPathPiece ident)])
-- intended to be viewed primarily in a modal, wie lmsStatusPlusCell
getLmsUserR :: CryptoUUIDUser -> Handler Html
diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs
index 0f4bac949..81373f37c 100644
--- a/src/Handler/Qualification.hs
+++ b/src/Handler/Qualification.hs
@@ -342,8 +342,6 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
, single ("last-notified" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastNotified))
, single ("blocked-due" , SortColumnNeverNull $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
- -- , single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted))
- -- , single ("lms-status" , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
, single ("lms-status-plus",SortColumnNeverNull $ \row -> E.coalesce [E.explicitUnsafeCoerceSqlExprValue "timestamp" $ (queryLmsUser row E.?. LmsUserStatus) E.#>>. "{day}"
, queryLmsUser row E.?. LmsUserStarted])
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))
@@ -517,9 +515,6 @@ postQualificationR sid qsh = do
) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> blockedDueCell b
, sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
- -- , sortable (Just "lms-started") (i18nCell MsgTableLmsElearning <> spacerCell <> i18nCell MsgTableLmsStarted)
- -- $ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d
- -- , sortable (Just "lms-status") (i18nCell MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths))
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusPlusCell linkLmsUser) lu
, sortable (Just "last-notified") (i18nCell MsgTableQualificationLastNotified) $ \( view $ resultQualUser . _entityVal . _qualificationUserLastNotified -> d) -> dateTimeCell d
diff --git a/src/Model/Types/Lms.hs b/src/Model/Types/Lms.hs
index a9421a496..85483197b 100644
--- a/src/Model/Types/Lms.hs
+++ b/src/Model/Types/Lms.hs
@@ -22,7 +22,7 @@ import Utils.Lens.TH
newtype LmsIdent = LmsIdent { getLmsIdent :: Text }
deriving (Eq, Ord, Read, Show, Generic)
- deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField)
+ deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField, Hashable)
instance E.SqlString LmsIdent
makeLenses_ ''LmsIdent
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 669c6c440..2d00d373e 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -108,6 +108,13 @@ noField = Field{..}
fieldView _ _ _ _ _ = mempty
fieldEnctype = UrlEncoded
+-- | Field to inject comments into forms, also see aformMessage
+commentField :: (Monad m, RenderMessage (HandlerSite m) a) => a -> Field m ()
+commentField msg = Field {..}
+ where
+ fieldParse _ _ = return $ Right $ Just ()
+ fieldView _ _ _ _ _ = msg2widget msg
+ fieldEnctype = UrlEncoded
--------------------
-- Field Settings --
diff --git a/templates/lms-user.hamlet b/templates/lms-user.hamlet
index a09a25886..842013fc4 100644
--- a/templates/lms-user.hamlet
+++ b/templates/lms-user.hamlet
@@ -36,7 +36,10 @@ $else
_{MsgTableLmsStatus}
^{lmsUserStatusWidget True lmsUsr}
_{MsgTableLmsIdent}
- #{getLmsIdent (lmsUserIdent lmsUsr)}
+
+
+
+ #{getLmsIdent (lmsUserIdent lmsUsr)}
_{MsgTableLmsPin}