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

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

Browse Source
This commit is contained in:
Gregor Kleen 2019-09-30 08:06:56 +02:00
parent dce89c215c
commit c8e1d51e25
1 changed files with 3 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Foundation.hs
View File

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