chore(lms): fix #35 restart lms, link qualification entry to lms, rename lms pin to password
This commit is contained in:
parent
30c3182370
commit
86c43f5115
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
2
routes
2
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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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 --
|
||||
|
||||
@ -36,7 +36,10 @@ $else
|
||||
<dt .deflist__dt>_{MsgTableLmsStatus}
|
||||
<dd .deflist__dd>^{lmsUserStatusWidget True lmsUsr}
|
||||
<dt .deflist__dt>_{MsgTableLmsIdent}
|
||||
<dd .deflist__dd .email>#{getLmsIdent (lmsUserIdent lmsUsr)}
|
||||
<dd .deflist__dd>
|
||||
<a href=@{LmsIdentR (qualificationSchool quali) (qualificationShorthand quali) (lmsUserIdent lmsUsr)}>
|
||||
<span .email>
|
||||
#{getLmsIdent (lmsUserIdent lmsUsr)}
|
||||
<dt .deflist__dt>_{MsgTableLmsPin}
|
||||
<dd .deflist__dd >
|
||||
<span .email>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user