diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 45793963..0a5ed49e 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-core +## 1.6.20.1 + +* Throw an error in `breadcrumbs` if the trail of breadcrumbs is circular. [#1727](https://github.com/yesodweb/yesod/issues/1727) + ## 1.6.20 * Generate CSRF tokens using a secure entropy source [#1726](https://github.com/yesodweb/yesod/pull/1726) diff --git a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs index 1e956ff2..9773af1d 100644 --- a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs +++ b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} module Yesod.Core.Class.Breadcrumbs where import Yesod.Core.Handler @@ -15,7 +16,7 @@ class YesodBreadcrumbs site where -- | Gets the title of the current page and the hierarchy of parent pages, -- along with their respective titles. -breadcrumbs :: YesodBreadcrumbs site => HandlerFor site (Text, [(Route site, Text)]) +breadcrumbs :: (YesodBreadcrumbs site, Show (Route site), Eq (Route site)) => HandlerFor site (Text, [(Route site, Text)]) breadcrumbs = do x <- getCurrentRoute case x of @@ -26,6 +27,8 @@ breadcrumbs = do return (title, z) where go back Nothing = return back - go back (Just this) = do - (title, next) <- breadcrumb this - go ((this, title) : back) next + go back (Just this) + | this `elem` map fst back = error $ "yesod-core: infinite recursion in breadcrumbs at " ++ show this + | otherwise = do + (title, next) <- breadcrumb this + go ((this, title) : back) next diff --git a/yesod-core/test/YesodCoreTest.hs b/yesod-core/test/YesodCoreTest.hs index e9f42851..591f86a7 100644 --- a/yesod-core/test/YesodCoreTest.hs +++ b/yesod-core/test/YesodCoreTest.hs @@ -12,6 +12,7 @@ import YesodCoreTest.InternalRequest import YesodCoreTest.ErrorHandling import YesodCoreTest.Cache import YesodCoreTest.ParameterizedSite +import YesodCoreTest.Breadcrumb import qualified YesodCoreTest.WaiSubsite as WaiSubsite import qualified YesodCoreTest.Redirect as Redirect import qualified YesodCoreTest.JsLoader as JsLoader @@ -61,3 +62,4 @@ specs = do Ssl.sslOnlySpec Ssl.sameSiteSpec Csrf.csrfSpec + breadcrumbTest diff --git a/yesod-core/test/YesodCoreTest/Breadcrumb.hs b/yesod-core/test/YesodCoreTest/Breadcrumb.hs new file mode 100644 index 00000000..c64cfa25 --- /dev/null +++ b/yesod-core/test/YesodCoreTest/Breadcrumb.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module YesodCoreTest.Breadcrumb + ( breadcrumbTest, + ) +where + +import qualified Data.ByteString.Lazy.Char8 as L8 +import Data.Text (Text) +import Data.Typeable (Typeable) +import Network.Wai +import Network.Wai.Test +import Test.Hspec +import UnliftIO.IORef +import Yesod.Core + +data A = A + +mkYesod + "A" + [parseRoutes| +/ RootR GET +/loop LoopR GET +|] + +instance Yesod A + +instance YesodBreadcrumbs A where + breadcrumb r = case r of + RootR -> pure ("Root", Nothing) + LoopR -> pure ("Loop", Just LoopR) -- Purposefully a loop + +getRootR :: Handler Text +getRootR = fst <$> breadcrumbs + +getLoopR :: Handler Text +getLoopR = fst <$> breadcrumbs + +breadcrumbTest :: Spec +breadcrumbTest = + describe "Test.Breadcrumb" $ do + it "can fetch the root which contains breadcrumbs" $ + runner $ do + res <- request defaultRequest + assertStatus 200 res + it "gets a 500 for a route with a looping breadcrumb" $ + runner $ do + res <- request defaultRequest {pathInfo = ["loop"]} + assertStatus 500 res + +runner :: Session () -> IO () +runner f = toWaiApp A >>= runSession f diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 1c258f15..b22ade9d 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.20 +version: 1.6.20.1 license: MIT license-file: LICENSE author: Michael Snoyman