From d2ba173776a6caa84ae53e6f87245205e344fa40 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 28 Sep 2019 13:07:44 +0200 Subject: [PATCH] fix: fix tutorial registration group applying globally --- src/Foundation.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index a9d2d1df0..0fbdd36af 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -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