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

Address #344

Browse Source
This commit is contained in:
Gregor Kleen 2019-04-29 18:35:35 +02:00
parent 48c3e25d37
commit 2f4f88ad76
1 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/Foundation.hs
View File

@ -699,18 +699,6 @@ tagAccessPredicate AuthCourseRegistered = APDB $ \mAuthId route _ -> case route
return Authorized return Authorized
r -> $unsupportedAuthPredicate AuthCourseRegistered r r -> $unsupportedAuthPredicate AuthCourseRegistered r
tagAccessPredicate AuthTutorialRegistered = APDB $ \mAuthId route _ -> case route of tagAccessPredicate AuthTutorialRegistered = APDB $ \mAuthId route _ -> case route of
CourseR tid ssh csh _ -> exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
[E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialParticipant) -> do
E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. E.val authId
E.&&. course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
return (E.countRows :: E.SqlExpr (E.Value Int64))
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
return Authorized
CTutorialR tid ssh csh tutn _ -> exceptT return return $ do CTutorialR tid ssh csh tutn _ -> exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId authId <- maybeExceptT AuthenticationRequired $ return mAuthId
[E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialParticipant) -> do [E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialParticipant) -> do
@ -724,6 +712,18 @@ tagAccessPredicate AuthTutorialRegistered = APDB $ \mAuthId route _ -> case rout
return (E.countRows :: E.SqlExpr (E.Value Int64)) return (E.countRows :: E.SqlExpr (E.Value Int64))
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered) guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
return Authorized return Authorized
CourseR tid ssh csh _ -> exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
[E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialParticipant) -> do
E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. E.val authId
E.&&. course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
return (E.countRows :: E.SqlExpr (E.Value Int64))
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
return Authorized
r -> $unsupportedAuthPredicate AuthTutorialRegistered r r -> $unsupportedAuthPredicate AuthTutorialRegistered r
tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do