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

This commit is contained in:
Gregor Kleen 2019-09-05 14:20:46 +02:00
parent ac03b8c238
commit 7f2dd7808e

View File

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