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

fix(course-edit): expand rights of allocation admins

Browse Source
This commit is contained in:
Gregor Kleen 2019-09-05 14:20:46 +02:00
parent ac03b8c238
commit 7f2dd7808e
1 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/Course/Edit.hs
View File

@ -211,14 +211,16 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do
E.where_ $ term E.^. TermActive
E.||. alreadyParticipates
E.||. allocation E.^. AllocationSchool `E.in_` E.valList adminSchools
return (allocation, alreadyParticipates)
now <- liftIO getCurrentTime
let
allocationEnabled :: Entity Allocation -> Bool
allocationEnabled (Entity _ Allocation{..})
= NTop allocationStaffRegisterFrom <= NTop (Just now)
&& NTop (Just now) <= NTop allocationStaffRegisterTo
= ( NTop allocationStaffRegisterFrom <= NTop (Just now)
&& NTop (Just now) <= NTop allocationStaffRegisterTo
) || allocationSchool `elem` adminSchools
availableAllocations = availableAllocations' ^.. folded . filtered (allocationEnabled . view _1) . _1
activeAllocations = availableAllocations' ^.. folded . filtered ((&&) <$> (not <$> allocationEnabled . view _1) <*> view (_2 . _Value)) . _1
@ -558,7 +560,7 @@ upsertAllocationCourse cid cfAllocation = do
Course{..} <- getJust cid
prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
userAdmin <- hasWriteAccessTo $ SchoolR courseSchool SchoolEditR
userAdmin <- fromMaybe False <$> for prevAllocation (\Allocation{..} -> hasWriteAccessTo $ SchoolR allocationSchool SchoolEditR)
doEdit <- if
| userAdmin