Add WaiSubsiteWithAuth

yesod-core/ChangeLog.md

@@ -1,3 +1,7 @@
+## 1.4.34
+
+* Add `WaiSubsiteWithAuth`. [#1394](https://github.com/yesodweb/yesod/pull/1394)
+
 ## 1.4.33
 
 * Adds curly brackets to route parser. [#1363](https://github.com/yesodweb/yesod/pull/1363)

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

@@ -175,9 +175,14 @@ type BottomOfHeadAsync master
 
 type Texts = [Text]
 
--- | Wrap up a normal WAI application as a Yesod subsite.
+-- | Wrap up a normal WAI application as a Yesod subsite. Ignore parent site's middleware and isAuthorized.
 newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
 
+-- | Like 'WaiSubsite', but applies parent site's middleware and isAuthorized.
+-- 
+-- @since 1.4.34
+newtype WaiSubsiteWithAuth = WaiSubsiteWithAuth { runWaiSubsiteWithAuth :: W.Application }
+
 data RunHandlerEnv site = RunHandlerEnv
     { rheRender   :: !(Route site -> [(Text, Text)] -> Text)
     , rheRoute    :: !(Maybe (Route site))
@@ -560,6 +565,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

yesod-core/yesod-core.cabal

@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.4.33
+version:         1.4.34
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>