chore(lms): disable some content from lms overview page for non-admins
This commit is contained in:
Steffen Jost
parent
5f515d7420
commit
2163ed96d0
@ -80,4 +80,8 @@ MppPin !ident-ok: Pin
|
||||
MppRecipient: Empfänger
|
||||
MppAddress: Adresse
|
||||
MppLang: Sprache
|
||||
MppBadLanguage: Sprache muss derzeit "de" oder "en" sein.
|
||||
MppBadLanguage: Sprache muss derzeit "de" oder "en" sein.
|
||||
LmsAutomaticQueuing n@Natural: Die folgenden Funktionen werden normalerweise einmal pro Tag um #{show n} Uhr ausgeführt.
|
||||
LmsManualQueuing: Die folgenden Funktionen sollten einmal pro Tag ausgeführt werden.
|
||||
BtnLmsEnqueue: Nutzer mit ablaufenden Qualifikationen zum E-Learning anmelden und benachrichtigen
|
||||
BtnLmsDequeue: Nutzer mit beendetem E-Learning ggf. benachrichtigen und aufräumen
|
||||
@ -80,4 +80,8 @@ MppPin: Pin
|
||||
MppRecipient: Recipient
|
||||
MppAddress: Address
|
||||
MppLang: Language
|
||||
MppBadLanguage: Language currently restricted to "en" or "de".
|
||||
MppBadLanguage: Language currently restricted to "en" or "de".
|
||||
LmsAutomaticQueuing n@Natural: The following functions are executed daily at #{show n} o'clock.
|
||||
LmsManualQueuing: The following functions should be executed daily.
|
||||
BtnLmsEnqueue: Enqueue users with expiring qualifications for e-learning and notify them.
|
||||
BtnLmsDequeue: Dequeue users with finished e-learning and notify, if appropriate.
|
||||
10
routes
10
routes
@ -294,16 +294,16 @@
|
||||
-- OSIS CSV Export Demo
|
||||
/lms LmsAllR GET POST !free -- TODO verify that this is ok
|
||||
/lms/#SchoolId LmsSchoolR GET !free -- TODO verify that this is ok
|
||||
/lms/#SchoolId/#QualificationShorthand LmsR GET POST !free -- TODO Filtering does not work!
|
||||
/lms/#SchoolId/#QualificationShorthand LmsR GET POST !free --
|
||||
/lms/#SchoolId/#QualificationShorthand/edit LmsEditR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/users LmsUsersR GET
|
||||
/lms/#SchoolId/#QualificationShorthand/users/direct LmsUsersDirectR GET -- development
|
||||
/lms/#SchoolId/#QualificationShorthand/users/direct LmsUsersDirectR GET -- development only
|
||||
/lms/#SchoolId/#QualificationShorthand/userlist LmsUserlistR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/userlist/upload LmsUserlistUploadR GET POST -- development
|
||||
/lms/#SchoolId/#QualificationShorthand/userlist/upload LmsUserlistUploadR GET POST -- development only
|
||||
/lms/#SchoolId/#QualificationShorthand/userlist/direct LmsUserlistDirectR POST !token
|
||||
/lms/#SchoolId/#QualificationShorthand/fake LmsFakeR GET POST !development -- TODO: delete this testing URL
|
||||
/lms/#SchoolId/#QualificationShorthand/fake LmsFakeR GET POST -- TODO: delete this testing URL
|
||||
/lms/#SchoolId/#QualificationShorthand/result LmsResultR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/result/upload LmsResultUploadR GET POST -- development
|
||||
/lms/#SchoolId/#QualificationShorthand/result/upload LmsResultUploadR GET POST -- development only
|
||||
/lms/#SchoolId/#QualificationShorthand/result/direct LmsResultDirectR POST !token
|
||||
|
||||
/api ApiDocsR GET !free
|
||||
|
||||
@ -50,19 +50,17 @@ single :: (k,a) -> Map k a
|
||||
single = uncurry Map.singleton
|
||||
|
||||
-- Button only needed here
|
||||
data ButtonManualLms = LmsEnqueue | LmsDequeue
|
||||
data ButtonManualLms = BtnLmsEnqueue | BtnLmsDequeue
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonManualLms
|
||||
instance Finite ButtonManualLms
|
||||
|
||||
nullaryPathPiece ''ButtonManualLms camelToPathPiece
|
||||
embedRenderMessage ''UniWorX ''ButtonManualLms id
|
||||
|
||||
instance Button UniWorX ButtonManualLms where
|
||||
btnLabel LmsEnqueue = "Enqeue"
|
||||
btnLabel LmsDequeue = "Deqeue"
|
||||
|
||||
btnClasses LmsEnqueue = [BCIsButton, BCPrimary]
|
||||
btnClasses LmsDequeue = [BCIsButton, BCDefault]
|
||||
btnClasses BtnLmsEnqueue = [BCIsButton, BCPrimary]
|
||||
btnClasses BtnLmsDequeue = [BCIsButton, BCDefault]
|
||||
|
||||
|
||||
getLmsSchoolR :: SchoolId -> Handler Html
|
||||
@ -71,19 +69,22 @@ getLmsSchoolR ssh = redirect (LmsAllR, [("qualification-overview-school", toPath
|
||||
getLmsAllR, postLmsAllR :: Handler Html
|
||||
getLmsAllR = postLmsAllR
|
||||
postLmsAllR = do
|
||||
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonManualLms)
|
||||
let btnForm = wrapForm btnWdgt def
|
||||
{ formAction = Just $ SomeRoute LmsAllR
|
||||
, formEncoding = btnEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
case btnResult of
|
||||
(FormSuccess LmsEnqueue) -> queueJob' JobLmsQualificationsEnqueue
|
||||
(FormSuccess LmsDequeue) -> queueJob' JobLmsQualificationsDequeue
|
||||
FormMissing -> return ()
|
||||
_other -> addMessage Warning "Kein korrekter LMS Knopf erkannt"
|
||||
|
||||
isAdmin <- hasReadAccessTo AdminR
|
||||
mbQcheck <- getsYesod $ view _appQualificationCheckHour
|
||||
-- TODO: Move this functionality elsewhere without the need for `isAdmin`
|
||||
mbBtnForm <- if not isAdmin then return Nothing else do
|
||||
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonManualLms)
|
||||
case btnResult of
|
||||
(FormSuccess BtnLmsEnqueue) -> queueJob' JobLmsQualificationsEnqueue
|
||||
(FormSuccess BtnLmsDequeue) -> queueJob' JobLmsQualificationsDequeue
|
||||
FormMissing -> return ()
|
||||
_other -> addMessage Warning "Kein korrekter LMS Knopf erkannt"
|
||||
return $ Just $ wrapForm btnWdgt def
|
||||
{ formAction = Just $ SomeRoute LmsAllR
|
||||
, formEncoding = btnEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
|
||||
lmsTable <- runDB $ do
|
||||
view _2 <$> mkLmsAllTable isAdmin
|
||||
siteLayoutMsg MsgMenuQualifications $ do
|
||||
@ -120,6 +121,7 @@ mkLmsAllTable isAdmin = do
|
||||
return (quali, cactive, cusers)
|
||||
dbtRowKey = (E.^. QualificationId)
|
||||
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
|
||||
adminable = if isAdmin then sortable else \_ _ _ -> mempty
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ colSchool $ resultAllQualification . _qualificationSchool
|
||||
, sortable (Just "qshort") (i18nCell MsgQualificationShort) $ \(view resultAllQualification -> quali) ->
|
||||
@ -147,9 +149,9 @@ mkLmsAllTable isAdmin = do
|
||||
Nothing -> mempty
|
||||
Just sapId | isAdmin -> cellTooltipIcon (Just icn) (text2message sapId) mempty
|
||||
Just _ -> iconCell icn
|
||||
, sortable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip)
|
||||
, adminable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip)
|
||||
$ \(view resultAllQualificationActive -> n) -> wgtCell $ word2widget n
|
||||
, sortable Nothing (i18nCell MsgTableQualificationCountTotal) $ wgtCell . word2widget . view resultAllQualificationTotal
|
||||
, adminable Nothing (i18nCell MsgTableQualificationCountTotal) $ wgtCell . word2widget . view resultAllQualificationTotal
|
||||
-- \(view resultAllQualificationTotal -> n) -> wgtCell $ word2widget n
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
|
||||
@ -4,7 +4,15 @@ $# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
$#
|
||||
$# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
<p>
|
||||
^{btnForm}
|
||||
<p>
|
||||
^{lmsTable}
|
||||
^{lmsTable}
|
||||
|
||||
$maybe btnForm <- mbBtnForm
|
||||
<section>
|
||||
<p>
|
||||
$maybe qcheck <- mbQcheck
|
||||
_{MsgLmsAutomaticQueuing qcheck}
|
||||
$nothing
|
||||
_{MsgLmsManualQueuing}
|
||||
<p>
|
||||
^{btnForm}
|
||||
Loading…
Reference in New Issue
Block a user