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

SheetList-prime accessCallback from Course refactored

Browse Source
This commit is contained in:
Steffen Jost 2019-05-09 17:11:23 +02:00
parent a0de628d9b
commit d6c3cc8c15
1 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Foundation.hs
View File

@ -1825,8 +1825,8 @@ pageActions (CourseR tid ssh csh CShowR) =
, menuItemRoute = SomeRoute $ CourseR tid ssh csh MaterialListR
, menuItemModal = False
, menuItemAccessCallback' =
let lecturerAccess = hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- Always show for lecturers that can create new material
materialAccess mnm = hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR -- or show if user can see at least one of the contents
let lecturerAccess = hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- Always show for lecturers to create new material
materialAccess mnm = hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR -- otherwise show only if the user can see at least one of the contents
existsVisible = do
matNames <- E.select . E.from $ \(course `E.InnerJoin` material) -> do
E.on $ course E.^. CourseId E.==. material E.^. MaterialCourse
@ -1843,17 +1843,18 @@ pageActions (CourseR tid ssh csh CShowR) =
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetListR
, menuItemModal = False
, menuItemAccessCallback' = do --TODO always show for lecturer
let sheetRouteAccess shn = (== Authorized) <$> evalAccess (CSheetR tid ssh csh shn SShowR) False
muid <- maybeAuthId
(sheets,lecturer) <- runDB $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
sheets <- map (sheetName.entityVal) <$> selectList [SheetCourse ==. cid] [Desc SheetActiveFrom]
lecturer <- case muid of
Nothing -> return False
(Just uid) -> existsBy $ UniqueLecturer uid cid
return (sheets,lecturer)
or2M (return lecturer) $ anyM sheets sheetRouteAccess
, menuItemAccessCallback' =
let lecturerAccess = hasWriteAccessTo $ CourseR tid ssh csh SheetNewR -- Always show for lecturers to create new sheets
sheetAccess shn = hasReadAccessTo $ CSheetR tid ssh csh shn SShowR -- othwerwise show only if the user can see at least one of the contents
existsVisible = do
sheetNames <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.where_ $ course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
return $ sheet E.^. SheetName
anyM sheetNames (sheetAccess . E.unValue)
in runDB $ lecturerAccess `or2M` existsVisible
}
] ++ pageActions (CourseR tid ssh csh SheetListR) ++
[ MenuItem