fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(lms): lms admin renew pin actions were ignored

Browse Source
This commit is contained in:
Steffen Jost 2023-02-10 12:12:53 +01:00
parent e68d05f3ee
commit 242dd0b8d4
2 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/LMS.hs
View File

@ -375,9 +375,9 @@ mkLmsTable :: forall h p cols act act'.
-> DB (FormResult (act', Set UserId), Widget)
mkLmsTable nlimit noffset isAdmin (Entity qid quali) acts cols psValidator = do
now <- liftIO getCurrentTime
-- currentRoute <- fromMaybe (error "mkLmsAllTable called from 404-handler") <$> liftHandler getCurrentRoute -- we know the route here
currentRoute <- fromMaybe (error "mkLmsAllTable called from 404-handler") <$> liftHandler getCurrentRoute -- we know the route here
let
currentRoute = LmsR (qualificationSchool quali) (qualificationShorthand quali)
-- currentRoute = LmsR (qualificationSchool quali) (qualificationShorthand quali) -- bad idea as seen
nowaday = utctDay now
mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
@ -500,12 +500,12 @@ mkLmsTable nlimit noffset isAdmin (Entity qid quali) acts cols psValidator = do
getLmsR, postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsR = postLmsR
postLmsR sid qsh = redirect $ LmsLSR sid qsh 250 0
postLmsR sid qsh = redirect $ LmsLSR sid qsh 500 0
getLmsLSR, postLmsLSR :: SchoolId -> QualificationShorthand -> Int64 -> Int64 -> Handler Html
getLmsLSR = postLmsLSR
postLmsLSR sid qsh nlimit noffset
| nlimit < 0 || noffset < 0 = redirect $ LmsLSR sid qsh 200 0
| nlimit < 0 || noffset < 0 = redirect $ LmsLSR sid qsh 500 0
| otherwise = do
isAdmin <- hasReadAccessTo AdminR
currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler

2
src/Jobs/Handler/LMS.hs
View File

@ -244,7 +244,7 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
(luser :& lulist) <- E.from $
E.table @LmsUser `E.leftJoin` E.table @LmsUserlist
`E.on` (\(luser :& lulist) -> luser E.^. LmsUserIdent E.=?. lulist E.?. LmsUserlistIdent
E.&&. luser E.^. LmsUserQualification E.=?. lulist E.?. LmsUserlistQualification)
E.&&. luser E.^. LmsUserQualification E.=?. lulist E.?. LmsUserlistQualification)
E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners
return (luser, lulist)