diff --git a/yesod-core/Yesod/Core/Class/Dispatch.hs b/yesod-core/Yesod/Core/Class/Dispatch.hs index 7f52b9fb..b68340ea 100644 --- a/yesod-core/Yesod/Core/Class/Dispatch.hs +++ b/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. diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs index 17674268..d13a154d 100644 --- a/yesod-core/Yesod/Core/Dispatch.hs +++ b/yesod-core/Yesod/Core/Dispatch.hs @@ -34,6 +34,7 @@ module Yesod.Core.Dispatch , defaultMiddlewaresNoLogging -- * WAI subsites , WaiSubsite (..) + , WaiSubsiteWithAuth (..) , subHelper ) where diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs index fa86a6f5..38194b4f 100644 --- a/yesod-core/Yesod/Core/Types.hs +++ b/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