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

fix: fix tutorial registration group applying globally

Browse Source
This commit is contained in:
Gregor Kleen 2019-09-28 13:07:44 +02:00
parent d27eb5c59b
commit d2ba173776
1 changed files with 4 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Foundation.hs
View File

@ -1197,10 +1197,11 @@ tagAccessPredicate AuthRegisterGroup = APDB $ \mAuthId route _ -> case route of
(Nothing, _) -> return Authorized
(_, Nothing) -> return AuthenticationRequired
(Just rGroup, Just uid) -> do
[E.Value hasOther] <- $cachedHereBinary (uid, rGroup) . lift . E.select . return . E.exists . E.from $ \(tutorial `E.InnerJoin` participant) -> do
[E.Value hasOther] <- $cachedHereBinary (uid, rGroup) . lift . E.selectExists . E.from $ \(tutorial `E.InnerJoin` participant) -> do
E.on $ tutorial E.^. TutorialId E.==. participant E.^. TutorialParticipantTutorial
E.where_ $ participant E.^. TutorialParticipantUser E.==. E.val uid
E.&&. tutorial E.^. TutorialRegGroup E.==. E.just (E.val rGroup)
E.&&. tutorial E.^. TutorialCourse E.==. E.val tutorialCourse
E.&&. tutorial E.^. TutorialRegGroup E.==. E.just (E.val rGroup)
E.&&. participant E.^. TutorialParticipantUser E.==. E.val uid
guard $ not hasOther
return Authorized
r -> $unsupportedAuthPredicate AuthRegisterGroup r