fix(authorisation): keep showing allocations (ro) to lecturers

This commit is contained in:
Gregor Kleen 2019-09-30 08:06:56 +02:00
parent dce89c215c
commit c8e1d51e25

View File

@ -933,7 +933,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
return Authorized
r -> $unsupportedAuthPredicate AuthTime r
tagAccessPredicate AuthStaffTime = APDB $ \_ route _ -> case route of
tagAccessPredicate AuthStaffTime = APDB $ \_ route isWrite -> case route of
CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
@ -944,7 +944,8 @@ tagAccessPredicate AuthStaffTime = APDB $ \_ route _ -> case route of
Just Allocation{..} -> do
cTime <- liftIO getCurrentTime
guard $ NTop allocationStaffAllocationFrom <= NTop (Just cTime)
guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
when isWrite $
guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
return Authorized