From 871595e068e5a86144b865a00b6ea899be6bcbb2 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 28 Jul 2021 11:05:45 +0200 Subject: [PATCH] perf(auth): offload work creating list of correctors to db --- src/Foundation/Authorization.hs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/Foundation/Authorization.hs b/src/Foundation/Authorization.hs index b9ee6ad72..76134e3e6 100644 --- a/src/Foundation/Authorization.hs +++ b/src/Foundation/Authorization.hs @@ -570,8 +570,8 @@ tagAccessPredicate AuthStudent = cacheAPSystemFunction SystemStudent (Just $ Rig | otherwise -> unauthorizedI MsgUnauthorizedStudent | otherwise -> Left $ APDB $ \_ _ mAuthId _ _ -> $cachedHereBinary mAuthId . exceptT return return $ do authId <- maybeExceptT AuthenticationRequired $ return mAuthId - isExamOffice <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemStudent, UserSystemFunctionIsOptOut ==. False] - guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedStudent + isStudent <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemStudent, UserSystemFunctionIsOptOut ==. False] + guardMExceptT isStudent $ unauthorizedI MsgUnauthorizedStudent return Authorized tagAccessPredicate AuthExamOffice = cacheAPSchoolFunction SchoolExamOffice (Just $ Right diffHour) $ \mAuthId' route' _ examOfficeList -> if | maybe True (`Set.notMember` examOfficeList) mAuthId' -> Right $ case route' of @@ -794,11 +794,17 @@ tagAccessPredicate AuthCorrector = cacheAPDB (Just $ Right diffMinute) AuthCache E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val authId return Authorized where - mkCorrectorList = execWriterT $ do - tellM . fmap (setOf $ folded . _Value . _Just) . E.select . E.from $ \submission -> do + mkCorrectorList = do + submissionCorrectors <- E.select . E.from $ \submission -> E.distinctOnOrderBy [E.asc $ submission E.^. SubmissionRatingBy] $ do E.where_ . E.isJust $ submission E.^. SubmissionRatingBy return $ submission E.^. SubmissionRatingBy - tellM . fmap (setOf $ folded . _Value) . E.select . E.from $ return . (E.^. SheetCorrectorUser) + let submissionCorrectors' = Set.fromDistinctAscList $ mapMaybe (preview $ _Value . _Just) submissionCorrectors + + sheetCorrectors <- E.select . E.from $ \sheetCorrector -> E.distinctOnOrderBy [E.asc $ sheetCorrector E.^. SheetCorrectorUser] $ + return $ sheetCorrector E.^. SheetCorrectorUser + let sheetCorrectors' = Set.fromDistinctAscList $ map (^. _Value) sheetCorrectors + + return $ submissionCorrectors' `Set.union` sheetCorrectors' tagAccessPredicate AuthExamCorrector = cacheAPDB (Just $ Right diffMinute) AuthCacheExamCorrectorList mkExamCorrectorList $ \mAuthId' route' _ examCorrectorList -> if | maybe True (`Set.notMember` examCorrectorList) mAuthId' -> Right $ case route' of _ | is _Nothing mAuthId' -> return AuthenticationRequired