diff --git a/src/Foundation/Authorization.hs b/src/Foundation/Authorization.hs
index 52fb9926e..6ebd30cc2 100644
--- a/src/Foundation/Authorization.hs
+++ b/src/Foundation/Authorization.hs
@@ -36,6 +36,7 @@ import Handler.Utils.Memcached
 import Handler.Utils.I18n
 import Utils.Course (courseIsVisible)
 import Utils.Workflow
+import Utils.Metrics (observeAuthTagEvaluation, AuthTagEvalOutcome(..))
   
 import qualified Data.Set as Set
 import qualified Data.Aeson as JSON
@@ -93,21 +94,53 @@ data AccessPredicate
   = APPure     (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> Reader MsgRenderer AuthResult)
   | APHandler  (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> HandlerFor UniWorX AuthResult)
   | APDB       (ByteString -> (forall m. MonadAP m => AuthTagsEval m) -> Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> ReaderT SqlReadBackend (HandlerFor UniWorX) AuthResult)
+  | APCache    (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> HandlerFor UniWorX (Either AccessPredicate AuthResult))
 
-class (MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => MonadAP m where
+class (MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX, MonadUnliftIO m) => MonadAP m where
   evalAccessPred :: HasCallStack => AccessPredicate -> ByteString -> (forall m'. MonadAP m' => AuthTagsEval m') -> Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> m AuthResult
 
-instance {-# INCOHERENT #-} (MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => MonadAP m where
+instance {-# INCOHERENT #-} (MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX, MonadUnliftIO m) => MonadAP m where
   evalAccessPred aPred contCtx cont aid r w = liftHandler $ case aPred of
     (APPure    p) -> runReader (p aid r w) <$> getMsgRenderer
     (APHandler p) -> p aid r w
     (APDB      p) -> runDBRead' callStack $ p contCtx cont aid r w
+    (APCache   p) -> do
+      res <- p aid r w
+      case res of
+        Right res' -> return res'
+        Left p' -> evalAccessPred p' contCtx cont aid r w
 
-instance (MonadHandler m, HandlerSite m ~ UniWorX, BackendCompatible SqlReadBackend backend, BearerAuthSite UniWorX) => MonadAP (ReaderT backend m) where
+instance (MonadHandler m, HandlerSite m ~ UniWorX, BackendCompatible SqlReadBackend backend, BearerAuthSite UniWorX, MonadUnliftIO m) => MonadAP (ReaderT backend m) where
   evalAccessPred aPred contCtx cont aid r w = mapReaderT liftHandler . withReaderT (projectBackend @SqlReadBackend) $ case aPred of
     (APPure    p) -> lift $ runReader (p aid r w) <$> getMsgRenderer
     (APHandler p) -> lift $ p aid r w
     (APDB      p) -> p contCtx cont aid r w
+    (APCache   p) -> do
+      res <- lift $ p aid r w
+      case res of
+        Right res' -> return res'
+        Left p' -> evalAccessPred p' contCtx cont aid r w
+
+cacheAP :: ( Binary k
+           , Typeable v, Binary v
+           )
+        => Maybe Expiry
+        -> k
+        -> HandlerFor UniWorX v
+        -> (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> v -> Either AccessPredicate (HandlerFor UniWorX AuthResult))
+        -> AccessPredicate
+cacheAP mExp k mkV cont = APCache $ \mAuthId route isWrite -> either (return . Left) (fmap Right) . cont mAuthId route isWrite =<< memcachedBy mExp k mkV
+  
+cacheAP' :: ( Binary k
+            , Typeable v, Binary v
+            )
+         => Maybe Expiry
+         -> (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> Maybe (k, HandlerFor UniWorX v))
+         -> (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> Maybe v -> Either AccessPredicate (HandlerFor UniWorX AuthResult))
+         -> AccessPredicate
+cacheAP' mExp mkKV cont = APCache $ \mAuthId route isWrite -> case mkKV mAuthId route isWrite of
+  Just (k, mkV) -> either (return . Left) (fmap Right) . cont mAuthId route isWrite . Just =<< memcachedBy mExp k mkV
+  Nothing -> either (return . Left) (fmap Right) $ cont mAuthId route isWrite Nothing
 
 
 orAR, andAR :: MsgRenderer -> AuthResult -> AuthResult -> AuthResult
@@ -158,9 +191,10 @@ data AuthContext = AuthContext
   , authActiveTags :: AuthTagActive
   } deriving (Generic, Typeable)
 
-deriving instance Eq (AuthId UniWorX) => Eq AuthContext
-deriving instance (Read (AuthId UniWorX), Eq (AuthId UniWorX), Hashable (AuthId UniWorX)) => Read AuthContext
-deriving instance (Show (AuthId UniWorX), Eq (AuthId UniWorX), Hashable (AuthId UniWorX)) => Show AuthContext
+deriving stock instance Eq (AuthId UniWorX) => Eq AuthContext
+deriving stock instance Ord (AuthId UniWorX) => Ord AuthContext
+deriving stock instance (Read (AuthId UniWorX), Eq (AuthId UniWorX), Hashable (AuthId UniWorX)) => Read AuthContext
+deriving stock instance (Show (AuthId UniWorX), Eq (AuthId UniWorX), Hashable (AuthId UniWorX)) => Show AuthContext
 deriving anyclass instance Hashable (AuthId UniWorX) => Hashable AuthContext
 deriving anyclass instance (Binary (AuthId UniWorX), Eq (AuthId UniWorX), Hashable (AuthId UniWorX)) => Binary AuthContext
 
@@ -262,7 +296,7 @@ validateBearer mAuthId' route' isWrite' token' = $runCachedMemoT $ for4 memo val
           Just iuid | uid == iuid -> return $ Set.singleton uid
                     | otherwise -> do
                         cID <- encrypt iuid
-                        unlessM (is _Authorized <$> evalAccessWithFor [(AuthToken, False)] (Just uid) (AdminHijackUserR cID) True) $
+                        unlessM (lift $ is _Authorized <$> evalAccessWithFor [(AuthToken, False)] (Just uid) (AdminHijackUserR cID) True) $
                           throwError =<< unauthorizedI MsgUnauthorizedTokenInvalidImpersonation
                         return $ Set.singleton iuid
           Nothing -> return $ Set.singleton uid
@@ -282,12 +316,12 @@ validateBearer mAuthId' route' isWrite' token' = $runCachedMemoT $ for4 memo val
 
         authorityVal <- do
           dnf <- either throwM return $ routeAuthTags route
-          evalWriterT $ eval (noTokenAuth dnf) (Just uid) route isWrite
+          lift . evalWriterT $ eval (noTokenAuth dnf) (Just uid) route isWrite
         guardExceptT (is _Authorized authorityVal) authorityVal
 
       whenIsJust bearerAddAuth $ \addDNF -> do
         $logDebugS "validateToken" $ tshow addDNF
-        additionalVal <- evalWriterT $ eval (noTokenAuth addDNF) mAuthId route isWrite
+        additionalVal <- lift . evalWriterT $ eval (noTokenAuth addDNF) mAuthId route isWrite
         guardExceptT (is _Authorized additionalVal) additionalVal
 
       return Authorized
@@ -339,134 +373,191 @@ maybeCurrentBearerRestrictions = liftHandler . runMaybeT $ do
 data AuthorizationCacheKey
   = AuthCacheWorkflowWorkflowEdgeActors CryptoFileNameWorkflowWorkflow
   | AuthCacheWorkflowWorkflowViewers CryptoFileNameWorkflowWorkflow
+  | AuthCacheSchoolFunctionList SchoolFunction | AuthCacheSystemFunctionList SystemFunction
+  | AuthCacheLecturerList | AuthCacheCorrectorList | AuthCacheExamCorrectorList | AuthCacheTutorList | AuthCacheSubmissionGroupUserList
+  | AuthCacheCourseRegisteredList TermId SchoolId CourseShorthand
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
   deriving anyclass (Binary)
 
+cacheAPSchoolFunction :: BearerAuthSite UniWorX
+                      => SchoolFunction
+                      -> Maybe Expiry
+                      -> (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> Set (AuthId (UniWorX)) -> Either AccessPredicate (HandlerFor UniWorX AuthResult))
+                      -> AccessPredicate
+cacheAPSchoolFunction f mExp = cacheAP mExp (AuthCacheSchoolFunctionList f) mkFunctionList
+  where
+    mkFunctionList = runDBRead . fmap (setOf $ folded . _Value) . E.select . E.from $ \userFunction -> do
+      E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val f
+      return $ userFunction E.^. UserFunctionUser
+
+cacheAPSystemFunction :: BearerAuthSite UniWorX
+                      => SystemFunction
+                      -> Maybe Expiry
+                      -> (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> Set (AuthId (UniWorX)) -> Either AccessPredicate (HandlerFor UniWorX AuthResult))
+                      -> AccessPredicate
+cacheAPSystemFunction f mExp = cacheAP mExp (AuthCacheSystemFunctionList f) mkFunctionList
+  where
+    mkFunctionList = runDBRead . fmap (setOf $ folded . _Value) . E.select . E.from $ \userSystemFunction -> do
+      E.where_ $ userSystemFunction E.^. UserSystemFunctionFunction E.==. E.val f
+           E.&&. E.not_ (userSystemFunction E.^. UserSystemFunctionIsOptOut)
+      return $ userSystemFunction E.^. UserSystemFunctionUser
+
 tagAccessPredicate :: BearerAuthSite UniWorX
                    => AuthTag -> AccessPredicate
 tagAccessPredicate AuthFree = trueAP
-tagAccessPredicate AuthAdmin = APDB $ \_ _ mAuthId route _ -> case route of
-  -- Courses: access only to school admins
-  CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isAdmin <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` userAdmin) -> do
-      E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserFunctionSchool
-      E.where_  $ userAdmin E.^. UserFunctionUser E.==. E.val authId
-            E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
-            E.&&. course E.^. CourseTerm      E.==. E.val tid
-            E.&&. course E.^. CourseSchool    E.==. E.val ssh
-            E.&&. course E.^. CourseShorthand E.==. E.val csh
-    guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
-    return Authorized
-  -- Allocations: access only to school admins
-  AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isAdmin <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` userAdmin) -> do
-      E.on $ allocation E.^. AllocationSchool E.==. userAdmin E.^. UserFunctionSchool
-      E.where_  $ userAdmin E.^. UserFunctionUser E.==. E.val authId
-            E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
-            E.&&. allocation E.^. AllocationTerm      E.==. E.val tid
-            E.&&. allocation E.^. AllocationSchool    E.==. E.val ssh
-            E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
-    guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
-    return Authorized
-  -- Schools: access only to school admins
-  SchoolR ssh _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isAdmin <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin]
-    guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
-    return Authorized
-  -- other routes: access to any admin is granted here
-  _other -> $cachedHereBinary mAuthId . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin] []
-    guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedSiteAdmin)
-    return Authorized
-tagAccessPredicate AuthSystemExamOffice = APDB $ \_ _ mAuthId _ _ -> $cachedHereBinary mAuthId . exceptT return return $ do
-  authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-  isExamOffice <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemExamOffice, UserSystemFunctionIsOptOut ==. False]
-  guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedSystemExamOffice
-  return Authorized
-tagAccessPredicate AuthStudent = 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
-  return Authorized
-tagAccessPredicate AuthExamOffice = APDB $ \_ _ mAuthId route _ -> case route of
-  CExamR tid ssh csh examn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, examn) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    hasUsers <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examResult) -> do
-      E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
-      E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
+tagAccessPredicate AuthAdmin = cacheAPSchoolFunction SchoolAdmin (Just $ Right diffHour) $ \mAuthId' route' _ adminList -> if
+  | maybe True (`Set.notMember` adminList) mAuthId' -> Right $ case route' of
+      _ | is _Nothing mAuthId' -> return AuthenticationRequired
+      CourseR _ _ _ _ -> unauthorizedI MsgUnauthorizedSchoolAdmin
+      AllocationR _ _ _ _ -> unauthorizedI MsgUnauthorizedSchoolAdmin
+      SchoolR _ _ -> unauthorizedI MsgUnauthorizedSchoolAdmin
+      _other -> unauthorizedI MsgUnauthorizedSiteAdmin
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
+      -- Courses: access only to school admins
+      CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isAdmin <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` userAdmin) -> do
+          E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserFunctionSchool
+          E.where_  $ userAdmin E.^. UserFunctionUser E.==. E.val authId
+                E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
+                E.&&. course E.^. CourseTerm      E.==. E.val tid
+                E.&&. course E.^. CourseSchool    E.==. E.val ssh
+                E.&&. course E.^. CourseShorthand E.==. E.val csh
+        guardMExceptT isAdmin $ unauthorizedI MsgUnauthorizedSchoolAdmin
+        return Authorized
+      -- Allocations: access only to school admins
+      AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isAdmin <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` userAdmin) -> do
+          E.on $ allocation E.^. AllocationSchool E.==. userAdmin E.^. UserFunctionSchool
+          E.where_  $ userAdmin E.^. UserFunctionUser E.==. E.val authId
+                E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
+                E.&&. allocation E.^. AllocationTerm      E.==. E.val tid
+                E.&&. allocation E.^. AllocationSchool    E.==. E.val ssh
+                E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
+        guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
+        return Authorized
+      -- Schools: access only to school admins
+      SchoolR ssh _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isAdmin <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin]
+        guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
+        return Authorized
+      -- other routes: access to any admin is granted here
+      _other -> $cachedHereBinary mAuthId . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin] []
+        guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedSiteAdmin)
+        return Authorized
+tagAccessPredicate AuthSystemExamOffice = cacheAPSystemFunction SystemExamOffice (Just $ Right diffHour) $ \mAuthId' _ _ examOfficeList -> if
+  | maybe True (`Set.notMember` examOfficeList) mAuthId' -> Right $ if
+      | is _Nothing mAuthId' -> return AuthenticationRequired
+      | otherwise -> unauthorizedI MsgUnauthorizedSystemExamOffice
+  | otherwise -> Left $ APDB $ \_ _ mAuthId _ _ -> $cachedHereBinary mAuthId . exceptT return return $ do
+      authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+      isExamOffice <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemExamOffice, UserSystemFunctionIsOptOut ==. False]
+      guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedSystemExamOffice
+      return Authorized
+tagAccessPredicate AuthStudent = cacheAPSystemFunction SystemStudent (Just $ Right diffHour) $ \mAuthId' _ _ studentList -> if
+  | maybe True (`Set.notMember` studentList) mAuthId' -> Right $ if
+      | is _Nothing mAuthId' -> return AuthenticationRequired
+      | 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
+      return Authorized
+tagAccessPredicate AuthExamOffice = cacheAPSchoolFunction SchoolExamOffice (Just $ Right diffHour) $ \mAuthId' route' _ examOfficeList -> if
+  | maybe True (`Set.notMember` examOfficeList) mAuthId' -> Right $ case route' of
+      _ | is _Nothing mAuthId' -> return AuthenticationRequired
+      CExamR _ _ _ _ _ -> unauthorizedI MsgUnauthorizedExamExamOffice
+      EExamR _ _ _ _ _ -> unauthorizedI MsgUnauthorizedExternalExamExamOffice
+      CourseR _ _ _ _ -> unauthorizedI MsgUnauthorizedExamExamOffice
+      SchoolR _ _ -> unauthorizedI MsgUnauthorizedSchoolExamOffice
+      _other -> unauthorizedI MsgUnauthorizedExamOffice
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
+      CExamR tid ssh csh examn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, examn) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        hasUsers <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examResult) -> do
+          E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
+          E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
 
-      E.where_ $ course E.^. CourseTerm E.==. E.val tid
-           E.&&. course E.^. CourseSchool E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-           E.&&. exam E.^. ExamName E.==. E.val examn
+          E.where_ $ course E.^. CourseTerm E.==. E.val tid
+               E.&&. course E.^. CourseSchool E.==. E.val ssh
+               E.&&. course E.^. CourseShorthand E.==. E.val csh
+               E.&&. exam E.^. ExamName E.==. E.val examn
 
-      E.where_ $ examOfficeExamResultAuth (E.val authId) examResult
-    guardMExceptT hasUsers (unauthorizedI MsgUnauthorizedExamExamOffice)
-    return Authorized
-  EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    hasUsers <- lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` eexamResult) -> do
-      E.on $ eexam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam
+          E.where_ $ examOfficeExamResultAuth (E.val authId) examResult
+        guardMExceptT hasUsers (unauthorizedI MsgUnauthorizedExamExamOffice)
+        return Authorized
+      EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        hasUsers <- lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` eexamResult) -> do
+          E.on $ eexam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam
 
-      E.where_ $ eexam E.^. ExternalExamTerm E.==. E.val tid
-           E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
-           E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
-           E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
+          E.where_ $ eexam E.^. ExternalExamTerm E.==. E.val tid
+               E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
+               E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
+               E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
 
-      E.where_ $ examOfficeExternalExamResultAuth (E.val authId) eexamResult
-    guardMExceptT hasUsers $ unauthorizedI MsgUnauthorizedExternalExamExamOffice
-    return Authorized
-  CourseR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isExamOffice <- lift . existsBy $ UniqueUserFunction authId ssh SchoolExamOffice
-    guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedExamExamOffice
-    return Authorized
-  SchoolR ssh _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isAdmin <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice]
-    guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolExamOffice)
-    return Authorized
-  _other -> $cachedHereBinary mAuthId . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isExamOffice <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice]
-    guardMExceptT isExamOffice (unauthorizedI MsgUnauthorizedExamOffice)
-    return Authorized
-tagAccessPredicate AuthEvaluation = APDB $ \_ _ mAuthId route _ -> case route of
-  ParticipantsR _ ssh -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
-    guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
-    return Authorized
-  CourseR _ ssh _ _ -> $cachedHereBinary(mAuthId, ssh) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
-    guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
-    return Authorized
-  _other -> $cachedHereBinary mAuthId . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolEvaluation]
-    guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
-    return Authorized
-tagAccessPredicate AuthAllocationAdmin = APDB $ \_ _ mAuthId route _ -> case route of
-  AllocationR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolAllocation
-    guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
-    return Authorized
-  CourseR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolAllocation
-    guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
-    return Authorized
-  _other -> $cachedHereBinary mAuthId . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAllocation]
-    guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
-    return Authorized
+          E.where_ $ examOfficeExternalExamResultAuth (E.val authId) eexamResult
+        guardMExceptT hasUsers $ unauthorizedI MsgUnauthorizedExternalExamExamOffice
+        return Authorized
+      CourseR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isExamOffice <- lift . existsBy $ UniqueUserFunction authId ssh SchoolExamOffice
+        guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedExamExamOffice
+        return Authorized
+      SchoolR ssh _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isAdmin <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice]
+        guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolExamOffice)
+        return Authorized
+      _other -> $cachedHereBinary mAuthId . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isExamOffice <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice]
+        guardMExceptT isExamOffice (unauthorizedI MsgUnauthorizedExamOffice)
+        return Authorized
+tagAccessPredicate AuthEvaluation = cacheAPSchoolFunction SchoolEvaluation (Just $ Right diffHour) $ \mAuthId' _ _ evaluationList -> if
+  | maybe True (`Set.notMember` evaluationList) mAuthId' -> Right $ if
+      | is _Nothing mAuthId' -> return AuthenticationRequired
+      | otherwise -> unauthorizedI MsgUnauthorizedEvaluation
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
+      ParticipantsR _ ssh -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
+        guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
+        return Authorized
+      CourseR _ ssh _ _ -> $cachedHereBinary(mAuthId, ssh) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
+        guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
+        return Authorized
+      _other -> $cachedHereBinary mAuthId . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolEvaluation]
+        guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
+        return Authorized
+tagAccessPredicate AuthAllocationAdmin = cacheAPSchoolFunction SchoolAllocation (Just $ Right diffHour) $ \mAuthId' _ _ allocationList -> if
+  | maybe True (`Set.notMember` allocationList) mAuthId' -> Right $ if
+      | is _Nothing mAuthId' -> return AuthenticationRequired
+      | otherwise -> unauthorizedI MsgUnauthorizedAllocationAdmin
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
+      AllocationR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolAllocation
+        guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
+        return Authorized
+      CourseR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolAllocation
+        guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
+        return Authorized
+      _other -> $cachedHereBinary mAuthId . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAllocation]
+        guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
+        return Authorized
 tagAccessPredicate AuthToken = APDB $ \_ _ mAuthId route isWrite -> exceptT return return $
   lift . validateBearer mAuthId route isWrite =<< askBearerUnsafe
 tagAccessPredicate AuthNoEscalation = APDB $ \_ _ mAuthId route _ -> case route of
@@ -490,121 +581,175 @@ tagAccessPredicate AuthDevelopment = APHandler $ \_ r _ -> do
 #else
   return $ Unauthorized "Route under development"
 #endif
-tagAccessPredicate AuthLecturer = APDB $ \_ _ mAuthId route _ -> case route of
-  CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
-     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-     isLecturer <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` lecturer) -> do
-       E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
-       E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
+
+tagAccessPredicate AuthLecturer = cacheAP' (Just $ Right diffMinute) mkLecturerList $ \mAuthId' route' _ mLecturerList -> if
+  | Just lecturerList <- mLecturerList
+  , maybe True (`Set.notMember` lecturerList) mAuthId' -> Right $ case route' of
+      _ | is _Nothing mAuthId' -> return AuthenticationRequired
+      CourseR _ _ _ _ -> unauthorizedI MsgUnauthorizedLecturer
+      AllocationR _ _ _ _ -> unauthorizedI MsgUnauthorizedAllocationLecturer
+      EExamR _ _ _ _ _ -> unauthorizedI MsgUnauthorizedExternalExamLecturer
+      _other -> unauthorizedI MsgUnauthorizedSchoolLecturer 
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
+      CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
+         authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+         isLecturer <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` lecturer) -> do
+           E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
+           E.where_ $ lecturer E.^. LecturerUser 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
+         guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedLecturer)
+         return Authorized
+      AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isLecturer <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` allocationCourse `E.InnerJoin` course `E.InnerJoin` lecturer) -> do
+          E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
+          E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
+          E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
+          E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
+               E.&&. allocation E.^. AllocationTerm      E.==. E.val tid
+               E.&&. allocation E.^. AllocationSchool    E.==. E.val ssh
+               E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
+        guardMExceptT isLecturer $ unauthorizedI MsgUnauthorizedAllocationLecturer
+        return Authorized
+      EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isLecturer <- lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` staff) -> do
+          E.on $ eexam E.^. ExternalExamId E.==. staff E.^. ExternalExamStaffExam
+          E.where_ $ staff E.^. ExternalExamStaffUser E.==. E.val authId
+               E.&&. eexam E.^. ExternalExamTerm E.==. E.val tid
+               E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
+               E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
+               E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
+        guardMExceptT isLecturer $ unauthorizedI MsgUnauthorizedExternalExamLecturer
+        return Authorized
+      -- lecturer for any school will do
+      _ -> $cachedHereBinary mAuthId . exceptT return return $ do
+         authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+         void . maybeMExceptT (unauthorizedI MsgUnauthorizedSchoolLecturer) $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolLecturer] []
+         return Authorized
+  where
+    mkLecturerList _ route _ = case route of
+      CourseR _ _ _ _ -> cacheLecturerList 
+      AllocationR _ _ _ _ -> cacheLecturerList 
+      EExamR _ _ _ _ _ -> cacheLecturerList 
+      _other -> Just
+        ( AuthCacheSchoolFunctionList SchoolLecturer
+        , runDBRead . fmap (setOf $ folded . _Value) . E.select . E.from $ \userFunction -> do
+            E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolLecturer
+            return $ userFunction E.^. UserFunctionUser
+        )
+      where
+        cacheLecturerList = Just
+          ( AuthCacheLecturerList
+          , runDBRead . fmap (setOf $ folded . _Value) . E.select . E.from $ return . (E.^. LecturerUser)
+          )
+tagAccessPredicate AuthCorrector = cacheAP (Just $ Right diffMinute) AuthCacheCorrectorList mkCorrectorList $ \mAuthId' route' _ correctorList -> if
+  | maybe False (`Set.notMember` correctorList) mAuthId' -> Right $ case route' of
+      _ | is _Nothing mAuthId' -> return AuthenticationRequired
+      CSubmissionR _ _ _ _ _ _ -> unauthorizedI MsgUnauthorizedSubmissionCorrector
+      CSheetR _ _ _ _ _ -> unauthorizedI MsgUnauthorizedSheetCorrector
+      CourseR _ _ _ _ -> unauthorizedI MsgUnauthorizedCorrector
+      _other -> unauthorizedI MsgUnauthorizedCorrectorAny
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> exceptT return return $ do
+      authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+      resList <- $cachedHereBinary mAuthId . lift . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector) -> do
+        E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
+        E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
+        E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val authId
+        return (course E.^. CourseId, sheet E.^. SheetId)
+      let
+        resMap :: Map CourseId (Set SheetId)
+        resMap = Map.fromListWith Set.union [ (cid, Set.singleton sid) | (E.Value cid, E.Value sid) <- resList ]
+      case route of
+        CSubmissionR _ _ _ _ cID _ -> $cachedHereBinary (mAuthId, cID) . maybeT (unauthorizedI MsgUnauthorizedSubmissionCorrector) $ do
+          sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
+          Submission{..} <- MaybeT . lift $ get sid
+          guard $ Just authId == submissionRatingBy
+          return Authorized
+        CSheetR tid ssh csh shn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, shn) . maybeT (unauthorizedI MsgUnauthorizedSheetCorrector) $ do
+          Entity cid _ <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
+          Entity sid _ <- MaybeT . lift . getBy $ CourseSheet cid shn
+          guard $ sid `Set.member` fromMaybe Set.empty (resMap !? cid)
+          return Authorized
+        CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . maybeT (unauthorizedI MsgUnauthorizedCorrector) $ do
+          Entity cid _ <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
+          guard $ cid `Set.member` Map.keysSet resMap
+          return Authorized
+        _ -> do
+          guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedCorrectorAny)
+          return Authorized
+  where
+    mkCorrectorList = runDBRead . execWriterT $ do
+      tellM . fmap (setOf $ folded . _Value . _Just) . E.select . E.from $ \submission -> do
+        E.where_ . E.isJust $ submission E.^. SubmissionRatingBy
+        return $ submission E.^. SubmissionRatingBy
+      tellM . fmap (setOf $ folded . _Value) . E.select . E.from $ return . (E.^. SheetCorrectorUser)
+tagAccessPredicate AuthExamCorrector = cacheAP (Just $ Right diffMinute) AuthCacheExamCorrectorList mkExamCorrectorList $ \mAuthId' route' _ examCorrectorList -> if
+  | maybe False (`Set.notMember` examCorrectorList) mAuthId' -> Right $ case route' of
+      _ | is _Nothing mAuthId' -> return AuthenticationRequired
+      CExamR _ _ _ _ _ -> unauthorizedI MsgUnauthorizedExamCorrector
+      CourseR _ _ _ _ -> unauthorizedI MsgUnauthorizedExamCorrector
+      r -> $unsupportedAuthPredicate AuthExamCorrector r
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
+      CExamR tid ssh csh examn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, examn) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isCorrector <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examCorrector) -> do
+          E.on $ examCorrector E.^. ExamCorrectorExam E.==. exam E.^. ExamId
+          E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
+          E.where_ $ examCorrector E.^. ExamCorrectorUser 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
-     guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedLecturer)
-     return Authorized
-  AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isLecturer <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` allocationCourse `E.InnerJoin` course `E.InnerJoin` lecturer) -> do
-      E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
-      E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
-      E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
-      E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
-           E.&&. allocation E.^. AllocationTerm      E.==. E.val tid
-           E.&&. allocation E.^. AllocationSchool    E.==. E.val ssh
-           E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
-    guardMExceptT isLecturer $ unauthorizedI MsgUnauthorizedAllocationLecturer
-    return Authorized
-  EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isLecturer <- lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` staff) -> do
-      E.on $ eexam E.^. ExternalExamId E.==. staff E.^. ExternalExamStaffExam
-      E.where_ $ staff E.^. ExternalExamStaffUser E.==. E.val authId
-           E.&&. eexam E.^. ExternalExamTerm E.==. E.val tid
-           E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
-           E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
-           E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
-    guardMExceptT isLecturer $ unauthorizedI MsgUnauthorizedExternalExamLecturer
-    return Authorized
-  -- lecturer for any school will do
-  _ -> $cachedHereBinary mAuthId . exceptT return return $ do
-     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-     void . maybeMExceptT (unauthorizedI MsgUnauthorizedSchoolLecturer) $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolLecturer] []
-     return Authorized
-tagAccessPredicate AuthCorrector = APDB $ \_ _ mAuthId route _ -> exceptT return return $ do
-  authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-  resList <- $cachedHereBinary mAuthId . lift . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector) -> do
-    E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
-    E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
-    E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val authId
-    return (course E.^. CourseId, sheet E.^. SheetId)
-  let
-    resMap :: Map CourseId (Set SheetId)
-    resMap = Map.fromListWith Set.union [ (cid, Set.singleton sid) | (E.Value cid, E.Value sid) <- resList ]
-  case route of
-    CSubmissionR _ _ _ _ cID _ -> $cachedHereBinary (mAuthId, cID) . maybeT (unauthorizedI MsgUnauthorizedSubmissionCorrector) $ do
-      sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
-      Submission{..} <- MaybeT . lift $ get sid
-      guard $ Just authId == submissionRatingBy
-      return Authorized
-    CSheetR tid ssh csh shn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, shn) . maybeT (unauthorizedI MsgUnauthorizedSheetCorrector) $ do
-      Entity cid _ <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
-      Entity sid _ <- MaybeT . lift . getBy $ CourseSheet cid shn
-      guard $ sid `Set.member` fromMaybe Set.empty (resMap !? cid)
-      return Authorized
-    CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . maybeT (unauthorizedI MsgUnauthorizedCorrector) $ do
-      Entity cid _ <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
-      guard $ cid `Set.member` Map.keysSet resMap
-      return Authorized
-    _ -> do
-      guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedCorrectorAny)
-      return Authorized
-tagAccessPredicate AuthExamCorrector = APDB $ \_ _ mAuthId route _ -> case route of
-  CExamR tid ssh csh examn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, examn) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isCorrector <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examCorrector) -> do
-      E.on $ examCorrector E.^. ExamCorrectorExam E.==. exam E.^. ExamId
-      E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
-      E.where_ $ examCorrector E.^. ExamCorrectorUser 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
-        E.&&. exam   E.^. ExamName        E.==. E.val examn
-    guardMExceptT isCorrector $ unauthorizedI MsgUnauthorizedExamCorrector
-    return Authorized
-  CourseR tid ssh csh _ -> $cachedHereBinary (tid, ssh, csh) . exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isCorrector <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examCorrector) -> do
-      E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
-      E.on $ exam E.^. ExamId E.==. examCorrector E.^. ExamCorrectorExam
-      E.where_ $ examCorrector E.^. ExamCorrectorUser 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
-    guardMExceptT isCorrector $ unauthorizedI MsgUnauthorizedExamCorrector
-    return Authorized
-  r -> $unsupportedAuthPredicate AuthExamCorrector r
-tagAccessPredicate AuthTutor = APDB $ \_ _ mAuthId route _ -> exceptT return return $ do
-  authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-  resList <- $cachedHereBinary authId . lift . E.select . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutor) -> do
-    E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
-    E.on $ tutorial E.^. TutorialCourse E.==. course E.^. CourseId
-    E.where_ $ tutor E.^. TutorUser E.==. E.val authId
-    return (course E.^. CourseId, tutorial E.^. TutorialId)
-  let
-    resMap :: Map CourseId (Set TutorialId)
-    resMap = Map.fromListWith Set.union [ (cid, Set.singleton tutid) | (E.Value cid, E.Value tutid) <- resList ]
-  case route of
-    CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgUnauthorizedTutorialTutor) $ do
-      Entity cid _ <- $cachedHereBinary (tid, ssh, csh) . MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
-      Entity tutid _ <- $cachedHereBinary (cid, tutn) . MaybeT . lift . getBy $ UniqueTutorial cid tutn
-      guard $ tutid `Set.member` fromMaybe Set.empty (resMap !? cid)
-      return Authorized
-    CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnauthorizedCourseTutor) $ do
-      Entity cid _ <- $cachedHereBinary (tid, ssh, csh) . MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
-      guard $ cid `Set.member` Map.keysSet resMap
-      return Authorized
-    _ -> do
-      guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedTutor)
-      return Authorized
+            E.&&. exam   E.^. ExamName        E.==. E.val examn
+        guardMExceptT isCorrector $ unauthorizedI MsgUnauthorizedExamCorrector
+        return Authorized
+      CourseR tid ssh csh _ -> $cachedHereBinary (tid, ssh, csh) . exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isCorrector <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examCorrector) -> do
+          E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
+          E.on $ exam E.^. ExamId E.==. examCorrector E.^. ExamCorrectorExam
+          E.where_ $ examCorrector E.^. ExamCorrectorUser 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
+        guardMExceptT isCorrector $ unauthorizedI MsgUnauthorizedExamCorrector
+        return Authorized
+      r -> $unsupportedAuthPredicate AuthExamCorrector r
+  where
+    mkExamCorrectorList = runDBRead . fmap (setOf $ folded . _Value) . E.select . E.from $ return . (E.^. ExamCorrectorUser)
+tagAccessPredicate AuthTutor = cacheAP (Just $ Right diffMinute) AuthCacheTutorList mkTutorList $ \mAuthId' route' _ tutorList -> if
+  | maybe False (`Set.notMember` tutorList) mAuthId' -> Right $ case route' of
+      _ | is _Nothing mAuthId' -> return AuthenticationRequired
+      CTutorialR _ _ _ _ _ -> unauthorizedI MsgUnauthorizedTutorialTutor
+      CourseR _ _ _ _ -> unauthorizedI MsgUnauthorizedCourseTutor
+      _other -> unauthorizedI MsgUnauthorizedTutor
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> exceptT return return $ do
+      authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+      resList <- $cachedHereBinary authId . lift . E.select . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutor) -> do
+        E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
+        E.on $ tutorial E.^. TutorialCourse E.==. course E.^. CourseId
+        E.where_ $ tutor E.^. TutorUser E.==. E.val authId
+        return (course E.^. CourseId, tutorial E.^. TutorialId)
+      let
+        resMap :: Map CourseId (Set TutorialId)
+        resMap = Map.fromListWith Set.union [ (cid, Set.singleton tutid) | (E.Value cid, E.Value tutid) <- resList ]
+      case route of
+        CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgUnauthorizedTutorialTutor) $ do
+          Entity cid _ <- $cachedHereBinary (tid, ssh, csh) . MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
+          Entity tutid _ <- $cachedHereBinary (cid, tutn) . MaybeT . lift . getBy $ UniqueTutorial cid tutn
+          guard $ tutid `Set.member` fromMaybe Set.empty (resMap !? cid)
+          return Authorized
+        CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnauthorizedCourseTutor) $ do
+          Entity cid _ <- $cachedHereBinary (tid, ssh, csh) . MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
+          guard $ cid `Set.member` Map.keysSet resMap
+          return Authorized
+        _ -> do
+          guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedTutor)
+          return Authorized
+  where
+    mkTutorList = runDBRead . fmap (setOf $ folded . _Value) . E.select . E.from $ return . (E.^. TutorUser)
 tagAccessPredicate AuthTutorControl = APDB $ \_ _ _ route _ -> case route of
   CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgUnauthorizedTutorialTutorControl) $ do
     Entity cid _ <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
@@ -612,31 +757,39 @@ tagAccessPredicate AuthTutorControl = APDB $ \_ _ _ route _ -> case route of
     guard tutorialTutorControlled
     return Authorized
   r -> $unsupportedAuthPredicate AuthTutorControl r
-tagAccessPredicate AuthSubmissionGroup = APDB $ \_ _ mAuthId route _ -> case route of
-  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
-    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.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smId
-      return $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
-    unless (Set.null groups || isn't _RegisteredGroups sheetGrouping) $ do
-      uid <- hoistMaybe mAuthId
-      guardM . lift $ exists [SubmissionGroupUserUser ==. uid, SubmissionGroupUserSubmissionGroup <-. Set.toList groups]
-    return Authorized
-  CSheetR tid ssh csh sheetn _ -> maybeT (unauthorizedI MsgUnauthorizedSheetSubmissionGroup) $ do
-    course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
-    Entity _ Sheet{..} <- $cachedHereBinary (course, sheetn) . MaybeT . getBy $ CourseSheet course sheetn
-    when (is _RegisteredGroups sheetGrouping) $ do
-      uid <- hoistMaybe mAuthId
-      guardM . lift . E.selectExists . E.from $ \(submissionGroup `E.InnerJoin` submissionGroupUser) -> do
-        E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
-        E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val course
-             E.&&. submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
+tagAccessPredicate AuthSubmissionGroup = cacheAP (Just $ Right diffMinute) AuthCacheSubmissionGroupUserList mkSubmissionGroupUserList $ \mAuthId' route' _ submissionGroupUserList -> if
+  | maybe True (`Set.notMember` submissionGroupUserList) mAuthId' -> Right $ case route' of
+      _ | is _Nothing mAuthId' -> return AuthenticationRequired
+      CSubmissionR _ _ _ _ _ _ -> unauthorizedI MsgUnauthorizedSubmissionSubmissionGroup
+      CSheetR _ _ _ _ _ -> unauthorizedI MsgUnauthorizedSheetSubmissionGroup
+      r -> $unsupportedAuthPredicate AuthSubmissionGroup r
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
+      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
+        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.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smId
+          return $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
+        unless (Set.null groups || isn't _RegisteredGroups sheetGrouping) $ do
+          uid <- hoistMaybe mAuthId
+          guardM . lift $ exists [SubmissionGroupUserUser ==. uid, SubmissionGroupUserSubmissionGroup <-. Set.toList groups]
+        return Authorized
+      CSheetR tid ssh csh sheetn _ -> maybeT (unauthorizedI MsgUnauthorizedSheetSubmissionGroup) $ do
+        course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
+        Entity _ Sheet{..} <- $cachedHereBinary (course, sheetn) . MaybeT . getBy $ CourseSheet course sheetn
+        when (is _RegisteredGroups sheetGrouping) $ do
+          uid <- hoistMaybe mAuthId
+          guardM . lift . E.selectExists . E.from $ \(submissionGroup `E.InnerJoin` submissionGroupUser) -> do
+            E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
+            E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val course
+                 E.&&. submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
 
-    return Authorized
-  r -> $unsupportedAuthPredicate AuthSubmissionGroup r
+        return Authorized
+      r -> $unsupportedAuthPredicate AuthSubmissionGroup r
+  where
+    mkSubmissionGroupUserList = runDBRead . fmap (setOf $ folded . _Value) . E.select . E.from $ return . (E.^. SubmissionGroupUserUser)
 tagAccessPredicate AuthTime = APDB $ \_ (runTACont -> cont) mAuthId route isWrite -> case route of
   CExamR tid ssh csh examn subRoute -> maybeT (unauthorizedI MsgUnauthorizedExamTime) $ do
     course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
@@ -897,19 +1050,38 @@ tagAccessPredicate AuthCourseTime = APDB $ \_ _ _mAuthId route _ -> case route o
     guardMExceptT courseVisible (unauthorizedI MsgUnauthorizedCourseTime)
     return Authorized
   r -> $unsupportedAuthPredicate AuthCourseTime r
-tagAccessPredicate AuthCourseRegistered = APDB $ \_ _ mAuthId route _ -> case route of
-  CourseR tid ssh csh _ -> exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    isRegistered <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` courseParticipant) -> do
-      E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
-      E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val authId
-           E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
-           E.&&. course E.^. CourseTerm      E.==. E.val tid
-           E.&&. course E.^. CourseSchool    E.==. E.val ssh
-           E.&&. course E.^. CourseShorthand E.==. E.val csh
-    guardMExceptT isRegistered (unauthorizedI MsgUnauthorizedRegistered)
-    return Authorized
-  r -> $unsupportedAuthPredicate AuthCourseRegistered r
+tagAccessPredicate AuthCourseRegistered = cacheAP' (Just $ Right diffMinute) mkAuthCacheCourseRegisteredList $ \mAuthId' route' _ mCourseRegisteredList -> if
+  | Just courseRegisteredList <- mCourseRegisteredList
+  , maybe True (`Set.notMember` courseRegisteredList) mAuthId' -> Right $ case route' of
+      _ | is _Nothing mAuthId' -> return AuthenticationRequired
+      CourseR _ _ _ _ -> unauthorizedI MsgUnauthorizedRegistered
+      r -> $unsupportedAuthPredicate AuthCourseRegistered r
+  | otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
+      CourseR tid ssh csh _ -> exceptT return return $ do
+        authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+        isRegistered <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` courseParticipant) -> do
+          E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
+          E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val authId
+               E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
+               E.&&. course E.^. CourseTerm      E.==. E.val tid
+               E.&&. course E.^. CourseSchool    E.==. E.val ssh
+               E.&&. course E.^. CourseShorthand E.==. E.val csh
+        guardMExceptT isRegistered (unauthorizedI MsgUnauthorizedRegistered)
+        return Authorized
+      r -> $unsupportedAuthPredicate AuthCourseRegistered r
+  where
+    mkAuthCacheCourseRegisteredList _ route _ = case route of
+      CourseR tid ssh csh _ -> Just
+        ( AuthCacheCourseRegisteredList tid ssh csh
+        , runDBRead . fmap (setOf $ folded . _Value) . E.select . E.from $ \(course `E.InnerJoin` courseParticipant) -> do
+            E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
+            E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
+                 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 $ courseParticipant E.^. CourseParticipantUser
+        )
+      _other -> Nothing
 tagAccessPredicate AuthTutorialRegistered = APDB $ \_ _ mAuthId route _ -> case route of
   CTutorialR tid ssh csh tutn _ -> exceptT return return $ do
     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
@@ -1268,7 +1440,7 @@ tagAccessPredicate AuthEmpty = APDB $ \_ _ mAuthId route _
                checkAccess (E.Value wwId, E.Value wwScope) = maybeT (return False) $ do
                  cID <- encrypt wwId
                  rScope' <- toRouteWorkflowScope $ _DBWorkflowScope # wwScope
-                 guardM . fmap (is _Authorized) . flip (evalAccessFor mAuthId) False $ _WorkflowScopeRoute # (rScope', WorkflowWorkflowR cID WWWorkflowR)
+                 guardM . lift . fmap (is _Authorized) . flip (evalAccessFor mAuthId) False $ _WorkflowScopeRoute # (rScope', WorkflowWorkflowR cID WWWorkflowR)
                  return True
            guardM . fmap not . lift . runConduit $ getWorkflowWorkflows .| C.mapM checkAccess .| C.or
            return AuthorizedI18n
@@ -1551,7 +1723,12 @@ evalAuthTags ctx authActive@AuthTagActive{..} cont (map (Set.toList . toNullable
           where
             evalAccessPred' authTag' mAuthId' route' isWrite' = lift $ do
               $logDebugS "evalAccessPred" $ tshow (authTag', mAuthId', route', isWrite')
-              evalAccessPred (tagAccessPredicate authTag') contCtx cont mAuthId' route' isWrite'
+              observeAuthTagEvaluation authTag' $ do
+                res <- evalAccessPred (tagAccessPredicate authTag') contCtx cont mAuthId' route' isWrite'
+                return . (res, ) $ case res of
+                  Authorized             -> OutcomeAuthorized
+                  Unauthorized _         -> OutcomeUnauthorized
+                  AuthenticationRequired -> OutcomeAuthenticationRequired
 
         evalAuthLiteral :: AuthLiteral -> WriterT (Set AuthTag) m AuthResult
         evalAuthLiteral PLVariable{..} = evalAuthTag plVar
@@ -1580,7 +1757,7 @@ evalAuthTags ctx authActive@AuthTagActive{..} cont (map (Set.toList . toNullable
 
       return result
 
-evalAccessWithFor :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => [(AuthTag, Bool)] -> Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> m AuthResult
+evalAccessWithFor :: (HasCallStack, MonadThrow m, MonadAP m) => [(AuthTag, Bool)] -> Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> m AuthResult
 evalAccessWithFor assumptions mAuthId route isWrite = do
   isSelf <- (== mAuthId) <$> liftHandler defaultMaybeAuthId
   tagActive <- if
@@ -1598,42 +1775,42 @@ evalAccessWithFor assumptions mAuthId route isWrite = do
       tellSessionJson SessionInactiveAuthTags deactivated
     return result
 
-evalAccessFor :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> m AuthResult
+evalAccessFor :: (HasCallStack, MonadThrow m, MonadAP m) => Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> m AuthResult
 evalAccessFor = evalAccessWithFor []
 
-evalAccessForDB :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX, BackendCompatible SqlReadBackend backend) => Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> ReaderT backend m AuthResult
+evalAccessForDB :: (HasCallStack, MonadThrow m, MonadAP m, BackendCompatible SqlReadBackend backend) => Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> ReaderT backend m AuthResult
 evalAccessForDB = evalAccessFor
 
-evalAccessWith :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => [(AuthTag, Bool)] -> Route UniWorX -> Bool -> m AuthResult
+evalAccessWith :: (HasCallStack, MonadThrow m, MonadAP m) => [(AuthTag, Bool)] -> Route UniWorX -> Bool -> m AuthResult
 evalAccessWith assumptions route isWrite = do
   mAuthId <- liftHandler maybeAuthId
   evalAccessWithFor assumptions mAuthId route isWrite
   
-evalAccessWithDB :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX, BackendCompatible SqlReadBackend backend) => [(AuthTag, Bool)] -> Route UniWorX -> Bool -> ReaderT backend m AuthResult
+evalAccessWithDB :: (HasCallStack, MonadThrow m, MonadAP m, BackendCompatible SqlReadBackend backend) => [(AuthTag, Bool)] -> Route UniWorX -> Bool -> ReaderT backend m AuthResult
 evalAccessWithDB = evalAccessWith
 
-evalAccess :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => Route UniWorX -> Bool -> m AuthResult
+evalAccess :: (HasCallStack, MonadThrow m, MonadAP m) => Route UniWorX -> Bool -> m AuthResult
 evalAccess = evalAccessWith []
 
-evalAccessDB :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX, BackendCompatible SqlReadBackend backend) => Route UniWorX -> Bool -> ReaderT backend m AuthResult
+evalAccessDB :: (HasCallStack, MonadThrow m, MonadAP m, BackendCompatible SqlReadBackend backend) => Route UniWorX -> Bool -> ReaderT backend m AuthResult
 evalAccessDB = evalAccess
 
 -- | Check whether the current user is authorized by `evalAccess` for the given route
 --   Convenience function for a commonly used code fragment
-hasAccessTo :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => Route UniWorX -> Bool -> m Bool
+hasAccessTo :: (HasCallStack, MonadThrow m, MonadAP m) => Route UniWorX -> Bool -> m Bool
 hasAccessTo route isWrite = (== Authorized) <$> evalAccess route isWrite
 
 -- | Check whether the current user is authorized by `evalAccess` to read from the given route
 --   Convenience function for a commonly used code fragment
-hasReadAccessTo :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => Route UniWorX -> m Bool
+hasReadAccessTo :: (HasCallStack, MonadThrow m, MonadAP m) => Route UniWorX -> m Bool
 hasReadAccessTo = flip hasAccessTo False
 
 -- | Check whether the current user is authorized by `evalAccess` to rwrite to the given route
 --   Convenience function for a commonly used code fragment
-hasWriteAccessTo :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX) => Route UniWorX -> m Bool
+hasWriteAccessTo :: (HasCallStack, MonadThrow m, MonadAP m) => Route UniWorX -> m Bool
 hasWriteAccessTo = flip hasAccessTo True
 
-wouldHaveAccessTo :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX)
+wouldHaveAccessTo :: (HasCallStack, MonadThrow m, MonadAP m)
                   => [(AuthTag, Bool)] -- ^ Assumptions
                   -> Route UniWorX
                   -> Bool
@@ -1641,7 +1818,7 @@ wouldHaveAccessTo :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m
 wouldHaveAccessTo assumptions route isWrite = (== Authorized) <$> evalAccessWith assumptions route isWrite
 
 wouldHaveReadAccessTo, wouldHaveWriteAccessTo
-  :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX)
+  :: (HasCallStack, MonadThrow m, MonadAP m)
   => [(AuthTag, Bool)] -- ^ Assumptions
   -> Route UniWorX
   -> m Bool
@@ -1649,7 +1826,7 @@ wouldHaveReadAccessTo assumptions route = wouldHaveAccessTo assumptions route Fa
 wouldHaveWriteAccessTo assumptions route = wouldHaveAccessTo assumptions route True
 
 wouldHaveReadAccessToIff, wouldHaveWriteAccessToIff
-  :: (HasCallStack, MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX)
+  :: (HasCallStack, MonadThrow m, MonadAP m)
   => [(AuthTag, Bool)] -- ^ Assumptions
   -> Route UniWorX
   -> m Bool
@@ -1659,9 +1836,7 @@ wouldHaveWriteAccessToIff assumptions route = and2M (not <$> hasWriteAccessTo ro
 
 evalWorkflowRoleFor' :: forall m backend.
                         ( HasCallStack
-                        , MonadHandler m
-                        , HandlerSite m ~ UniWorX
-                        , BearerAuthSite UniWorX
+                        , MonadAP m
                         , BackendCompatible SqlReadBackend backend
                         )
                      => (forall m'. MonadAP m' => AuthTagsEval m')
@@ -1708,9 +1883,7 @@ evalWorkflowRoleFor' eval mAuthId mwwId wRole route isWrite = do
     WorkflowRoleAuthorized{..} -> eval (predDNFEntail $ workflowRoleAuthorized `predDNFOr` defaultAuthDNF) mAuthId route isWrite
 
 evalWorkflowRoleFor :: ( HasCallStack
-                       , MonadHandler m
-                       , HandlerSite m ~ UniWorX
-                       , BearerAuthSite UniWorX
+                       , MonadAP m
                        , BackendCompatible SqlReadBackend backend
                        )
                     => Maybe UserId
@@ -1733,9 +1906,7 @@ evalWorkflowRoleFor mAuthId mwwId wRole route isWrite = do
   return result
  
 hasWorkflowRole :: ( HasCallStack
-                   , MonadHandler m
-                   , HandlerSite m ~ UniWorX
-                   , BearerAuthSite UniWorX
+                   , MonadAP m
                    , BackendCompatible SqlReadBackend backend
                    )
                 => Maybe WorkflowWorkflowId
@@ -1749,9 +1920,7 @@ hasWorkflowRole mwwId wRole route isWrite = do
 
 mayViewWorkflowAction' :: forall backend m fileid.
                           ( HasCallStack
-                          , MonadHandler m
-                          , HandlerSite m ~ UniWorX
-                          , BearerAuthSite UniWorX
+                          , MonadAP m
                           , BackendCompatible SqlReadBackend backend
                           , MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey
                           , MonadCatch m
@@ -1780,9 +1949,7 @@ mayViewWorkflowAction' eval mAuthId wwId WorkflowAction{..} = hoist (withReaderT
 
 mayViewWorkflowAction :: forall backend m fileid.
                          ( HasCallStack
-                         , MonadHandler m
-                         , HandlerSite m ~ UniWorX
-                         , BearerAuthSite UniWorX
+                         , MonadAP m
                          , BackendCompatible SqlReadBackend backend
                          , MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey
                          , MonadCatch m
diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs
index 506f7d413..69f6d2121 100644
--- a/src/Foundation/Navigation.hs
+++ b/src/Foundation/Navigation.hs
@@ -70,7 +70,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
   breadcrumb UsersR           = i18nCrumb MsgMenuUsers   $ Just AdminR
   breadcrumb AdminUserAddR    = i18nCrumb MsgMenuUserAdd $ Just UsersR
   breadcrumb (AdminUserR cID) = maybeT (i18nCrumb MsgBreadcrumbUser $ Just UsersR) $ do
-    guardM . hasReadAccessTo $ AdminUserR cID
+    guardM . lift . hasReadAccessTo $ AdminUserR cID
     uid <- decrypt cID
     User{..} <- MaybeT . runDBRead $ get uid
     return (userDisplayName, Just UsersR)
@@ -104,7 +104,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
   breadcrumb (SchoolR ssh sRoute) = case sRoute of
     SchoolEditR -> maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do
       School{..} <- MaybeT . runDBRead $ get ssh
-      isAdmin <- hasReadAccessTo SchoolListR
+      isAdmin <- lift $ hasReadAccessTo SchoolListR
       return (CI.original schoolName, bool Nothing (Just SchoolListR) isAdmin)
 
     SchoolWorkflowInstanceListR -> i18nCrumb MsgBreadcrumbWorkflowInstanceList . Just $ SchoolR ssh SchoolEditR
@@ -212,7 +212,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
   breadcrumb (CourseR tid ssh csh CInviteR)   = i18nCrumb MsgBreadcrumbCourseParticipantInvitation . Just $ CourseR tid ssh csh CShowR
   breadcrumb (CourseR tid ssh csh CExamOfficeR) = i18nCrumb MsgMenuCourseExamOffice . Just $ CourseR tid ssh csh CShowR
   breadcrumb (CourseR tid ssh csh (CUserR cID)) = maybeT (i18nCrumb MsgBreadcrumbUser . Just $ CourseR tid ssh csh CUsersR) $ do
-    guardM . hasReadAccessTo . CourseR tid ssh csh $ CUserR cID
+    guardM . lift . hasReadAccessTo . CourseR tid ssh csh $ CUserR cID
     uid <- decrypt cID
     User{userDisplayName} <- MaybeT . runDBRead $ get uid
     return (userDisplayName, Just $ CourseR tid ssh csh CUsersR)
@@ -254,7 +254,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
 
   breadcrumb (CourseR tid ssh csh (CourseApplicationR cID sRoute)) = case sRoute of
     CAEditR -> maybeT (i18nCrumb MsgBreadcrumbApplicant . Just $ CourseR tid ssh csh CApplicationsR) $ do
-      guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAEditR
+      guardM . lift . hasReadAccessTo $ CApplicationR tid ssh csh cID CAEditR
       appId <- decrypt cID
       User{..} <- hoist runDBRead $ MaybeT (get appId) >>= MaybeT . get . courseApplicationUser
       return (userDisplayName, Just $ CourseR tid ssh csh CApplicationsR)
@@ -262,7 +262,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
 
   breadcrumb (CourseR tid ssh csh (ExamR examn sRoute)) = case sRoute of
     EShowR    -> maybeT (i18nCrumb MsgBreadcrumbExam . Just $ CourseR tid ssh csh CExamListR) $ do
-      guardM . hasReadAccessTo $ CExamR tid ssh csh examn EShowR
+      guardM . lift . hasReadAccessTo $ CExamR tid ssh csh examn EShowR
       return (CI.original examn, Just $ CourseR tid ssh csh CExamListR)
     EEditR    -> i18nCrumb MsgMenuExamEdit . Just $ CExamR tid ssh csh examn EShowR
     EUsersR   -> i18nCrumb MsgMenuExamUsers . Just $ CExamR tid ssh csh examn EShowR
@@ -277,7 +277,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
 
   breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
     TUsersR  -> maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do
-      guardM . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR
+      guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR
       return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR)
     TEditR   -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR
     TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR
@@ -287,7 +287,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
 
   breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of
     SShowR -> maybeT (i18nCrumb MsgBreadcrumbSheet . Just $ CourseR tid ssh csh SheetListR) $ do
-      guardM . hasReadAccessTo $ CSheetR tid ssh csh shn SShowR
+      guardM . lift . hasReadAccessTo $ CSheetR tid ssh csh shn SShowR
       return (CI.original shn, Just $ CourseR tid ssh csh SheetListR)
     SEditR -> i18nCrumb MsgMenuSheetEdit . Just $ CSheetR tid ssh csh shn SShowR
     SDelR  -> i18nCrumb MsgMenuSheetDelete . Just $ CSheetR tid ssh csh shn SShowR
@@ -321,7 +321,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
   breadcrumb (CourseR tid ssh csh MaterialNewR ) = i18nCrumb MsgMenuMaterialNew . Just $ CourseR tid ssh csh MaterialListR
   breadcrumb (CourseR tid ssh csh (MaterialR mnm sRoute)) = case sRoute of
     MShowR -> maybeT (i18nCrumb MsgBreadcrumbMaterial . Just $ CourseR tid ssh csh MaterialListR) $ do
-      guardM . hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR
+      guardM . lift . hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR
       return (CI.original mnm, Just $ CourseR tid ssh csh MaterialListR)
     MEditR -> i18nCrumb MsgMenuMaterialEdit . Just $ CMaterialR tid ssh csh mnm MShowR
     MDelR  -> i18nCrumb MsgMenuMaterialDelete . Just $ CMaterialR tid ssh csh mnm MShowR
@@ -359,7 +359,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
     EEShowR -> do
       isEO <- hasReadAccessTo $ ExamOfficeR EOExamsR
       maybeT (i18nCrumb MsgBreadcrumbExternalExam . Just $ bool EExamListR (ExamOfficeR EOExamsR) isEO) $ do
-        guardM . hasReadAccessTo $ EExamR tid ssh coursen examn EEShowR
+        guardM . lift . hasReadAccessTo $ EExamR tid ssh coursen examn EEShowR
         i18nCrumb (MsgBreadcrumbExternalExamShow coursen examn) . Just $ if
           | isEO -> ExamOfficeR EOExamsR
           | otherwise -> EExamListR
@@ -501,15 +501,15 @@ type family ChildrenNavChildren a where
 
   ChildrenNavChildren a = Children ChGeneric a
 
-navAccess :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m, BearerAuthSite UniWorX) => Nav -> MaybeT m Nav
+navAccess :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m, BearerAuthSite UniWorX, MonadUnliftIO m) => Nav -> MaybeT m Nav
 navAccess = execStateT $ do
-  guardM $ preuse _navLink >>= maybe (return True) navLinkAccess
+  guardM $ preuse _navLink >>= lift . lift . maybe (return True) navLinkAccess
 
-  _navChildren <~ (filterM navLinkAccess =<< use _navChildren)
+  _navChildren <~ (filterM (lift . lift . navLinkAccess) =<< use _navChildren)
   whenM (hasn't _navLink <$> use id) $
     guardM $ not . null <$> use _navChildren
 
-navLinkAccess :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m, BearerAuthSite UniWorX) => NavLink -> m Bool
+navLinkAccess :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m, BearerAuthSite UniWorX, MonadUnliftIO m) => NavLink -> m Bool
 navLinkAccess NavLink{..} = handle shortCircuit $ liftHandler navAccess' `and2M` accessCheck navType navRoute
   where
     shortCircuit :: HandlerContents -> m Bool
@@ -518,7 +518,7 @@ navLinkAccess NavLink{..} = handle shortCircuit $ liftHandler navAccess' `and2M`
     accessCheck :: HasRoute UniWorX route => NavType -> route -> m Bool
     accessCheck nt (urlRoute -> route) = do
       authCtx <- getAuthContext
-      $memcachedByHere (Just $ Right 120) (authCtx, nt, route) $
+      $memcachedByHere (Just . Right $ 2 * diffMinute) (authCtx, nt, route) $
         bool hasWriteAccessTo hasReadAccessTo (is _NavTypeLink nt) route
   
 defaultLinks :: ( MonadHandler m
@@ -871,6 +871,7 @@ pageActions :: ( MonadHandler m
                , MonadCatch m
                , BearerAuthSite UniWorX
                , BackendCompatible SqlReadBackend (YesodPersistBackend UniWorX)
+               , MonadUnliftIO m
                )
             => Route UniWorX -> m [Nav]
 pageActions NewsR = return
@@ -2576,7 +2577,7 @@ submissionList tid csh shn uid = withReaderT (projectBackend @SqlReadBackend) .
   return $ submission E.^. SubmissionId
 
 
-pageQuickActions :: ( MonadCatch m
+pageQuickActions :: ( MonadCatch m, MonadUnliftIO m
                     , MonadHandler m
                     , HandlerSite m ~ UniWorX
                     , BearerAuthSite UniWorX
@@ -2590,7 +2591,7 @@ pageQuickActions qView route = do
 
 -- | Verify that the currently logged in user is lecturer or corrector for at least one sheet for the given course
 evalAccessCorrector
-  :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX)
+  :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX, MonadUnliftIO m)
   => TermId -> SchoolId -> CourseShorthand -> m AuthResult
 evalAccessCorrector tid ssh csh = evalAccess (CourseR tid ssh csh CNotesR) False
 
@@ -2606,7 +2607,7 @@ _haveWorkflowInstances rScope = hoist liftHandler . withReaderT (projectBackend
   scope <- fromRouteWorkflowScope rScope
 
   let checkAccess (Entity _ WorkflowInstance{..})
-        = hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)
+        = lift . hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)
       getInstances = E.selectSource . E.from $ \workflowInstance -> do
         E.where_ $ workflowInstance E.^. WorkflowInstanceScope E.==. E.val (scope ^. _DBWorkflowScope)
         return workflowInstance
@@ -2617,7 +2618,7 @@ haveWorkflowWorkflows rScope = hoist liftHandler . withReaderT (projectBackend @
 
   let checkAccess (E.Value wwId) = do
         cID <- lift . lift $ encrypt wwId
-        hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
+        lift . hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
       getWorkflows = E.selectSource . E.from $ \workflowWorkflow -> do
         E.where_ $ workflowWorkflow E.^. WorkflowWorkflowScope E.==. E.val (scope ^. _DBWorkflowScope)
         return $ workflowWorkflow E.^. WorkflowWorkflowId
@@ -2633,7 +2634,7 @@ haveTopWorkflowInstances, haveTopWorkflowWorkflows
 haveTopWorkflowInstances = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . maybeT (return False) $
   let checkAccess (Entity _ WorkflowInstance{..}) = do
         rScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowInstanceScope
-        hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)
+        lift . hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR workflowInstanceName WIInitiateR)
       getInstances = selectSource [] []
       isTop (Entity _ WorkflowInstance{..}) = isTopWorkflowScope workflowInstanceScope
    in $cachedHere . runConduit $ transPipe lift getInstances .| C.filter isTop .| C.mapM checkAccess .| C.or
@@ -2641,7 +2642,7 @@ haveTopWorkflowWorkflows = hoist liftHandler . withReaderT (projectBackend @SqlR
   let checkAccess (Entity wwId WorkflowWorkflow{..}) = do
         rScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowWorkflowScope
         cID <- lift . lift $ encrypt wwId
-        hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
+        lift . hasReadAccessTo $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
       getWorkflows = selectSource [] []
       isTop (Entity _ WorkflowWorkflow{..}) = isTopWorkflowScope workflowWorkflowScope
    in $cachedHere . runConduit $ transPipe lift getWorkflows .| C.filter isTop .| C.mapM checkAccess .| C.or
diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs
index f114b23e4..b4e72497e 100644
--- a/src/Foundation/Yesod/Auth.hs
+++ b/src/Foundation/Yesod/Auth.hs
@@ -15,6 +15,8 @@ import Handler.Utils.Profile
 import Handler.Utils.StudyFeatures
 import Handler.Utils.SchoolLdap
 import Handler.Utils.LdapSystemFunctions
+import Handler.Utils.Memcached
+import Foundation.Authorization (AuthorizationCacheKey(..))
 
 import Yesod.Auth.Message
 import Auth.LDAP
@@ -469,9 +471,10 @@ upsertCampusUser upsertMode ldapData = do
       Right str <- return $ Text.decodeUtf8' v'
       assertM' (not . Text.null) $ Text.strip str
 
-  iforM_ userSystemFunctions $ \func preset -> if
-    | preset -> void $ upsert (UserSystemFunction userId func False False) []
-    | otherwise -> deleteWhere [UserSystemFunctionUser ==. userId, UserSystemFunctionFunction ==. func, UserSystemFunctionIsOptOut ==. False, UserSystemFunctionManual ==. False]
+  iforM_ userSystemFunctions $ \func preset -> do
+    memcachedByInvalidate (AuthCacheSystemFunctionList func) $ Proxy @(Set UserId)
+    if | preset -> void $ upsert (UserSystemFunction userId func False False) []
+       | otherwise -> deleteWhere [UserSystemFunctionUser ==. userId, UserSystemFunctionFunction ==. func, UserSystemFunctionIsOptOut ==. False, UserSystemFunctionManual ==. False]
 
   return user
   where
diff --git a/src/Handler/Course/Application/Files.hs b/src/Handler/Course/Application/Files.hs
index 05b229560..e10087bd0 100644
--- a/src/Handler/Course/Application/Files.hs
+++ b/src/Handler/Course/Application/Files.hs
@@ -58,7 +58,7 @@ getCAppsFilesR tid ssh csh = do
         return (allocation, user, courseApplication)
       apps' <- flip filterM apps $ \(_, _, Entity appId _) -> do
         cID <- cachedByBinary appId $ encrypt appId
-        hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
+        lift . hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
       let
         applicationAllocs = setOf (folded . _1) apps'
 
diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs
index 5c58a0385..04acd6bd0 100644
--- a/src/Handler/Course/Edit.hs
+++ b/src/Handler/Course/Edit.hs
@@ -328,7 +328,7 @@ validateCourse = do
 
   now <- liftIO getCurrentTime
   uid <- liftHandler requireAuthId
-  userAdmin <- hasWriteAccessTo $ SchoolR cfSchool SchoolEditR
+  userAdmin <- lift . hasWriteAccessTo $ SchoolR cfSchool SchoolEditR
   newAllocationTerm <- for (acfAllocation <$> cfAllocation) $ lift . fmap allocationTerm . getJust
 
   prevAllocationCourse <- join <$> traverse (lift . getBy . UniqueAllocationCourse) cfCourseId
@@ -514,6 +514,7 @@ courseEditHandler miButtonAction mbCourseForm = do
               sinkInvitationsF lecturerInvitationConfig $ map (\(lEmail, mLty) -> (lEmail, cid, (InvDBDataLecturer mLty, InvTokenDataLecturer))) invites
               insert_ $ CourseEdit aid now cid
               upsertAllocationCourse cid $ cfAllocation res
+              memcachedByInvalidate AuthCacheLecturerList $ Proxy @(Set UserId)
             return insertOkay
           case insertOkay of
             Just _ -> do
@@ -573,6 +574,8 @@ courseEditHandler miButtonAction mbCourseForm = do
                      in void . replaceFileReferences mkFilter (CourseAppInstructionFileResidual cid) . sequence_ $ cfAppInstructionFiles res
 
                     upsertAllocationCourse cid $ cfAllocation res
+  
+                    memcachedByInvalidate AuthCacheLecturerList $ Proxy @(Set UserId)
 
                     addMessageI Success $ MsgCourseEditOk tid ssh csh
                     return True
diff --git a/src/Handler/Course/LecturerInvite.hs b/src/Handler/Course/LecturerInvite.hs
index 58530d651..a8d379711 100644
--- a/src/Handler/Course/LecturerInvite.hs
+++ b/src/Handler/Course/LecturerInvite.hs
@@ -10,6 +10,7 @@ import Import
 
 import Utils.Form
 import Handler.Utils.Invitations
+import Handler.Utils.Memcached
 
 import qualified Data.CaseInsensitive as CI
 
@@ -75,7 +76,7 @@ lecturerInvitationConfig = InvitationConfig{..}
         toJunction jLecturerType = (JunctionLecturer{..}, ())
         lFs :: FieldSettings UniWorX
         lFs = fslI MsgLecturerType & setTooltip MsgCourseLecturerRightsIdentical
-    invitationInsertHook _ _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = (*>) (memcachedByInvalidate AuthCacheLecturerList $ Proxy @(Set UserId))
     invitationSuccessMsg (Entity _ Course{..}) (Entity _ Lecturer{..}) = do
       MsgRenderer mr <- getMsgRenderer
       return . SomeMessage $ MsgLecturerInvitationAccepted (mr lecturerType) courseShorthand
diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs
index 21566bb55..bec9bb4aa 100644
--- a/src/Handler/Course/ParticipantInvite.hs
+++ b/src/Handler/Course/ParticipantInvite.hs
@@ -92,11 +92,12 @@ participantInvitationConfig = InvitationConfig{..}
     invitationForm _ _ _ = hoistAForm lift . wFormToAForm $ do
       now <- liftIO getCurrentTime
       return . pure . (, ()) $ JunctionParticipant now Nothing CourseParticipantActive
-    invitationInsertHook _ _ (_, InvTokenDataParticipant{..}) CourseParticipant{..} _ act = do
+    invitationInsertHook _ (Entity _ Course{..}) (_, InvTokenDataParticipant{..}) CourseParticipant{..} _ act = do
       deleteBy $ UniqueParticipant courseParticipantUser courseParticipantCourse -- there are no foreign key references to @{CourseParticipant}; therefor we can delete and recreate to simulate upsert
       res <- act -- insertUnique
       audit $ TransactionCourseParticipantEdit courseParticipantCourse courseParticipantUser
       void $ setUserSubmissionGroup courseParticipantCourse courseParticipantUser invTokenParticipantSubmissionGroup
+      memcachedByInvalidate (AuthCacheCourseRegisteredList courseTerm courseSchool courseShorthand) (Proxy @(Set UserId))
       return res
     invitationSuccessMsg (Entity _ Course{..}) _ =
       return . SomeMessage $ MsgCourseParticipantInvitationAccepted (CI.original courseName)
diff --git a/src/Handler/Course/Register.hs b/src/Handler/Course/Register.hs
index 1a88bfc3c..d173e1429 100644
--- a/src/Handler/Course/Register.hs
+++ b/src/Handler/Course/Register.hs
@@ -222,6 +222,7 @@ postCRegisterR tid ssh csh = do
         = return $ Just ()
       mkRegistration = do
         audit $ TransactionCourseParticipantEdit cid uid
+        memcachedByInvalidate (AuthCacheCourseRegisteredList courseTerm courseSchool courseShorthand) (Proxy @(Set UserId))
         entityKey <$> upsert
           (CourseParticipant cid uid cTime Nothing CourseParticipantActive)
           [ CourseParticipantRegistration =. cTime
@@ -238,7 +239,7 @@ postCRegisterR tid ssh csh = do
       BtnCourseDeregister -> runDB . setSerializable $ do
         part <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
         forM_ part $ \(Entity _partId CourseParticipant{..}) -> do
-          deregisterParticipant uid cid
+          deregisterParticipant uid course
 
           when (is _Just courseParticipantAllocated) $ do
             updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive courseDeregisterNoShow ]
@@ -284,12 +285,13 @@ deleteApplications uid cid = do
 deleteApplicationFiles :: CourseApplicationId -> DB ()
 deleteApplicationFiles appId = deleteWhere [ CourseApplicationFileApplication ==. appId ]
 
-deregisterParticipant :: UserId -> CourseId -> DB ()
-deregisterParticipant uid cid = do
+deregisterParticipant :: UserId -> Entity Course -> DB ()
+deregisterParticipant uid (Entity cid Course{..}) = do
   part <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
   forM_ part $ \(Entity partId CourseParticipant{}) -> do
     update partId [CourseParticipantState =. CourseParticipantInactive False]
     audit $ TransactionCourseParticipantDeleted cid uid
+    memcachedByInvalidate (AuthCacheCourseRegisteredList courseTerm courseSchool courseShorthand) (Proxy @(Set UserId))
 
   examRegistrations <- E.select . E.from $ \(examRegistration `E.InnerJoin` exam) -> do
     E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs
index 1e1f08ea5..abad8669c 100644
--- a/src/Handler/Course/Show.hs
+++ b/src/Handler/Course/Show.hs
@@ -84,7 +84,7 @@ getCShowR tid ssh csh = do
     cTime <- NTop . Just <$> liftIO getCurrentTime
     news <- forMaybeM news' $ \(Entity nId n@CourseNews{..}) -> do
       cID <- encrypt nId :: MaybeT (MaybeT DB) CryptoUUIDCourseNews
-      guardM . hasReadAccessTo $ CNewsR tid ssh csh cID CNShowR
+      guardM . lift . lift . hasReadAccessTo $ CNewsR tid ssh csh cID CNShowR
       let visible = cTime >= NTop courseNewsVisibleFrom
       files' <- lift . lift . E.select . E.from $ \newsFile -> do
         E.where_ $ newsFile E.^. CourseNewsFileNews E.==. E.val nId
@@ -93,8 +93,8 @@ getCShowR tid ssh csh = do
             & over (mapped . _1) E.unValue
             & over (mapped . _2) E.unValue
       lastEditText <- formatTime SelFormatDateTime $ maybe id max (guardOn visible =<< courseNewsVisibleFrom) courseNewsLastEdit
-      mayEditNews <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNEditR
-      mayDelete <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNDeleteR
+      mayEditNews <- lift . lift . hasWriteAccessTo $ CNewsR tid ssh csh cID CNEditR
+      mayDelete <- lift . lift . hasWriteAccessTo $ CNewsR tid ssh csh cID CNDeleteR
 
       files <- lift . lift $ forM files'' $ \f@(_isDir, fPath) -> fmap (f ,) . toTextUrl . CNewsR tid ssh csh cID $ CNFileR fPath
       archiveUrl <- lift . lift . toTextUrl $ CNewsR tid ssh csh cID CNArchiveR
@@ -121,17 +121,17 @@ getCShowR tid ssh csh = do
 
     mayReRegister <- lift . courseMayReRegister $ Entity cid course
 
-    mayViewSheets <- hasReadAccessTo $ CourseR tid ssh csh SheetListR
+    mayViewSheets <- lift . hasReadAccessTo $ CourseR tid ssh csh SheetListR
     sheets <- lift . E.select . E.from $ \sheet -> do
       E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
       return $ sheet E.^. SheetName
-    mayViewAnySheet <- anyM sheets $ \(E.Value shn) -> hasReadAccessTo $ CSheetR tid ssh csh shn SShowR
+    mayViewAnySheet <- lift . anyM sheets $ \(E.Value shn) -> hasReadAccessTo $ CSheetR tid ssh csh shn SShowR
 
-    mayViewMaterials <- hasReadAccessTo $ CourseR tid ssh csh MaterialListR
+    mayViewMaterials <- lift . hasReadAccessTo $ CourseR tid ssh csh MaterialListR
     materials <- lift . E.select . E.from $ \material -> do
       E.where_ $ material E.^. MaterialCourse E.==. E.val cid
       return $ material E.^. MaterialName
-    mayViewAnyMaterial <- anyM materials $ \(E.Value mnm) -> hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR
+    mayViewAnyMaterial <- lift . anyM materials $ \(E.Value mnm) -> hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR
 
     return (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,mApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen,mayReRegister, (mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial))
 
diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs
index 482d1a53b..7dbb4cdf4 100644
--- a/src/Handler/Course/User.hs
+++ b/src/Handler/Course/User.hs
@@ -90,22 +90,22 @@ postCUserR tid ssh csh uCId = do
     forM_ sections . fromMaybe $ return ()
 
 courseUserProfileSection :: Entity Course -> Entity User -> MaybeT Handler Widget
-courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex = _, ..}) = do
+courseUserProfileSection course@(Entity cid Course{..}) (Entity uid User{ userShowSex = _, ..}) = do
   showSex <- maybe False (userShowSex . entityVal) <$> maybeAuth
   currentRoute <- MaybeT getCurrentRoute
 
   (mRegistration, studies) <- lift . runDB $ do
     registration <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
-    studies <- E.select $ E.from $ \(course `E.InnerJoin` studyfeat `E.InnerJoin` studydegree `E.InnerJoin` studyterms) -> do
+    studies <- E.select $ E.from $ \(course' `E.InnerJoin` studyfeat `E.InnerJoin` studydegree `E.InnerJoin` studyterms) -> do
       E.on $ studyfeat E.^. StudyFeaturesField  E.==. studyterms  E.^. StudyTermsId
       E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
-      E.on $ isCourseStudyFeature course studyfeat
+      E.on $ isCourseStudyFeature course' studyfeat
       E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
-      E.where_ $ course E.^. CourseId E.==. E.val cid
+      E.where_ $ course' E.^. CourseId E.==. E.val cid
       return  (studyfeat, studydegree, studyterms)
     return (registration, studies)
 
-  mayRegister <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CAddUserR
+  mayRegister <- lift . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CAddUserR
   let regButton
         | is _Just mRegistration = BtnCourseDeregister
         | otherwise = BtnCourseRegister
@@ -138,7 +138,8 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex =
       | Just (Entity _pId CourseParticipant{..}) <- mRegistration
         -> do
           lift . runDB $ do
-            deregisterParticipant courseParticipantUser courseParticipantCourse
+            unless (courseParticipantCourse == cid) $ error "courseParticipantCourse does not match cid"
+            deregisterParticipant courseParticipantUser course
 
             whenIsJust mbReason $ \(reason, noShow) -> do
               updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive noShow ]
@@ -181,7 +182,7 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex =
 
 courseUserNoteSection :: Entity Course -> Entity User -> MaybeT Handler Widget
 courseUserNoteSection (Entity cid Course{..}) (Entity uid _) = do
-  guardM . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CUsersR
+  guardM . lift . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CUsersR
 
   currentRoute <- MaybeT getCurrentRoute
 
@@ -240,7 +241,7 @@ courseUserNoteSection (Entity cid Course{..}) (Entity uid _) = do
 
 courseUserSubmissionsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
 courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid _) = do
-  guardM . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR
+  guardM . lift . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR
 
   let whereClause = (E.&&.) <$> courseIs cid <*> userIs uid
       colonnade = mconcat -- should match getSSubsR for consistent UX
@@ -279,7 +280,7 @@ courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid _) = do
 
 courseUserExamsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
 courseUserExamsSection (Entity cid Course{..}) (Entity uid _) = do
-  guardM . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CExamNewR
+  guardM . lift . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CExamNewR
 
   uCID <- encrypt uid
 
diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs
index 0115cf78a..fb0e4c859 100644
--- a/src/Handler/Course/Users.hs
+++ b/src/Handler/Course/Users.hs
@@ -509,7 +509,7 @@ getCUsersR, postCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCUsersR = postCUsersR
 postCUsersR tid ssh csh = do
   showSex <- getShowSex
-  (Entity cid Course{..}, numParticipants, (participantRes,participantTable)) <- runDB $ do
+  (course@(Entity cid Course{..}), numParticipants, (participantRes,participantTable)) <- runDB $ do
     mayRegister <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR
     ent@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh
     hasTutorials <- exists [TutorialCourse ==. cid]
@@ -607,7 +607,8 @@ postCUsersR tid ssh csh = do
         Sum nrDel <- fmap mconcat . runDB . forM (Set.toList selectedUsers) $ \uid -> fmap (maybe mempty Sum) . runMaybeT $ do
           now <- liftIO getCurrentTime
           Entity _ CourseParticipant{..} <- MaybeT . fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
-          lift $ deregisterParticipant courseParticipantUser courseParticipantCourse
+          unless (courseParticipantCourse == cid) $ error "courseParticipantCourse does not match cid"
+          lift $ deregisterParticipant courseParticipantUser course
           case deregisterSelfImposed of
             Just (reason, noShow)
               | is _Just courseParticipantAllocated -> lift $ do
diff --git a/src/Handler/Exam/AddUser.hs b/src/Handler/Exam/AddUser.hs
index a833073f6..85ba770de 100644
--- a/src/Handler/Exam/AddUser.hs
+++ b/src/Handler/Exam/AddUser.hs
@@ -129,7 +129,7 @@ postEAddUserR tid ssh csh examn = do
       unless registerCourse $
         throwError $ mempty { aurNoCourseRegistration = pure userEmail }
 
-      guardAuthResult =<< lift (lift $ evalAccessDB (CourseR tid ssh csh CAddUserR) True)
+      lift . lift . hoist lift $ guardAuthResult =<< evalAccessDB (CourseR tid ssh csh CAddUserR) True
 
 
       lift . lift . void $ upsert
diff --git a/src/Handler/Exam/CorrectorInvite.hs b/src/Handler/Exam/CorrectorInvite.hs
index 5441a3409..a69ecd850 100644
--- a/src/Handler/Exam/CorrectorInvite.hs
+++ b/src/Handler/Exam/CorrectorInvite.hs
@@ -11,6 +11,7 @@ module Handler.Exam.CorrectorInvite
 import Import
 import Handler.Utils.Invitations
 import Handler.Utils.Exam
+import Handler.Utils.Memcached
 
 import Data.Aeson hiding (Result(..))
 
@@ -71,7 +72,7 @@ examCorrectorInvitationConfig = InvitationConfig{..}
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionExamCorrector, ())
-    invitationInsertHook _ _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = (*>) (memcachedByInvalidate AuthCacheExamCorrectorList $ Proxy @(Set UserId))
     invitationSuccessMsg (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInvitationAccepted examName
     invitationUltDest (Entity _ Exam{..}) _ = do
       Course{..} <- get404 examCourse
diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs
index 4208453e1..959b38580 100644
--- a/src/Handler/Exam/Edit.hs
+++ b/src/Handler/Exam/Edit.hs
@@ -113,6 +113,7 @@ postEEditR tid ssh csh examn = do
 
         deleteWhere [ ExamCorrectorExam ==. eId ]
         insertMany_ $ map (ExamCorrector eId) adds
+        memcachedByInvalidate AuthCacheExamCorrectorList $ Proxy @(Set UserId)
 
         deleteWhere [ InvitationFor ==. invRef @ExamCorrector eId, InvitationEmail /<-. invites ]
         sinkInvitationsF examCorrectorInvitationConfig $ map (, eId, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites
diff --git a/src/Handler/Exam/New.hs b/src/Handler/Exam/New.hs
index e982a91be..90d80c17d 100644
--- a/src/Handler/Exam/New.hs
+++ b/src/Handler/Exam/New.hs
@@ -84,6 +84,7 @@ postCExamNewR tid ssh csh = do
                     , examCorrectorUser <- adds
                     ]
         sinkInvitationsF examCorrectorInvitationConfig $ map (, examid, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites
+        memcachedByInvalidate AuthCacheExamCorrectorList $ Proxy @(Set UserId)
 
         let recordNoShow (Entity _ CourseParticipant{..}) = do
               didRecord <- is _Just <$> insertUnique ExamResult
diff --git a/src/Handler/Exam/Show.hs b/src/Handler/Exam/Show.hs
index 59ed1a4c5..1509bfa98 100644
--- a/src/Handler/Exam/Show.hs
+++ b/src/Handler/Exam/Show.hs
@@ -196,7 +196,7 @@ getEShowR tid ssh csh examn = do
 
   notificationDiscouragedExamMode <- runMaybeT $ do
     guard $ evalExamModeDNF schoolExamDiscouragedModes examExamMode
-    guardM . hasWriteAccessTo $ CExamR tid ssh csh examn EEditR
+    guardM . lift . hasWriteAccessTo $ CExamR tid ssh csh examn EEditR
     return $ notification NotificationBroad =<< messageI Warning MsgExamModeSchoolDiscouraged
       
   siteLayoutMsg heading $ do
diff --git a/src/Handler/ExternalExam/Form.hs b/src/Handler/ExternalExam/Form.hs
index 02944853c..38a3e19d4 100644
--- a/src/Handler/ExternalExam/Form.hs
+++ b/src/Handler/ExternalExam/Form.hs
@@ -107,13 +107,13 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
         fSettings = fslI MsgExternalExamStaff & setTooltip MsgExternalExamStaffTip
         fRequired = True
 
-validateExternalExam :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => FormValidator ExternalExamForm m ()
+validateExternalExam :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnliftIO m) => FormValidator ExternalExamForm m ()
 validateExternalExam = do
   State.modify $ \eeForm -> eeForm & over _eefOfficeSchools (Set.delete $ eeForm ^. _eefSchool)
 
   ExternalExamForm{..} <- State.get
 
-  isAdmin <- hasWriteAccessTo $ SchoolR eefSchool SchoolEditR
+  isAdmin <- lift . hasWriteAccessTo $ SchoolR eefSchool SchoolEditR
   unless isAdmin $ do
     uid <- requireAuthId
     guardValidation MsgExternalExamUserMustBeStaff $ Right uid `Set.member` eefStaff
diff --git a/src/Handler/Info.hs b/src/Handler/Info.hs
index f12f96e44..18fdf5a59 100644
--- a/src/Handler/Info.hs
+++ b/src/Handler/Info.hs
@@ -108,6 +108,7 @@ mkMessageFor ''UniWorX ''FAQItem "messages/faq" "de-de-formal"
 
 faqsWidget :: ( MonadHandler m, HandlerSite m ~ UniWorX
               , MonadThrow m
+              , MonadUnliftIO m
               )
            => Maybe Natural -> Maybe (Route UniWorX) -> m (Maybe Widget, Bool)
 faqsWidget mLimit route = do
@@ -157,6 +158,7 @@ getFaqR =
 
 showFAQ :: ( MonadHandler m, HandlerSite m ~ UniWorX
            , MonadThrow m
+           , MonadUnliftIO m
            )
         => Route UniWorX -> FAQItem -> m Bool
 showFAQ _ FAQNoCampusAccount = is _Nothing <$> maybeAuthId
diff --git a/src/Handler/News.hs b/src/Handler/News.hs
index ab8c765b4..5124d597d 100644
--- a/src/Handler/News.hs
+++ b/src/Handler/News.hs
@@ -70,7 +70,7 @@ newsSystemMessages = do
 
   (messages', Any anyHidden) <- liftHandler . runDB . runConduit . C.runWriterLC $
        transPipe lift (selectKeys [] [])
-    .| C.filterM (hasReadAccessTo . MessageR <=< encrypt)
+    .| C.filterM (lift . hasReadAccessTo . MessageR <=< encrypt)
     .| transPipe lift (C.mapMaybeM $ \smId -> fmap (\args@(sm, _) -> (smId, sm, systemMessageToTranslation smId args)) <$> getSystemMessage smId)
     .| C.filter (\(_, SystemMessage{..}, _) -> NTop systemMessageFrom <= NTop (Just now) && NTop (Just now) < NTop systemMessageTo)
     .| C.mapMaybeM checkHidden
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index e57de169b..cb7d70549 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -151,7 +151,7 @@ schoolsForm template = formToAForm $ schoolsFormView =<< renderWForm FormStandar
 notificationForm :: Maybe NotificationSettings -> AForm Handler NotificationSettings
 notificationForm template = wFormToAForm $ do
   mbUid <- liftHandler maybeAuthId
-  isAdmin <- hasReadAccessTo AdminR
+  isAdmin <- lift . lift $ hasReadAccessTo AdminR
 
   let
     sectionIsHidden :: NotificationTriggerKind -> DB Bool
diff --git a/src/Handler/Sheet/CorrectorInvite.hs b/src/Handler/Sheet/CorrectorInvite.hs
index da23c0b78..ea4e29d83 100644
--- a/src/Handler/Sheet/CorrectorInvite.hs
+++ b/src/Handler/Sheet/CorrectorInvite.hs
@@ -74,7 +74,7 @@ correctorInvitationConfig = InvitationConfig{..}
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ (InvDBDataSheetCorrector cLoad cState, _) _ = pure (JunctionSheetCorrector cLoad cState, ())
-    invitationInsertHook _ _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = (*>) (memcachedByInvalidate AuthCacheCorrectorList $ Proxy @(Set UserId))
     invitationSuccessMsg (Entity _ Sheet{..}) _ = return . SomeMessage $ MsgCorrectorInvitationAccepted sheetName
     invitationUltDest (Entity _ Sheet{..}) _ = do
       Course{..} <- get404 sheetCourse
diff --git a/src/Handler/Sheet/Edit.hs b/src/Handler/Sheet/Edit.hs
index 5acf81fc6..6e3977fbd 100644
--- a/src/Handler/Sheet/Edit.hs
+++ b/src/Handler/Sheet/Edit.hs
@@ -120,6 +120,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
 
             deleteWhere [ SheetCorrectorSheet ==. sid ]
             insertMany_ adds
+            memcachedByInvalidate AuthCacheCorrectorList (Proxy @(Set UserId))
 
             deleteWhere [InvitationFor ==. invRef @SheetCorrector sid, InvitationEmail /<-. toListOf (folded . _1) invites]
             sinkInvitationsF correctorInvitationConfig invites
diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs
index f70b3d473..0704a87d5 100644
--- a/src/Handler/Sheet/Form.hs
+++ b/src/Handler/Sheet/Form.hs
@@ -120,7 +120,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
               )
             ]
           )
-        guardM $ hasReadAccessTo downloadRoute
+        guardM . lift $ hasReadAccessTo downloadRoute
         messageIconWidget Info IconFileUser
           [whamlet|
             $newline never
diff --git a/src/Handler/Sheet/List.hs b/src/Handler/Sheet/List.hs
index c46419064..86708390d 100644
--- a/src/Handler/Sheet/List.hs
+++ b/src/Handler/Sheet/List.hs
@@ -95,7 +95,7 @@ getSheetListR tid ssh csh = do
                     acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
                     tellStats = do
                       r <- mkRoute
-                      showRating <- hasReadAccessTo r
+                      showRating <- lift $ hasReadAccessTo r
                       tell . stats $ bool Nothing submissionRatingPoints showRating
                 in acell & cellContents %~ (<* tellStats)
 
diff --git a/src/Handler/Sheet/Show.hs b/src/Handler/Sheet/Show.hs
index 462337399..4603474f6 100644
--- a/src/Handler/Sheet/Show.hs
+++ b/src/Handler/Sheet/Show.hs
@@ -129,7 +129,7 @@ getSShowR tid ssh csh shn = do
   mRequiredExamLink <- runMaybeT $ do
     (etid, essh, ecsh, examn) <- hoistMaybe mRequiredExam
     let eUrl = CExamR etid essh ecsh examn EShowR
-    guardM $ hasReadAccessTo eUrl
+    guardM . lift $ hasReadAccessTo eUrl
     return eUrl
   mMissingExamRegistration <- for (guardOnM checkExamRegistration $ sheetRequireExamRegistration sheet) $ \eId -> maybeT (return True) $ do
     uid <- MaybeT maybeAuthId
@@ -148,7 +148,7 @@ getSShowR tid ssh csh shn = do
   submissionModeNoneWithoutNotGradedWarning <- runMaybeT $ do
     guard $ classifySubmissionMode (sheetSubmissionMode sheet) == SubmissionModeNone
          && sheetType sheet /= NotGraded
-    guardM . hasWriteAccessTo $ CSheetR tid ssh csh shn SEditR
+    guardM . lift . hasWriteAccessTo $ CSheetR tid ssh csh shn SEditR
     return $ notification NotificationBroad =<< messageI Warning MsgSheetSubmissionModeNoneWithoutNotGraded
 
   sTypeDesc <- runDB $ sheetTypeDescription (sheetCourse sheet) (sheetType sheet)
@@ -162,7 +162,7 @@ getSShowR tid ssh csh shn = do
     sheetTo       <- traverse (formatTime SelFormatDateTime) $  sheetActiveTo     sheet
     hintsFrom     <- traverse (formatTime SelFormatDateTime) $  sheetHintFrom     sheet
     solutionFrom  <- traverse (formatTime SelFormatDateTime) $  sheetSolutionFrom sheet
-    markingText   <- runMaybeT $ assertM_ (Authorized ==) (evalAccessCorrector tid ssh csh) >> hoistMaybe (sheetMarkingText sheet)
+    markingText   <- runMaybeT $ assertM_ (Authorized ==) (lift $ evalAccessCorrector tid ssh csh) >> hoistMaybe (sheetMarkingText sheet)
     submissionTip <- messageI Info MsgSheetCorrectorSubmissionsTip
     tr <- getTranslate
     $(widgetFile "sheetShow")
diff --git a/src/Handler/Submission/Download.hs b/src/Handler/Submission/Download.hs
index 0e0e1d62c..5c12dcfc2 100644
--- a/src/Handler/Submission/Download.hs
+++ b/src/Handler/Submission/Download.hs
@@ -24,7 +24,7 @@ subDownloadSource tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) p
     isRating <- lift $ (== Just submissionID) <$> isRatingFile path
 
     when (isUpdate || isRating) $
-      guardM . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
+      guardM . lift . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
 
     return (submissionID, isRating)
 
@@ -59,7 +59,7 @@ getSubDownloadR tid ssh csh shn cID sft@(submissionFileTypeIsUpdate -> isUpdate)
 subArchiveSource :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> ConduitT () (Either SubmissionFile DBFile) (YesodDB UniWorX) ()
 subArchiveSource tid ssh csh shn cID sfType = maybeT (return ()) $ do
   when (sfType == SubmissionCorrected) $
-    guardM . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
+    guardM . lift . lift . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
 
   lift $ do
     submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
diff --git a/src/Handler/Tutorial/Communication.hs b/src/Handler/Tutorial/Communication.hs
index c09447ffb..70ca14d52 100644
--- a/src/Handler/Tutorial/Communication.hs
+++ b/src/Handler/Tutorial/Communication.hs
@@ -21,7 +21,7 @@ postTCommR tid ssh csh tutn = do
     tuts <- selectList [TutorialCourse ==. cid] []
     usertuts <- forMaybeM tuts $ \(Entity tutid Tutorial{..}) -> do
       cID <- encrypt tutid
-      guardM . hasReadAccessTo $ CTutorialR tid ssh csh tutorialName TUsersR
+      guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutorialName TUsersR
       return ( RGTutorialParticipants cID
              , E.from $ \(user `E.InnerJoin` participant) -> do
                  E.on $ user E.^. UserId E.==. participant E.^. TutorialParticipantUser
diff --git a/src/Handler/Tutorial/Edit.hs b/src/Handler/Tutorial/Edit.hs
index 753685c26..c8a9ce789 100644
--- a/src/Handler/Tutorial/Edit.hs
+++ b/src/Handler/Tutorial/Edit.hs
@@ -78,6 +78,7 @@ postTEditR tid ssh csh tutn = do
 
         deleteWhere [ InvitationFor ==. invRef @Tutor tutid, InvitationEmail /<-. invites ]
         sinkInvitationsF tutorInvitationConfig $ map (, tutid, (InvDBDataTutor, InvTokenDataTutor)) invites
+        memcachedByInvalidate AuthCacheTutorList $ Proxy @(Set UserId)
       return insertRes
     case insertRes of
       Just _  -> addMessageI Error $ MsgTutorialNameTaken tfName
diff --git a/src/Handler/Tutorial/New.hs b/src/Handler/Tutorial/New.hs
index 728e264ec..32a88670e 100644
--- a/src/Handler/Tutorial/New.hs
+++ b/src/Handler/Tutorial/New.hs
@@ -43,6 +43,7 @@ postCTutorialNewR tid ssh csh = do
 
         let (invites, adds) = partitionEithers $ Set.toList tfTutors
         insertMany_ $ map (Tutor tutid) adds
+        memcachedByInvalidate AuthCacheTutorList $ Proxy @(Set UserId)
         sinkInvitationsF tutorInvitationConfig $ map (, tutid, (InvDBDataTutor, InvTokenDataTutor)) invites
       return insertRes
     case insertRes of
diff --git a/src/Handler/Tutorial/TutorInvite.hs b/src/Handler/Tutorial/TutorInvite.hs
index 541a3e793..410f4e5d5 100644
--- a/src/Handler/Tutorial/TutorInvite.hs
+++ b/src/Handler/Tutorial/TutorInvite.hs
@@ -9,6 +9,7 @@ module Handler.Tutorial.TutorInvite
 import Import
 import Handler.Utils.Tutorial
 import Handler.Utils.Invitations
+import Handler.Utils.Memcached
 
 import Data.Aeson hiding (Result(..))
 
@@ -69,7 +70,7 @@ tutorInvitationConfig = InvitationConfig{..}
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionTutor, ())
-    invitationInsertHook _ _ _ _ _ = id
+    invitationInsertHook _ _ _ _ _ = (*>) (memcachedByInvalidate AuthCacheTutorList $ Proxy @(Set UserId))
     invitationSuccessMsg (Entity _ Tutorial{..}) _ = return . SomeMessage $ MsgCorrectorInvitationAccepted tutorialName
     invitationUltDest (Entity _ Tutorial{..}) _ = do
       Course{..} <- get404 tutorialCourse
diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs
index 97dc383ac..a2ba0c97d 100644
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@@ -108,7 +108,7 @@ postUsersR = do
           , formCellLens     = id
           , formCellContents = do
               cID <- encrypt uid
-              mayHijack <- (== Authorized) <$> evalAccess (AdminHijackUserR cID) True
+              mayHijack <- lift . lift $ (== Authorized) <$> evalAccess (AdminHijackUserR cID) True
               myUid <- liftHandler maybeAuthId
               if
                 | mayHijack
@@ -319,7 +319,7 @@ postAdminUserR uuid = do
 
     -- above data is needed for both form generation and result evaluation
     let userRightsForm :: Form (Set (SchoolFunction, SchoolId))
-        userRightsForm = identifyForm FIDuserRights $ \csrf -> do
+        userRightsForm csrf = do
           boxRights <- sequence . flip Map.fromSet (allFunctions `setProduct` allSchools) $ \(function, sid) -> if
             | sid `Set.member` adminSchools
               -> mpopt   checkBoxField "" . Just $ (function, sid) `Set.member` functions
@@ -339,6 +339,8 @@ postAdminUserR uuid = do
           if
             | not $ Set.null updates -> runDBJobs $ do
                 $logInfoS "user-rights-update" $ tshow updates
+                forM_ (setOf (folded . _1) updates) $ \func ->
+                  memcachedByInvalidate (AuthCacheSchoolFunctionList func) $ Proxy @(Set UserId)
                 forM_ updates $ \(function, sid) -> do
                   $logDebugS "user-rights-update" [st|#{tshow (function, sid)}: #{tshow (Set.member (function, sid) functions)} → #{tshow (Set.member (function,sid) changes)}|]
                   if
@@ -394,11 +396,12 @@ postAdminUserR uuid = do
           let symmDiff = setFromFunc newFuncs `setSymmDiff` setFromFunc systemFunctions
           if
             | not $ Set.null symmDiff -> runDBJobs $ do
-                forM_ symmDiff $ \func -> if
-                  | newFuncs func
-                    -> void $ upsert (UserSystemFunction uid func True False) [ UserSystemFunctionIsOptOut =. False, UserSystemFunctionManual =. True ]
-                  | otherwise
-                    -> void $ upsert (UserSystemFunction uid func True True) [ UserSystemFunctionIsOptOut =. True, UserSystemFunctionManual =. True ]
+                forM_ symmDiff $ \func -> do
+                  memcachedByInvalidate (AuthCacheSystemFunctionList func) $ Proxy @(Set UserId)
+                  if | newFuncs func
+                       -> void $ upsert (UserSystemFunction uid func True False) [ UserSystemFunctionIsOptOut =. False, UserSystemFunctionManual =. True ]
+                     | otherwise
+                       -> void $ upsert (UserSystemFunction uid func True True) [ UserSystemFunctionIsOptOut =. True, UserSystemFunctionManual =. True ]
                 queueDBJob . JobQueueNotification . NotificationUserSystemFunctionsUpdate uid $ setFromFunc systemFunctions
                 addMessageI Success MsgUserSystemFunctionsSaved
             | otherwise
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
index 31ed5dccd..6c8aae995 100644
--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@@ -70,8 +70,9 @@ warnTermDays tid timeNames = do
 
 
 -- | return a value only if the current user ist authorized for a given route
-guardAuthorizedFor :: ( HandlerSite h ~ UniWorX, MonadHandler h, MonadThrow h
-                      , MonadTrans m, MonadPlus (m (ReaderT SqlBackend h)))
+guardAuthorizedFor :: ( HandlerSite h ~ UniWorX, MonadHandler h, MonadThrow h, MonadUnliftIO h
+                      , MonadTrans m, MonadPlus (m (ReaderT SqlBackend h))
+                      )
   => Route UniWorX -> a -> m (ReaderT SqlBackend h) a
 guardAuthorizedFor link val =
   val <$ guardM (lift $ (== Authorized) <$> evalAccessDB link False)
diff --git a/src/Handler/Utils/Course.hs b/src/Handler/Utils/Course.hs
index bc4e3ce48..34b671b7d 100644
--- a/src/Handler/Utils/Course.hs
+++ b/src/Handler/Utils/Course.hs
@@ -2,6 +2,7 @@ module Handler.Utils.Course where
 
 import Import
 import Handler.Utils.Delete
+import Handler.Utils.Memcached
 
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
@@ -48,8 +49,9 @@ setUsersSubmissionGroup cid uids Nothing = do
     didDelete <- fmap (> 0) . E.deleteCount . E.from $ \submissionGroupUser ->
       E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
            E.&&. E.subSelectForeign submissionGroupUser SubmissionGroupUserSubmissionGroup (E.^. SubmissionGroupCourse) E.==. E.val cid
-    when didDelete $
+    when didDelete $ do
       audit $ TransactionSubmissionGroupUnset cid uid
+      memcachedByInvalidate AuthCacheSubmissionGroupUserList (Proxy @(Set UserId))
     return $ bool mempty (Sum 1) didDelete
   E.delete . E.from $ \submissionGroup ->
     E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cid
@@ -68,8 +70,9 @@ setUsersSubmissionGroup cid uids (Just grp) = do
          E.&&. submissionGroup E.^. SubmissionGroupId E.!=. E.val gId
   fmap getSum . flip foldMapM uids $ \uid -> do
     didSet <- fmap (is _Just) . insertUnique $ SubmissionGroupUser gId uid
-    when didSet $
+    when didSet $ do
       audit $ TransactionSubmissionGroupSet cid uid grp
+      memcachedByInvalidate AuthCacheSubmissionGroupUserList (Proxy @(Set UserId))
     return $ bool mempty (Sum 1) didSet
 
 showCourseEventRoom :: forall courseEvent courseId.
diff --git a/src/Handler/Utils/ExamOffice/Exam.hs b/src/Handler/Utils/ExamOffice/Exam.hs
index e9f903471..be3ab8fda 100644
--- a/src/Handler/Utils/ExamOffice/Exam.hs
+++ b/src/Handler/Utils/ExamOffice/Exam.hs
@@ -34,7 +34,7 @@ resultIsSynced authId examResult = (hasSchool E.&&. allSchools) E.||. (E.not_ ha
 examOfficeExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office
                          -> E.SqlExpr (Entity ExamResult)
                          -> E.SqlExpr (E.Value Bool)
-examOfficeExamResultAuth authId examResult = authByUser E.||. authByField E.||. authBySchool E.||. authByExtraSchool
+examOfficeExamResultAuth authId examResult = ((isOffice E.||. isSystemOffice) E.&&. authByUser) E.||. authByField E.||. authBySchool E.||. authByExtraSchool
   where
     cId = E.subSelectForeign examResult ExamResultExam (\exam -> E.subSelectForeign exam ExamCourse (E.^. CourseId))
     
@@ -61,6 +61,14 @@ examOfficeExamResultAuth authId examResult = authByUser E.||. authByField E.||.
       E.where_ $ examOfficeUser E.^. ExamOfficeUserOffice E.==. authId
            E.&&. examOfficeUser E.^. ExamOfficeUserUser E.==. examResult E.^. ExamResultUser
 
+    isOffice = E.exists . E.from $ \userFunction ->
+      E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
+           E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
+    isSystemOffice = E.exists . E.from $ \userSystemFunction -> 
+      E.where_ $ userSystemFunction E.^. UserSystemFunctionUser E.==. authId
+           E.&&. userSystemFunction E.^. UserSystemFunctionFunction E.==. E.val SystemExamOffice
+           E.&&. E.not_ (userSystemFunction E.^. UserSystemFunctionIsOptOut)
+
     authBySchool = E.exists . E.from $ \(userFunction `E.InnerJoin` course `E.InnerJoin` exam) -> do
       E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
        E.&&. exam E.^. ExamId E.==. examResult E.^. ExamResultExam
diff --git a/src/Handler/Utils/ExamOffice/ExternalExam.hs b/src/Handler/Utils/ExamOffice/ExternalExam.hs
index ed7be4aba..1c9d74310 100644
--- a/src/Handler/Utils/ExamOffice/ExternalExam.hs
+++ b/src/Handler/Utils/ExamOffice/ExternalExam.hs
@@ -34,7 +34,7 @@ resultIsSynced authId eexamResult = (hasSchool E.&&. allSchools) E.||. (E.not_ h
 examOfficeExternalExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office
                                  -> E.SqlExpr (Entity ExternalExamResult)
                                  -> E.SqlExpr (E.Value Bool)
-examOfficeExternalExamResultAuth authId eexamResult = authByUser E.||. authByField E.||. authBySchool E.||. authByExtraSchool
+examOfficeExternalExamResultAuth authId eexamResult = ((isOffice E.||. isSystemOffice) E.&&. authByUser) E.||. authByField E.||. authBySchool E.||. authByExtraSchool
   where
     authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do
       E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField
@@ -54,6 +54,14 @@ examOfficeExternalExamResultAuth authId eexamResult = authByUser E.||. authByFie
       E.where_ $ examOfficeUser E.^. ExamOfficeUserOffice E.==. authId
            E.&&. examOfficeUser E.^. ExamOfficeUserUser E.==. eexamResult E.^. ExternalExamResultUser
 
+    isOffice = E.exists . E.from $ \userFunction ->
+      E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
+           E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
+    isSystemOffice = E.exists . E.from $ \userSystemFunction -> 
+      E.where_ $ userSystemFunction E.^. UserSystemFunctionUser E.==. authId
+           E.&&. userSystemFunction E.^. UserSystemFunctionFunction E.==. E.val SystemExamOffice
+           E.&&. E.not_ (userSystemFunction E.^. UserSystemFunctionIsOptOut)
+
     authBySchool = E.exists . E.from $ \(userFunction `E.InnerJoin` eexam) -> do
       E.on $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
        E.&&. userFunction E.^. UserFunctionSchool E.==. eexam E.^. ExternalExamSchool
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 707a0a5e1..57b69c503 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -1199,14 +1199,17 @@ sheetGradingAFormReq fs template = multiActionA selOptions fs (classify' <$> tem
 
 sheetTypeAFormReq :: CourseId -> FieldSettings UniWorX -> Maybe (SheetType ExamPartId) -> AForm Handler (SheetType ExamPartId)
 sheetTypeAFormReq cId fs template = wFormToAForm $ do
-  examParts'' <- liftHandler . runDB . E.select . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examPart) -> do
-    E.on $ exam E.^. ExamId E.==. examPart E.^. ExamPartExam
-    E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
-    E.where_ $ exam E.^. ExamCourse E.==. E.val cId
-    return (exam, course, examPart)
+  (examParts'', editableExams) <- liftHandler . runDB $ do
+    examParts'' <- E.select . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examPart) -> do
+      E.on $ exam E.^. ExamId E.==. examPart E.^. ExamPartExam
+      E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
+      E.where_ $ exam E.^. ExamCourse E.==. E.val cId
+      return (exam, course, examPart)
 
-  editableExams <- fmap Map.keysSet . flip mapFilterM (foldMap (\(Entity eId exam, Entity _ course, _) -> Map.singleton eId (exam, course)) examParts'') $ \(Exam{..}, Course{..}) ->
-    hasWriteAccessTo $ CExamR courseTerm courseSchool courseShorthand examName EEditR
+    editableExams <- fmap Map.keysSet . flip mapFilterM (foldMap (\(Entity eId exam, Entity _ course, _) -> Map.singleton eId (exam, course)) examParts'') $ \(Exam{..}, Course{..}) ->
+      hasWriteAccessTo $ CExamR courseTerm courseSchool courseShorthand examName EEditR
+  
+    return (examParts'', editableExams)
 
   let
     examParts' = flip foldMap examParts'' $ \(eEnt@(Entity eId _), _, epEnt) -> guardOn @[] (eId `Set.member` editableExams) (eEnt, epEnt)
diff --git a/src/Handler/Utils/Memcached.hs b/src/Handler/Utils/Memcached.hs
index 140345aff..58a081b36 100644
--- a/src/Handler/Utils/Memcached.hs
+++ b/src/Handler/Utils/Memcached.hs
@@ -56,6 +56,8 @@ import qualified Crypto.Saltine.Core.AEAD as AEAD
 
 import qualified Control.Monad.State.Class as State
 
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+
 
 type Expiry = Either UTCTime DiffTime
 
@@ -141,13 +143,9 @@ data MemcachedException = MemcachedException Memcached.MemcachedException
   deriving anyclass (Exception)
 
 
-memcachedKey :: ( Typeable a
-                , Binary k
-                )
-             => AEAD.Key -> Proxy a -> k -> ByteString
-memcachedKey (Saltine.encode -> kmacKey) p k = Binary.encode k
-  & kmaclazy @(SHAKE256 256) (encodeUtf8 . tshow $ typeRep p) kmacKey
-  & BA.convert
+memcachedKey :: Typeable a
+             => AEAD.Key -> Proxy a -> Lazy.ByteString -> ByteString
+memcachedKey (Saltine.encode -> kmacKey) p = BA.convert . kmaclazy @(SHAKE256 256) (encodeUtf8 . tshow $ typeRep p) kmacKey
 
 memcachedAAD :: ByteString -> Maybe POSIXTime -> ByteString
 memcachedAAD cKey mExpiry = toStrict . Binary.runPut $ do
@@ -160,35 +158,38 @@ memcachedByGet :: forall a k m.
                   , Binary k
                   )
                => k -> m (Maybe a)
-memcachedByGet k = runMaybeT $ do
-  (aeadKey, conn) <- MaybeT $ getsYesod appMemcached
-  let cKey = memcachedKey aeadKey (Proxy @a) k
-
-  encVal <- fmap toStrict . hoist liftIO . catchMaybeT (Proxy @Memcached.MemcachedException) $ Memcached.get_ cKey conn
-
-  $logDebugS "memcached" "Cache hit"
-
-  let withExp doExp = do
-        MemcachedValue{..} <- hoistMaybe . flip runGetMaybe encVal $ bool getMemcachedValueNoExpiry getMemcachedValue doExp
-        $logDebugS "memcached" "Decode valid"
-        for_ mExpiry $ \expiry -> do
-          now <- liftIO getPOSIXTime
-          guard $ expiry > now + clockLeniency
-        $logDebugS "memcached" $ "Expiry valid: " <> tshow mExpiry
-        let aad = memcachedAAD cKey mExpiry
-        decrypted <- hoistMaybe $ AEAD.aeadOpen aeadKey mNonce mCiphertext aad
-
-        $logDebugS "memcached" $ "Decryption valid " <> bool "without" "with" doExp <> " expiration"
-
-        hoistMaybe $ runGetMaybe Binary.get decrypted
-
-  withExp True <|> withExp False
+memcachedByGet (Binary.encode -> k) = runMaybeT $ requestCache <|> memcache
   where
-    runGetMaybe p (fromStrict -> bs) = case Binary.runGetOrFail p bs of
-      Right (bs', _, x) | null bs' -> Just x
-      _other -> Nothing
-    clockLeniency :: NominalDiffTime
-    clockLeniency = 2
+    requestCache = MaybeT . cacheByGet $ toStrict k
+    memcache = do
+      (aeadKey, conn) <- MaybeT $ getsYesod appMemcached
+      let cKey = memcachedKey aeadKey (Proxy @a) k
+
+      encVal <- fmap toStrict . hoist liftIO . catchMaybeT (Proxy @Memcached.MemcachedException) $ Memcached.get_ cKey conn
+
+      $logDebugS "memcached" "Cache hit"
+
+      let withExp doExp = do
+            MemcachedValue{..} <- hoistMaybe . flip runGetMaybe encVal $ bool getMemcachedValueNoExpiry getMemcachedValue doExp
+            $logDebugS "memcached" "Decode valid"
+            for_ mExpiry $ \expiry -> do
+              now <- liftIO getPOSIXTime
+              guard $ expiry > now + clockLeniency
+            $logDebugS "memcached" $ "Expiry valid: " <> tshow mExpiry
+            let aad = memcachedAAD cKey mExpiry
+            decrypted <- hoistMaybe $ AEAD.aeadOpen aeadKey mNonce mCiphertext aad
+
+            $logDebugS "memcached" $ "Decryption valid " <> bool "without" "with" doExp <> " expiration"
+
+            hoistMaybe $ runGetMaybe Binary.get decrypted
+
+      withExp True <|> withExp False
+      where
+        runGetMaybe p (fromStrict -> bs) = case Binary.runGetOrFail p bs of
+          Right (bs', _, x) | null bs' -> Just x
+          _other -> Nothing
+        clockLeniency :: NominalDiffTime
+        clockLeniency = 2
 
 memcachedBySet :: forall a k m.
                   ( MonadHandler m, HandlerSite m ~ UniWorX
@@ -197,7 +198,7 @@ memcachedBySet :: forall a k m.
                   , Binary k
                   )
                => Maybe Expiry -> k -> a -> m ()
-memcachedBySet mExp k v = do
+memcachedBySet mExp (Binary.encode -> k) v = do
   mExp' <- for mExp $ \exp -> maybe (throwM $ MemcachedInvalidExpiry exp) return $ exp ^? _MemcachedExpiry
   mConn <- getsYesod appMemcached
   for_ mConn $ \(aeadKey, conn) -> do
@@ -209,6 +210,7 @@ memcachedBySet mExp k v = do
         aad = memcachedAAD cKey mExpiry
         mCiphertext = AEAD.aead aeadKey mNonce (toStrict $ Binary.encode v) aad
     liftIO $ Memcached.set zeroBits (fromMaybe zeroBits mExp') cKey (Binary.runPut $ putMemcachedValue MemcachedValue{..}) conn
+    cacheBySet (toStrict k) v
     $logDebugS "memcached" $ "Cache store: " <> tshow mExpiry
 
 memcachedByInvalidate :: forall a k m p.
@@ -217,7 +219,7 @@ memcachedByInvalidate :: forall a k m p.
                          , Binary k
                          )
                       => k -> p a -> m ()
-memcachedByInvalidate k _ = maybeT_ $ do
+memcachedByInvalidate (Binary.encode -> k) _ = maybeT_ $ do
   (aeadKey, conn) <- MaybeT $ getsYesod appMemcached
   let cKey = memcachedKey aeadKey (Proxy @a) k
   hoist liftIO . catchIfMaybeT Memcached.isKeyNotFound $ Memcached.delete cKey conn
diff --git a/src/Handler/Utils/Sheet.hs b/src/Handler/Utils/Sheet.hs
index 760c15705..4ab5bce08 100644
--- a/src/Handler/Utils/Sheet.hs
+++ b/src/Handler/Utils/Sheet.hs
@@ -91,13 +91,12 @@ resolveSheetTypeRating cId dbST = do
         }
 
 sheetTypeDescription :: forall m.
-                        ( MonadThrow m
-                        , MonadHandler m, HandlerSite m ~ UniWorX
+                        ( MonadHandler m, HandlerSite m ~ UniWorX
                         )
                      => CourseId
                      -> SheetType SqlBackendKey
                      -> ReaderT SqlBackend m (HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
-sheetTypeDescription cId dbST = do
+sheetTypeDescription cId dbST = hoist liftHandler $ do
   sType' <- resolveSheetType cId dbST
   sType <- for sType' $ \(Entity _epId ExamPart{..}) -> do
     Exam{..} <- getJust examPartExam
diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index e7f5cabf0..1627a2f51 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -359,7 +359,7 @@ submissionMultiArchive anonymous (Set.toList -> ids) = do
 
         notAnonymized' <- and2M
           (return $ isn't _SubmissionDownloadAnonymous anonymous)
-          (or2M (return $ not sheetAnonymous) (hasReadAccessTo $ CourseR tid ssh csh CCorrectionsR))
+          (or2M (return $ not sheetAnonymous) (lift . hasReadAccessTo $ CourseR tid ssh csh CCorrectionsR))
 
         submissionDirectory <- bool return withNames notAnonymized' $ dirFrag (cID :: CryptoFileNameSubmission)
 
@@ -811,7 +811,7 @@ sinkMultiSubmission userId isUpdate = do
             Submission{..} <- get404 sId
             Sheet{..} <- get404 submissionSheet
             Course{..} <- get404 sheetCourse
-            guardAuthResult =<< evalAccessDB (CSubmissionR courseTerm courseSchool courseShorthand sheetName cID CorrectionR) True
+            hoist lift $ guardAuthResult =<< evalAccessDB (CSubmissionR courseTerm courseSchool courseShorthand sheetName cID CorrectionR) True
           return . newResumableSink $ sinkSubmission (Just userId) (Right sId) isUpdate
       sink' <- lift $ yield val ++$$ sink
       case sink' of
diff --git a/src/Handler/Utils/Workflow/EdgeForm.hs b/src/Handler/Utils/Workflow/EdgeForm.hs
index d7b932e82..ea92d44f0 100644
--- a/src/Handler/Utils/Workflow/EdgeForm.hs
+++ b/src/Handler/Utils/Workflow/EdgeForm.hs
@@ -73,6 +73,7 @@ workflowEdgeForm :: ( MonadHandler m
                     , MonadHandler m'
                     , HandlerSite m' ~ UniWorX
                     , MonadCatch m'
+                    , MonadUnliftIO m'
                     )
                  => Either WorkflowInstanceId WorkflowWorkflowId
                  -> Maybe WorkflowEdgeForm
diff --git a/src/Handler/Utils/Workflow/Workflow.hs b/src/Handler/Utils/Workflow/Workflow.hs
index be615a834..15676222f 100644
--- a/src/Handler/Utils/Workflow/Workflow.hs
+++ b/src/Handler/Utils/Workflow/Workflow.hs
@@ -85,7 +85,7 @@ sourceWorkflowActionInfos
      ( MonadHandler m, HandlerSite m ~ UniWorX
      , BackendCompatible SqlReadBackend backend
      , MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey
-     , MonadCatch m
+     , MonadCatch m, MonadUnliftIO m
      )
   => WorkflowWorkflowId
   -> WorkflowState FileReference UserId
diff --git a/src/Handler/Workflow/Instance/List.hs b/src/Handler/Workflow/Instance/List.hs
index 0d4fc285d..8038ed7a4 100644
--- a/src/Handler/Workflow/Instance/List.hs
+++ b/src/Handler/Workflow/Instance/List.hs
@@ -151,9 +151,9 @@ workflowInstanceListR rScope = do
           Entity _ desc@WorkflowInstanceDescription{..} <- descs
           guard $ workflowInstanceDescriptionLanguage == lang
           return desc
-      mayInitiate <- hasWriteAccessTo $ toInitiateRoute workflowInstanceName
-      mayEdit <- hasReadAccessTo $ toEditRoute workflowInstanceName
-      mayList <- hasReadAccessTo $ toListRoute workflowInstanceName
+      mayInitiate <- lift . hasWriteAccessTo $ toInitiateRoute workflowInstanceName
+      mayEdit <- lift . hasReadAccessTo $ toEditRoute workflowInstanceName
+      mayList <- lift . hasReadAccessTo $ toListRoute workflowInstanceName
       guard $ mayInitiate || mayEdit || mayList
       return (wi, desc)
 
@@ -192,9 +192,9 @@ getTopWorkflowInstanceListR = do
           Entity _ desc@WorkflowInstanceDescription{..} <- descs
           guard $ workflowInstanceDescriptionLanguage == lang
           return desc
-      mayInitiate <- hasWriteAccessTo $ toInitiateRoute' rScope workflowInstanceName
-      mayEdit <- hasReadAccessTo $ toEditRoute' rScope workflowInstanceName
-      mayList <- hasReadAccessTo $ toListRoute' rScope workflowInstanceName
+      mayInitiate <- lift . hasWriteAccessTo $ toInitiateRoute' rScope workflowInstanceName
+      mayEdit <- lift . hasReadAccessTo $ toEditRoute' rScope workflowInstanceName
+      mayList <- lift . hasReadAccessTo $ toListRoute' rScope workflowInstanceName
       guard $ mayInitiate || mayEdit || mayList
       return (rScope, [(wi, desc)])
 
diff --git a/src/Handler/Workflow/Workflow/List.hs b/src/Handler/Workflow/Workflow/List.hs
index 97d56fb28..adbd79d95 100644
--- a/src/Handler/Workflow/Workflow/List.hs
+++ b/src/Handler/Workflow/Workflow/List.hs
@@ -367,6 +367,7 @@ workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do
                           ( MonadHandler m
                           , HandlerSite m ~ UniWorX
                           , MonadCatch m
+                          , MonadUnliftIO m
                           )
                        => WorkflowActionInfo FileReference UserId
                        -> WriterT (Maybe (Last (CryptoUUIDWorkflowStateIndex, Maybe WorkflowGraphNodeLabel, Maybe JsonWorkflowUser, UTCTime, Map WorkflowPayloadLabel JsonWorkflowPayload))) (SqlPersistT m) ()
diff --git a/src/Handler/Workflow/Workflow/Workflow.hs b/src/Handler/Workflow/Workflow/Workflow.hs
index 430d8aa59..d5be3e0c9 100644
--- a/src/Handler/Workflow/Workflow/Workflow.hs
+++ b/src/Handler/Workflow/Workflow/Workflow.hs
@@ -107,6 +107,7 @@ workflowR rScope cID = do
                 ( MonadHandler m
                 , HandlerSite m ~ UniWorX
                 , MonadCatch m
+                , MonadUnliftIO m
                 )
              => WorkflowActionInfo FileReference UserId
              -> RWST () (Maybe (Last WorkflowCurrentState), [WorkflowHistoryItem]) (Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW FileReference UserId))) (SqlPersistT m) ()
diff --git a/src/Jobs/Handler/SendNotification/Allocation.hs b/src/Jobs/Handler/SendNotification/Allocation.hs
index 8002e66b2..788c62086 100644
--- a/src/Jobs/Handler/SendNotification/Allocation.hs
+++ b/src/Jobs/Handler/SendNotification/Allocation.hs
@@ -196,7 +196,7 @@ dispatchNotificationAllocationNewCourse nAllocation nCourse jRecipient = userMai
   editNotifications <- mkEditNotifications jRecipient
 
   cID <- encrypt nCourse
-  mayApply <- orM
+  mayApply <- lift $ orM
     [ is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand ARegisterR) True
     , is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand $ AApplyR cID) True
     ]
diff --git a/src/Model/Migration/Definitions.hs b/src/Model/Migration/Definitions.hs
index 2fe78d785..adf98575d 100644
--- a/src/Model/Migration/Definitions.hs
+++ b/src/Model/Migration/Definitions.hs
@@ -140,6 +140,8 @@ migrateManual = do
     , ("sent_mail_bounce_secret",             "CREATE INDEX sent_mail_bounce_secret ON \"sent_mail\" (bounce_secret) WHERE bounce_secret IS NOT NULL")
     , ("sent_mail_recipient",                 "CREATE INDEX sent_mail_recipient ON \"sent_mail\" (recipient) WHERE recipient IS NOT NULL")
     , ("study_features_relevance_cached",     "CREATE INDEX study_features_relevance_cached ON \"study_features\" (relevance_cached)")
+    , ("submission_rating_by",                "CREATE INDEX submission_rating_by ON submission (rating_by) WHERE rating_by IS NOT NULL"  )
+    , ("exam_corrector_user",                 "CREATE INDEX exam_corrector_user ON exam_corrector (\"user\")"                            )
     ]
   where
     addIndex :: Text -> Sql -> Migration
diff --git a/src/Model/Tokens/Bearer.hs b/src/Model/Tokens/Bearer.hs
index 3185729c4..09849ecb6 100644
--- a/src/Model/Tokens/Bearer.hs
+++ b/src/Model/Tokens/Bearer.hs
@@ -79,13 +79,12 @@ data BearerToken site = BearerToken
   , bearerStartsAt     :: Maybe UTCTime
   } deriving (Generic, Typeable)
 
-deriving instance (Eq (AuthId site), Eq (Route site)) => Eq (BearerToken site)
-deriving instance (Read (AuthId site), Eq (Route site), Hashable (Route site), Read (Route site), Hashable (AuthId site), Eq (AuthId site)) => Read (BearerToken site)
-deriving instance (Show (AuthId site), Show (Route site), Hashable (AuthId site)) => Show (BearerToken site)
-
-instance (Hashable (AuthId site), Hashable (Route site)) => Hashable (BearerToken site)
-
-instance (Binary (AuthId site), Binary (Route site), Hashable (Route site), Eq (Route site), Hashable (AuthId site), Eq (AuthId site)) => Binary (BearerToken site)
+deriving stock instance (Eq (AuthId site), Eq (Route site)) => Eq (BearerToken site)
+deriving stock instance (Ord (AuthId site), Ord (Route site)) => Ord (BearerToken site)
+deriving stock instance (Read (AuthId site), Eq (Route site), Hashable (Route site), Read (Route site), Hashable (AuthId site), Eq (AuthId site)) => Read (BearerToken site)
+deriving stock instance (Show (AuthId site), Show (Route site), Hashable (AuthId site)) => Show (BearerToken site)
+deriving anyclass instance (Hashable (AuthId site), Hashable (Route site)) => Hashable (BearerToken site)
+deriving anyclass instance (Binary (AuthId site), Binary (Route site), Hashable (Route site), Eq (Route site), Hashable (AuthId site), Eq (AuthId site)) => Binary (BearerToken site)
 
 makeLenses_ ''BearerToken
 instance HasTokenIdentifier (BearerToken site) TokenId where
diff --git a/src/Model/Types/School.hs b/src/Model/Types/School.hs
index ef695831f..1e4a2d024 100644
--- a/src/Model/Types/School.hs
+++ b/src/Model/Types/School.hs
@@ -19,3 +19,4 @@ nullaryPathPiece ''SchoolFunction $ camelToPathPiece' 1
 pathPieceJSON ''SchoolFunction
 pathPieceJSONKey ''SchoolFunction
 derivePersistFieldPathPiece ''SchoolFunction
+pathPieceBinary ''SchoolFunction
diff --git a/src/Model/Types/User.hs b/src/Model/Types/User.hs
index 73745bddb..6e1b966a4 100644
--- a/src/Model/Types/User.hs
+++ b/src/Model/Types/User.hs
@@ -15,3 +15,4 @@ nullaryPathPiece ''SystemFunction $ camelToPathPiece' 1
 pathPieceJSON ''SystemFunction
 pathPieceJSONKey ''SystemFunction
 derivePersistFieldPathPiece ''SystemFunction
+pathPieceBinary ''SystemFunction
diff --git a/src/Utils/Metrics.hs b/src/Utils/Metrics.hs
index 9bc78cdd5..bba95d7b8 100644
--- a/src/Utils/Metrics.hs
+++ b/src/Utils/Metrics.hs
@@ -24,6 +24,7 @@ module Utils.Metrics
   , poolMetrics
   , observeDatabaseConnectionOpened, observeDatabaseConnectionClosed
   , onUseDBConn, onReleaseDBConn, DBConnUseState, DBConnLabel
+  , AuthTagEvalOutcome(..), observeAuthTagEvaluation
   ) where
 
 import Import.NoModel hiding (Vector, Info)
@@ -416,6 +417,19 @@ onReleaseDBConn DBConnUseState{..} _ = liftIO $ do
         [] -> "unlabeled"
         (_, SrcLoc{..}) : _ -> pack srcLocModule
   withLabel databaseConnDuration lbl $ flip observe diff
+
+data AuthTagEvalOutcome = OutcomeAuthorized | OutcomeUnauthorized | OutcomeAuthenticationRequired | OutcomeException
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+  deriving (Universe, Finite)
+nullaryPathPiece ''AuthTagEvalOutcome $ camelToPathPiece' 1
+
+{-# NOINLINE authTagEvaluationDuration #-}
+authTagEvaluationDuration :: Vector Label2 Histogram
+authTagEvaluationDuration = unsafeRegister . vector ("tag", "outcome") $ histogram info buckets
+  where
+    info = Info "uni2work_auth_tag_evaluation_duration_seconds"
+                "Duration of auth tag evaluations"
+    buckets = histogramBuckets 50e-6 1
     
 
 withHealthReportMetrics :: MonadIO m => m HealthReport -> m HealthReport
@@ -564,3 +578,17 @@ observeMissingFiles refIdent = liftIO . withLabel missingFiles refIdent . flip s
 observeDatabaseConnectionOpened, observeDatabaseConnectionClosed :: MonadIO m => m ()
 observeDatabaseConnectionOpened = liftIO $ incCounter databaseConnectionsOpened
 observeDatabaseConnectionClosed = liftIO $ incCounter databaseConnectionsClosed
+
+observeAuthTagEvaluation :: MonadUnliftIO m => AuthTag -> m (a, AuthTagEvalOutcome) -> m a
+observeAuthTagEvaluation aTag act = do
+  start <- liftIO $ getTime Monotonic
+  res <- tryAny act
+  end <- liftIO $ getTime Monotonic
+
+  let outcome = case res of
+        Right (_, outcome') -> outcome'
+        Left _ -> OutcomeException
+  
+  liftIO . withLabel authTagEvaluationDuration (toPathPiece aTag, toPathPiece outcome) . flip observe . realToFrac $ end - start
+
+  either throwIO (views _1 return) res