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

fix(submission): allow non-group-subs when user isn't in sub-group

Browse Source
This commit is contained in:
Gregor Kleen 2020-05-26 11:39:02 +02:00
parent f74581c356
commit 9a35c8542c
1 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Foundation.hs
View File

@ -688,13 +688,15 @@ tagAccessPredicate AuthTutorControl = APDB $ \_ route _ -> case route of
return Authorized return Authorized
r -> $unsupportedAuthPredicate AuthTutorControl r r -> $unsupportedAuthPredicate AuthTutorControl r
tagAccessPredicate AuthSubmissionGroup = APDB $ \mAuthId route _ -> case route of tagAccessPredicate AuthSubmissionGroup = APDB $ \mAuthId route _ -> case route of
CSubmissionR _ _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedSubmissionSubmissionGroup) $ do CSubmissionR tid ssh csh shn cID _ -> maybeT (unauthorizedI MsgUnauthorizedSubmissionSubmissionGroup) $ do
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
Entity _ Sheet{..} <- $cachedHereBinary (course, shn) . MaybeT . getBy $ CourseSheet course shn
smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
groups <- $cachedHereBinary cID . lift . fmap (Set.fromList . fmap E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionUser) -> do groups <- $cachedHereBinary cID . lift . fmap (Set.fromList . fmap E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionUser) -> do
E.on $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. submissionUser E.^. SubmissionUserUser E.on $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. submissionUser E.^. SubmissionUserUser
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smId E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smId
return $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup return $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
unless (Set.null groups) $ do unless (Set.null groups || isn't _RegisteredGroups sheetGrouping) $ do
uid <- hoistMaybe mAuthId uid <- hoistMaybe mAuthId
guardM . lift $ exists [SubmissionGroupUserUser ==. uid, SubmissionGroupUserSubmissionGroup <-. Set.toList groups] guardM . lift $ exists [SubmissionGroupUserUser ==. uid, SubmissionGroupUserSubmissionGroup <-. Set.toList groups]
return Authorized return Authorized