fraport/fradrive-old
Archived
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) -> DB (FormResult (act', Set UserId), Widget)
mkLmsTable nlimit noffset isAdmin (Entity qid quali) acts cols psValidator = do mkLmsTable nlimit noffset isAdmin (Entity qid quali) acts cols psValidator = do
now <- liftIO getCurrentTime 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 let
currentRoute = LmsR (qualificationSchool quali) (qualificationShorthand quali) -- currentRoute = LmsR (qualificationSchool quali) (qualificationShorthand quali) -- bad idea as seen
nowaday = utctDay now nowaday = utctDay now
mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName) 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 :: SchoolId -> QualificationShorthand -> Handler Html
getLmsR = postLmsR 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 :: SchoolId -> QualificationShorthand -> Int64 -> Int64 -> Handler Html
getLmsLSR = postLmsLSR getLmsLSR = postLmsLSR
postLmsLSR sid qsh nlimit noffset 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 | otherwise = do
isAdmin <- hasReadAccessTo AdminR isAdmin <- hasReadAccessTo AdminR
currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler 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 $ (luser :& lulist) <- E.from $
E.table @LmsUser `E.leftJoin` E.table @LmsUserlist E.table @LmsUser `E.leftJoin` E.table @LmsUserlist
`E.on` (\(luser :& lulist) -> luser E.^. LmsUserIdent E.=?. lulist E.?. LmsUserlistIdent `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.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners
return (luser, lulist) return (luser, lulist)