diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 1f4821a54..ebefebe94 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -25,7 +25,7 @@ import Import import Jobs import Handler.Utils --- import Handler.Utils.Csv +import Handler.Utils.Users import Handler.Utils.LMS @@ -47,7 +47,6 @@ import Handler.LMS.Userlist as Handler.LMS import Handler.LMS.Result as Handler.LMS import Handler.LMS.Fake as Handler.LMS -- TODO: remove in production! --- import Handler.Utils.Qualification (validQualification) -- avoids repetition of local definitions single :: (k,a) -> Map k a @@ -105,22 +104,22 @@ resultAllQualificationActive = _dbrOutput . _2 . _unValue resultAllQualificationTotal :: Lens' AllQualificationTableData Word64 resultAllQualificationTotal = _dbrOutput . _3 . _unValue - + mkLmsAllTable :: Bool -> DB (Any, Widget) mkLmsAllTable isAdmin = do - now <- liftIO getCurrentTime - + svs <- getSupervisees let resultDBTable = DBTable{..} where dbtSQLQuery quali = do - let cusers = Ex.subSelectCount $ do - quser <- Ex.from $ Ex.table @QualificationUser - Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId - cactive = Ex.subSelectCount $ do - quser <- Ex.from $ Ex.table @QualificationUser - Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId - Ex.&&. validQualification (utctDay now) quser + let filterSvs luser = luser Ex.^. LmsUserQualification Ex.==. quali Ex.^. QualificationId + Ex.&&. (E.val isAdmin E.||. luser Ex.^. LmsUserUser `Ex.in_` E.vals svs) + cusers = Ex.subSelectCount $ do + luser <- Ex.from $ Ex.table @LmsUser + Ex.where_ $ filterSvs luser + cactive = Ex.subSelectCount $ do + luser <- Ex.from $ Ex.table @LmsUser + Ex.where_ $ filterSvs luser Ex.&&. E.isNothing (luser E.^. LmsUserStatus) -- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem return (quali, cactive, cusers) dbtRowKey = (Ex.^. QualificationId) diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index fc0a0c46e..b312a83d5 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -16,7 +16,7 @@ import Import -- import Jobs import Handler.Utils --- import Handler.Utils.Csv +import Handler.Utils.Users import Handler.Utils.LMS @@ -46,8 +46,9 @@ getQualificationSchoolR ssh = redirect (QualificationAllR, [("qualification-over getQualificationAllR :: Handler Html getQualificationAllR = do + isAdmin <- hasReadAccessTo AdminR qualiTable <- runDB $ do - view _2 <$> mkQualificationAllTable + view _2 <$> mkQualificationAllTable isAdmin siteLayoutMsg MsgMenuQualifications $ do setTitleI MsgMenuQualifications $(widgetFile "qualification-all") @@ -62,15 +63,9 @@ resultAllQualificationActive = _dbrOutput . _2 . _unValue resultAllQualificationTotal :: Lens' AllQualificationTableData Word64 resultAllQualificationTotal = _dbrOutput . _3 . _unValue -getSupervisees :: DB (Set UserId) -getSupervisees = do - uid <- requireAuthId - svs <- userSupervisorUser . entityVal <<$>> selectList [UserSupervisorSupervisor ==. uid] [Asc UserSupervisorUser] - return $ Set.insert uid $ Set.fromAscList svs - -mkQualificationAllTable :: DB (Any, Widget) -mkQualificationAllTable = do +mkQualificationAllTable :: Bool -> DB (Any, Widget) +mkQualificationAllTable isAdmin = do svs <- getSupervisees now <- liftIO getCurrentTime let @@ -78,7 +73,7 @@ mkQualificationAllTable = do where dbtSQLQuery quali = do let filterSvs quser = quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId - Ex.&&. quser Ex.^. QualificationUserUser `Ex.in_` E.vals svs + Ex.&&. (E.val isAdmin E.||. quser Ex.^. QualificationUserUser `Ex.in_` E.vals svs) cusers = Ex.subSelectCount $ do quser <- Ex.from $ Ex.table @QualificationUser Ex.where_ $ filterSvs quser diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index b5948021e..f583e65b1 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -18,6 +18,7 @@ module Handler.Utils.Users , getPostalAddress, getPostalPreferenceAndAddress , abbrvName , getReceivers + , getSupervisees ) where import Import @@ -110,6 +111,13 @@ getReceivers uid = do then directResult else return (underling, receivers, uid `elem` (entityKey <$> receivers)) +-- | return underlings for currently logged in user +getSupervisees :: DB (Set UserId) +getSupervisees = do + uid <- requireAuthId + svs <- userSupervisorUser . entityVal <<$>> selectList [UserSupervisorSupervisor ==. uid] [Asc UserSupervisorUser] + return $ Set.insert uid $ Set.fromAscList svs + computeUserAuthenticationDigest :: AuthenticationMode -> Digest SHA3_256 computeUserAuthenticationDigest = hashlazy . JSON.encode