diff --git a/src/Foundation.hs b/src/Foundation.hs
index 0d8e5d909..0aca60110 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -60,7 +60,7 @@ import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Trans.Reader (runReader, mapReaderT)
 import Control.Monad.Trans.Writer (WriterT(..), runWriterT)
 import Control.Monad.Writer.Class (MonadWriter(..))
-import Control.Monad.Memo (MemoT, startEvalMemoT, MonadMemo(..))
+import Control.Monad.Memo.Class (MonadMemo(..), for4)
 import qualified Control.Monad.Catch as C
 
 import Handler.Utils.StudyFeatures
@@ -137,6 +137,8 @@ type SMTPPool = Pool SMTPConnection
 -- type Widget    = WidgetT  UniWorX IO ()
 mkYesodData "UniWorX" $(parseRoutesFile "routes")
 
+deriving instance Generic (Route UniWorX)
+
 -- | Convenient Type Synonyms:
 type DB a = YesodDB UniWorX a
 type Form x = Html -> MForm (HandlerT UniWorX IO) (FormResult x, Widget)
@@ -385,24 +387,24 @@ appLanguagesOpts = do
 
 -- Access Control
 data AccessPredicate
-  = APPure     (Route UniWorX -> Bool -> Reader MsgRenderer AuthResult)
-  | APHandler  (Route UniWorX -> Bool -> Handler AuthResult)
-  | APDB       (Route UniWorX -> Bool -> DB AuthResult)
+  = APPure     (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> Reader MsgRenderer AuthResult)
+  | APHandler  (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> Handler AuthResult)
+  | APDB       (Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> DB AuthResult)
 
 class (MonadHandler m, HandlerSite m ~ UniWorX) => MonadAP m where
-  evalAccessPred :: AccessPredicate -> Route UniWorX -> Bool -> m AuthResult
+  evalAccessPred :: AccessPredicate -> Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> m AuthResult
 
 instance {-# INCOHERENT #-} (MonadHandler m, HandlerSite m ~ UniWorX) => MonadAP m where
-  evalAccessPred aPred r w = liftHandlerT $ case aPred of
-    (APPure    p) -> runReader (p r w) <$> getMsgRenderer
-    (APHandler p) -> p r w
-    (APDB      p) -> runDB $ p r w
+  evalAccessPred aPred aid r w = liftHandlerT $ case aPred of
+    (APPure    p) -> runReader (p aid r w) <$> getMsgRenderer
+    (APHandler p) -> p aid r w
+    (APDB      p) -> runDB $ p aid r w
 
 instance (MonadHandler m, HandlerSite m ~ UniWorX, backend ~ YesodPersistBackend UniWorX) => MonadAP (ReaderT backend m) where
-  evalAccessPred aPred r w = mapReaderT liftHandlerT $ case aPred of
-    (APPure    p) -> lift $ runReader (p r w) <$> getMsgRenderer
-    (APHandler p) -> lift $ p r w
-    (APDB      p) -> p r w
+  evalAccessPred aPred aid r w = mapReaderT liftHandlerT $ case aPred of
+    (APPure    p) -> lift $ runReader (p aid r w) <$> getMsgRenderer
+    (APHandler p) -> lift $ p aid r w
+    (APDB      p) -> p aid r w
 
 
 orAR, andAR :: MsgRenderer -> AuthResult -> AuthResult -> AuthResult
@@ -423,16 +425,16 @@ trueAR = const Authorized
 falseAR = Unauthorized . ($ MsgUnauthorized) . render
 
 trueAP, falseAP :: AccessPredicate
-trueAP  = APPure . const . const $ trueAR <$> ask
-falseAP = APPure . const . const $ falseAR <$> ask -- included for completeness
+trueAP  = APPure . const . const . const $ trueAR <$> ask
+falseAP = APPure . const . const . const $ falseAR <$> ask -- included for completeness
 
 
 tagAccessPredicate :: AuthTag -> AccessPredicate
 tagAccessPredicate AuthFree = trueAP
-tagAccessPredicate AuthAdmin = APDB $ \route _ -> case route of
+tagAccessPredicate AuthAdmin = APDB $ \mAuthId route _ -> case route of
   -- Courses: access only to school admins
   CourseR tid ssh csh _ -> exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
     [E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` userAdmin) -> do
       E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserAdminSchool
       E.where_  $ userAdmin E.^. UserAdminUser E.==. E.val authId
@@ -444,13 +446,13 @@ tagAccessPredicate AuthAdmin = APDB $ \route _ -> case route of
     return Authorized
   -- other routes: access to any admin is granted here
   _other -> exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
     adrights <- lift $ selectFirst [UserAdminUser ==. authId] []
     guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedSiteAdmin)
     return Authorized
-tagAccessPredicate AuthNoEscalation = APDB $ \route _ -> case route of
+tagAccessPredicate AuthNoEscalation = APDB $ \mAuthId route _ -> case route of
   AdminHijackUserR cID -> exceptT return return $ do
-    myUid <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
+    myUid <- maybeExceptT AuthenticationRequired $ return mAuthId
     uid <- decrypt cID
     otherSchoolsAdmin <- lift $ Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. uid] []
     otherSchoolsLecturer <- lift $ Set.fromList . map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] []
@@ -458,21 +460,21 @@ tagAccessPredicate AuthNoEscalation = APDB $ \route _ -> case route of
     guardMExceptT ((otherSchoolsAdmin `Set.union` otherSchoolsLecturer) `Set.isSubsetOf` mySchools) (unauthorizedI MsgUnauthorizedAdminEscalation)
     return Authorized
   r -> $unsupportedAuthPredicate AuthNoEscalation r
-tagAccessPredicate AuthDeprecated = APHandler $ \r _ -> do
+tagAccessPredicate AuthDeprecated = APHandler $ \_ r _ -> do
   $logWarnS "AccessControl" ("deprecated route: " <> tshow r)
   addMessageI Error MsgDeprecatedRoute
   allow <- appAllowDeprecated . appSettings <$> getYesod
   return $ bool (Unauthorized "Deprecated Route") Authorized allow
-tagAccessPredicate AuthDevelopment = APHandler $ \r _ -> do
+tagAccessPredicate AuthDevelopment = APHandler $ \_ r _ -> do
   $logWarnS "AccessControl" ("route in development: " <> tshow r)
 #ifdef DEVELOPMENT
   return Authorized
 #else
   return $ Unauthorized "Route under development"
 #endif
-tagAccessPredicate AuthLecturer = APDB $ \route _ -> case route of
+tagAccessPredicate AuthLecturer = APDB $ \mAuthId route _ -> case route of
   CourseR tid ssh csh _ -> exceptT return return $ do
-     authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
+     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
      [E.Value c] <- lift . E.select . 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
@@ -484,11 +486,11 @@ tagAccessPredicate AuthLecturer = APDB $ \route _ -> case route of
      return Authorized
   -- lecturer for any school will do
   _ -> exceptT return return $ do
-     authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
+     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
      void . maybeMExceptT (unauthorizedI MsgUnauthorizedSchoolLecturer) $ selectFirst [UserLecturerUser ==. authId] []
      return Authorized
-tagAccessPredicate AuthCorrector = APDB $ \route _ -> exceptT return return $ do
-  authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
+tagAccessPredicate AuthCorrector = APDB $ \mAuthId route _ -> exceptT return return $ do
+  authId <- maybeExceptT AuthenticationRequired $ return mAuthId
   resList <- 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
@@ -515,7 +517,7 @@ tagAccessPredicate AuthCorrector = APDB $ \route _ -> exceptT return return $ do
     _ -> do
       guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedCorrectorAny)
       return Authorized
-tagAccessPredicate AuthTime = APDB $ \route _ -> case route of
+tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
   CSheetR tid ssh csh shn subRoute -> maybeT (unauthorizedI MsgUnauthorizedSheetTime) $ do
     Entity cid _ <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
     Entity _sid Sheet{..} <- MaybeT . getBy $ CourseSheet cid shn
@@ -541,8 +543,7 @@ tagAccessPredicate AuthTime = APDB $ \route _ -> case route of
   CourseR tid ssh csh CRegisterR -> do
     now <- liftIO getCurrentTime
     mbc <- getBy $ TermSchoolCourseShort tid ssh csh
-    mAid <- lift maybeAuthId
-    registered <- case (mbc,mAid) of
+    registered <- case (mbc,mAuthId) of
       (Just (Entity cid _), Just uid) -> isJust <$> (getBy $ UniqueParticipant uid cid)
       _ -> return False
     case mbc of
@@ -564,9 +565,9 @@ tagAccessPredicate AuthTime = APDB $ \route _ -> case route of
     return Authorized
 
   r -> $unsupportedAuthPredicate AuthTime r
-tagAccessPredicate AuthRegistered = APDB $ \route _ -> case route of
+tagAccessPredicate AuthRegistered = APDB $ \mAuthId route _ -> case route of
   CourseR tid ssh csh _ -> exceptT return return $ do
-    authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
     [E.Value c] <- lift . E.select . 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
@@ -577,7 +578,7 @@ tagAccessPredicate AuthRegistered = APDB $ \route _ -> case route of
     guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
     return Authorized
   r -> $unsupportedAuthPredicate AuthRegistered r
-tagAccessPredicate AuthParticipant = APDB $ \route _ -> case route of
+tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
   CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do
     let authorizedIfExists f = do
           [E.Value ok] <- lift . E.select . return . E.exists $ E.from f
@@ -639,14 +640,14 @@ tagAccessPredicate AuthParticipant = APDB $ \route _ -> case route of
            E.&&. course E.^. CourseShorthand E.==. E.val csh
     unauthorizedI MsgUnauthorizedParticipant
   r -> $unsupportedAuthPredicate AuthParticipant r
-tagAccessPredicate AuthCapacity = APDB $ \route _ -> case route of
+tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of
   CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do
     Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
     registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
     guard $ NTop courseCapacity > NTop (Just registered)
     return Authorized
   r -> $unsupportedAuthPredicate AuthCapacity r
-tagAccessPredicate AuthEmpty = APDB $ \route _ -> case route of
+tagAccessPredicate AuthEmpty = APDB $ \_ route _ -> case route of
   CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNotEmpty) $ do
     -- Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
     cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
@@ -657,50 +658,50 @@ tagAccessPredicate AuthEmpty = APDB $ \route _ -> case route of
       return E.countRows
     return Authorized
   r -> $unsupportedAuthPredicate AuthEmpty r
-tagAccessPredicate AuthMaterials = APDB $ \route _ -> case route of
+tagAccessPredicate AuthMaterials = APDB $ \_ route _ -> case route of
   CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnfreeMaterials) $ do
     Entity _ Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
     guard courseMaterialFree
     return Authorized
   r -> $unsupportedAuthPredicate AuthMaterials r
-tagAccessPredicate AuthOwner = APDB $ \route _ -> case route of
+tagAccessPredicate AuthOwner = APDB $ \mAuthId route _ -> case route of
   CSubmissionR _ _ _ _ cID _ -> exceptT return return $ do
     sid <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSubmissionOwner) (const True :: CryptoIDError -> Bool) $ decrypt cID
-    authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
     void . maybeMExceptT (unauthorizedI MsgUnauthorizedSubmissionOwner) . getBy $ UniqueSubmissionUser authId sid
     return Authorized
   r -> $unsupportedAuthPredicate AuthOwner r
-tagAccessPredicate AuthRated = APDB $ \route _ -> case route of
+tagAccessPredicate AuthRated = APDB $ \_ route _ -> case route of
   CSubmissionR _ _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedSubmissionRated) $ do
     sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
     sub <- MaybeT $ get sid
     guard $ submissionRatingDone sub
     return Authorized
   r -> $unsupportedAuthPredicate AuthRated r
-tagAccessPredicate AuthUserSubmissions = APDB $ \route _ -> case route of
+tagAccessPredicate AuthUserSubmissions = APDB $ \_ route _ -> case route of
   CSheetR tid ssh csh shn _ -> maybeT (unauthorizedI MsgUnauthorizedUserSubmission) $ do
     Entity cid _ <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
     Entity _ Sheet{sheetSubmissionMode} <- MaybeT . getBy $ CourseSheet cid shn
     guard $ sheetSubmissionMode == UserSubmissions
     return Authorized
   r -> $unsupportedAuthPredicate AuthUserSubmissions r
-tagAccessPredicate AuthCorrectorSubmissions = APDB $ \route _ -> case route of
+tagAccessPredicate AuthCorrectorSubmissions = APDB $ \_ route _ -> case route of
   CSheetR tid ssh csh shn _ -> maybeT (unauthorizedI MsgUnauthorizedCorrectorSubmission) $ do
     Entity cid _ <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
     Entity _ Sheet{sheetSubmissionMode} <- MaybeT . getBy $ CourseSheet cid shn
     guard $ sheetSubmissionMode == CorrectorSubmissions
     return Authorized
   r -> $unsupportedAuthPredicate AuthCorrectorSubmissions r
-tagAccessPredicate AuthAuthentication = APDB $ \route _ -> case route of
+tagAccessPredicate AuthAuthentication = APDB $ \mAuthId route _ -> case route of
   MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageAuth) $ do
     smId <- decrypt cID
     SystemMessage{..} <- MaybeT $ get smId
-    isAuthenticated <- isJust <$> liftHandlerT maybeAuthId
+    let isAuthenticated = isJust mAuthId
     guard $ not systemMessageAuthenticatedOnly || isAuthenticated
     return Authorized
   r -> $unsupportedAuthPredicate AuthAuthentication r
-tagAccessPredicate AuthRead = APHandler . const $ bool (return Authorized) (unauthorizedI MsgUnauthorizedWrite)
-tagAccessPredicate AuthWrite = APHandler . const $ bool (unauthorizedI MsgUnauthorized) (return Authorized)
+tagAccessPredicate AuthRead = APHandler . const . const $ bool (return Authorized) (unauthorizedI MsgUnauthorizedWrite)
+tagAccessPredicate AuthWrite = APHandler . const . const $ bool (unauthorizedI MsgUnauthorized) (return Authorized)
 
 
 newtype InvalidAuthTag = InvalidAuthTag Text
@@ -734,25 +735,29 @@ routeAuthTags = fmap (impureNonNull . Set.mapMonotonic impureNonNull) . ofoldM p
       | otherwise
         = Left $ InvalidAuthTag t
 
-evalAuthTags :: forall m. (MonadAP m, MonadLogger m) => AuthTagActive -> NonNull (DNF AuthTag) -> Route UniWorX -> Bool -> WriterT (Set AuthTag) m AuthResult
+evalAuthTags :: forall m. (MonadAP m, MonadLogger m) => AuthTagActive -> NonNull (DNF AuthTag) -> Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> WriterT (Set AuthTag) m AuthResult
 -- ^ `tell`s disabled predicates, identified as pivots
-evalAuthTags AuthTagActive{..} (map (Set.toList . toNullable) . Set.toList . toNullable -> authDNF) route isWrite
-  = startEvalMemoT $ do
-      mr <- lift getMsgRenderer
+evalAuthTags AuthTagActive{..} (map (Set.toList . toNullable) . Set.toList . toNullable -> authDNF) mAuthId route isWrite
+  = do
+      mr <- getMsgRenderer
       let
         authTagIsInactive = not . authTagIsActive
 
-        evalAuthTag :: AuthTag -> MemoT AuthTag AuthResult (WriterT (Set AuthTag) m) AuthResult
-        evalAuthTag = memo $ \authTag -> lift . lift $ evalAccessPred (tagAccessPredicate authTag) route isWrite
+        evalAuthTag :: AuthTag -> WriterT (Set AuthTag) m AuthResult
+        evalAuthTag authTag = lift . (runCachedMemoT :: CachedMemoT (AuthTag, Maybe UserId, Route UniWorX, Bool) AuthResult m _ -> m _) $ for4 memo evalAccessPred' authTag mAuthId route isWrite
+          where
+            evalAccessPred' authTag' mAuthId' route' isWrite' = CachedMemoT $ do
+              $logDebugS "evalAccessPred" $ tshow (authTag', mAuthId', route', isWrite')
+              evalAccessPred (tagAccessPredicate authTag') mAuthId' route' isWrite'
 
         orAR', andAR' :: forall m'. Monad m' => m' AuthResult -> m' AuthResult -> m' AuthResult
         orAR' = shortCircuitM (is _Authorized) (orAR mr)
         andAR' = shortCircuitM (is _Unauthorized) (andAR mr)
 
-        evalDNF :: [[AuthTag]] -> MemoT AuthTag AuthResult (WriterT (Set AuthTag) m) AuthResult
+        evalDNF :: [[AuthTag]] -> WriterT (Set AuthTag) m AuthResult
         evalDNF = foldr (\ats ar -> ar `orAR'` foldr (\aTag ar' -> ar' `andAR'` evalAuthTag aTag) (return $ trueAR mr) ats) (return $ falseAR mr)
 
-      lift . $logDebugS "evalAuthTags" . tshow . (route, isWrite, )$ map (map $ id &&& authTagIsActive) authDNF
+      $logDebugS "evalAuthTags" . tshow . (route, isWrite, )$ map (map $ id &&& authTagIsActive) authDNF
 
       result <- evalDNF $ filter (all authTagIsActive) authDNF
 
@@ -760,16 +765,25 @@ evalAuthTags AuthTagActive{..} (map (Set.toList . toNullable) . Set.toList . toN
         whenM (allM conj (\aTag -> (return . not $ authTagIsActive aTag) `or2M` (not . is _Unauthorized <$> evalAuthTag aTag))) $ do
           let pivots = filter authTagIsInactive conj
           whenM (allM pivots $ fmap (is _Authorized) . evalAuthTag) $ do
-            lift $ $logDebugS "evalAuthTags" [st|Recording pivots: #{tshow pivots}|]
-            lift . tell $ Set.fromList pivots
+            $logDebugS "evalAuthTags" [st|Recording pivots: #{tshow pivots}|]
+            tell $ Set.fromList pivots
 
       return result
 
+evalAccessFor :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> m AuthResult
+evalAccessFor mAuthId route isWrite = do
+  dnf <- either throwM return $ routeAuthTags route
+  fmap fst . runWriterT $ evalAuthTags (AuthTagActive $ const True) dnf mAuthId route isWrite
+
+evalAccessForDB :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> ReaderT (YesodPersistBackend UniWorX) m AuthResult
+evalAccessForDB = evalAccessFor
+
 evalAccess :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> Bool -> m AuthResult
 evalAccess route isWrite = do
+  mAuthId <- liftHandlerT maybeAuthId
   tagActive <- fromMaybe def <$> lookupSessionJson SessionActiveAuthTags
   dnf <- either throwM return $ routeAuthTags route
-  (result, deactivated) <- runWriterT $ evalAuthTags tagActive dnf route isWrite
+  (result, deactivated) <- runWriterT $ evalAuthTags tagActive dnf mAuthId route isWrite
   result <$ tellSessionJson SessionInactiveAuthTags deactivated
 
 evalAccessDB :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> Bool -> ReaderT (YesodPersistBackend UniWorX) m AuthResult
diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs
index 457682087..21e0b5de5 100644
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@@ -17,7 +17,7 @@ import Yesod.Default.Config2  as Import
 import Utils                  as Import
 import Utils.Modal            as Import
 import Yesod.Core.Json        as Import (provideJson)
-import Yesod.Core.Types.Instances as Import ()
+import Yesod.Core.Types.Instances as Import (CachedMemoT(..))
 
 
 import Data.Fixed             as Import
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index 775900850..7cf317d0c 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -749,6 +749,8 @@ instance ToJSONKey AuthTag where
 instance FromJSONKey AuthTag where
   fromJSONKey = FromJSONKeyTextParser $ parseJSON . Aeson.String
 
+instance Binary AuthTag
+
 
 newtype AuthTagActive = AuthTagActive { authTagIsActive :: AuthTag -> Bool }
   deriving (Read, Show, Generic)
diff --git a/src/Yesod/Core/Instances.hs b/src/Yesod/Core/Instances.hs
index 6512c936a..b8c6fed80 100644
--- a/src/Yesod/Core/Instances.hs
+++ b/src/Yesod/Core/Instances.hs
@@ -15,37 +15,58 @@ import Data.ByteString.Builder (toLazyByteString)
 import System.FilePath ((</>))
 
 import Data.Aeson
+import Data.Aeson.Types
 
 import Control.Monad.Fix
 import Control.Monad.Fail (MonadFail)
 import qualified Control.Monad.Fail as MonadFail
 import Control.Monad.Except (MonadError(..))
 import Data.Functor.Extend
-  
+
+import Data.Binary (Binary)
+import qualified Data.Binary as Binary
+
+
+routeFromPathPiece :: ParseRoute site => Text -> Maybe (Route site)
+routeFromPathPiece
+  = parseRoute
+  . over (_2.traverse._2) (fromMaybe "")
+  . over _2 queryToQueryText
+  . decodePath
+  . encodeUtf8
+
+routeToPathPiece :: RenderRoute site => Route site -> Text
+routeToPathPiece
+  = pack
+  . ("/" </>)
+  . unpack
+  . decodeUtf8
+  . toLazyByteString
+  . uncurry encodePath
+  . over _2 queryTextToQuery
+  . over (_2.traverse._2) (assertM' $ not . null)
+  . renderRoute
+
 
 instance (RenderRoute site, ParseRoute site) => PathPiece (Route site) where
-  fromPathPiece
-    = parseRoute
-    . over (_2.traverse._2) (fromMaybe "")
-    . over _2 queryToQueryText
-    . decodePath
-    . encodeUtf8
-  toPathPiece
-    = pack
-    . ("/" </>)
-    . unpack
-    . decodeUtf8
-    . toLazyByteString
-    . uncurry encodePath
-    . over _2 queryTextToQuery
-    . over (_2.traverse._2) (assertM' $ not . null)
-    . renderRoute
+  fromPathPiece = routeFromPathPiece
+  toPathPiece = routeToPathPiece
     
-instance (RenderRoute site, ParseRoute site) => FromJSON (Route site) where
-  parseJSON = withText "Route" $ maybe (fail "Could not parse route") return . fromPathPiece
+instance ParseRoute site => FromJSON (Route site) where
+  parseJSON = withText "Route" $ maybe (fail "Could not parse route") return . routeFromPathPiece
 
-instance (RenderRoute site, ParseRoute site) => ToJSON (Route site) where
-  toJSON = String . toPathPiece
+instance RenderRoute site => ToJSON (Route site) where
+  toJSON = String . routeToPathPiece
+
+instance ParseRoute site => FromJSONKey (Route site) where
+  fromJSONKey = FromJSONKeyTextParser $ maybe (fail "Coulde not parse route") return . routeFromPathPiece
+
+instance RenderRoute site => ToJSONKey (Route site) where
+  toJSONKey = toJSONKeyText routeToPathPiece
+
+instance (RenderRoute site, ParseRoute site) => Binary (Route site) where
+  put = Binary.put . toPathPiece
+  get = Binary.get >>= maybe (fail "Could not parse route") return . fromPathPiece
 
 
 instance Monad FormResult where
@@ -77,3 +98,5 @@ instance Extend FormResult where
   duplicated (FormSuccess x)    = FormSuccess $ FormSuccess x
   duplicated  FormMissing       = FormMissing
   duplicated (FormFailure errs) = FormFailure errs
+
+
diff --git a/src/Yesod/Core/Types/Instances.hs b/src/Yesod/Core/Types/Instances.hs
index e296d0c52..5402ce3ba 100644
--- a/src/Yesod/Core/Types/Instances.hs
+++ b/src/Yesod/Core/Types/Instances.hs
@@ -1,16 +1,48 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-}
 
 module Yesod.Core.Types.Instances
-  (
+  ( CachedMemoT(..)
   ) where
 
-import ClassyPrelude
+import ClassyPrelude.Yesod
 import Yesod.Core.Types
 
 import Control.Monad.Fix
 
+import Control.Monad.Memo
+
+import Data.Binary (Binary)
+import qualified Data.Binary as Binary
+
+import Control.Monad.Logger (MonadLoggerIO)
+  
+
 instance MonadFix m => MonadFix (HandlerT site m) where
   mfix f = HandlerT $ \r -> mfix $ \a -> unHandlerT (f a) r
   
 instance MonadFix m => MonadFix (WidgetT site m) where
   mfix f = WidgetT $ \r -> mfix $ \ ~(a, _) -> unWidgetT (f a) r
+
+
+-- | Type-level tags for compatability of Yesod `cached`-System with `MonadMemo`
+newtype CachedMemoT k v m a = CachedMemoT { runCachedMemoT :: m a }
+  deriving newtype ( Functor, Applicative, Alternative, Monad, MonadPlus, MonadFix
+                   , MonadIO
+                   , MonadThrow, MonadCatch, MonadMask, MonadLogger, MonadLoggerIO
+                   , MonadResource, MonadHandler, MonadWidget
+                   , IsString, Semigroup, Monoid
+                   )
+
+deriving newtype instance MonadBase b m => MonadBase b (CachedMemoT k v m)
+deriving newtype instance MonadBaseControl b m => MonadBaseControl b (CachedMemoT k v m)
+
+deriving newtype instance MonadReader r m => MonadReader r (CachedMemoT k v m)
+
+instance MonadTrans (CachedMemoT k v) where
+  lift = CachedMemoT
+
+
+-- | Uses `cachedBy` with a `Binary`-encoded @k@
+instance (Typeable v, Binary k, MonadHandler m) => MonadMemo k v (CachedMemoT k v m) where
+  memo act key = cachedBy (toStrict $ Binary.encode key) $ act key
diff --git a/start.sh b/start.sh
index b72d043c2..cdad4b731 100755
--- a/start.sh
+++ b/start.sh
@@ -1,12 +1,11 @@
 #!/usr/bin/env bash
 
 unset HOST
-export DETAILED_LOGGING=true
-export LOG_ALL=false
-export LOGLEVEL=info
-export DUMMY_LOGIN=true
-export ALLOW_DEPRECATED=true
-export PWFILE=users.yml
+export DETAILED_LOGGING=${DETAILED_LOGGIN:-true}
+export LOG_ALL=${LOG_ALL:-false}
+export LOGLEVEL=${LOGLEVEL:-info}
+export DUMMY_LOGIN=${DUMMY_LOGIN:-true}
+export ALLOW_DEPRECATED=${ALLOW_DEPRECATED:-true}
 
 move-back() {
     mv -v .stack-work .stack-work-run