Add WaiSubsiteWithAuth

yesod-core/Yesod/Core/Class/Dispatch.hs

@@ -10,7 +10,7 @@ import Yesod.Routes.Class
 import qualified Network.Wai as W
 import Yesod.Core.Types
 import Yesod.Core.Content
-import Yesod.Core.Handler (stripHandlerT)
+import Yesod.Core.Handler (sendWaiApplication, stripHandlerT)
 import Yesod.Core.Class.Yesod
 import Yesod.Core.Class.Handler
 
@@ -28,6 +28,15 @@ instance YesodSubDispatch WaiSubsite master where
       where
         WaiSubsite app = ysreGetSub $ yreSite ysreParentEnv
 
+instance YesodSubDispatch WaiSubsiteWithAuth (HandlerT master IO) where
+  yesodSubDispatch YesodSubRunnerEnv {..} req =
+      ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) req
+    where
+      base  = stripHandlerT handlert ysreGetSub ysreToParentRoute route
+      route = Just $ WaiSubsiteWithAuthRoute (W.pathInfo req) []
+      WaiSubsiteWithAuth set = ysreGetSub $ yreSite $ ysreParentEnv
+      handlert = sendWaiApplication $ set
+
 -- | A helper function for creating YesodSubDispatch instances, used by the
 -- internal generated code. This function has been exported since 1.4.11.
 -- It promotes a subsite handler to a wai application.

yesod-core/Yesod/Core/Dispatch.hs

@@ -34,6 +34,7 @@ module Yesod.Core.Dispatch
     , defaultMiddlewaresNoLogging
       -- * WAI subsites
     , WaiSubsite (..)
+    , WaiSubsiteWithAuth (..)
     , subHelper
     ) where
 

yesod-core/Yesod/Core/Types.hs

@@ -178,6 +178,8 @@ type Texts = [Text]
 -- | Wrap up a normal WAI application as a Yesod subsite.
 newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
 
+newtype WaiSubsiteWithAuth = WaiSubsiteWithAuth { runWaiSubsiteWithAuth :: W.Application }
+
 data RunHandlerEnv site = RunHandlerEnv
     { rheRender   :: !(Route site -> [(Text, Text)] -> Text)
     , rheRoute    :: !(Maybe (Route site))
@@ -560,6 +562,14 @@ instance RenderRoute WaiSubsite where
 instance ParseRoute WaiSubsite where
     parseRoute (x, y) = Just $ WaiSubsiteRoute x y
 
+instance RenderRoute WaiSubsiteWithAuth where
+  data Route WaiSubsiteWithAuth = WaiSubsiteWithAuthRoute [Text] [(Text,Text)]
+       deriving (Show, Eq, Read, Ord)
+  renderRoute (WaiSubsiteWithAuthRoute ps qs) = (ps,qs)
+
+instance ParseRoute WaiSubsiteWithAuth where
+  parseRoute (x, y) = Just $ WaiSubsiteWithAuthRoute x y
+
 data Logger = Logger
     { loggerSet :: !LoggerSet
     , loggerDate :: !DateCacheGetter