yesod-core 1.4.23.1 → 1.4.24

raw patch · 4 files changed

+47/−7 lines, 4 files

Files

• ChangeLog.md +4/−0
• Yesod/Core/Handler.hs +11/−6
• test/YesodCoreTest/Cache.hs +31/−0
• yesod-core.cabal +1/−1

@@ -1,3 +1,7 @@+## 1.4.24++* cached and cachedBy will not overwrite global state changes [#1268](https://github.com/yesodweb/yesod/pull/1268)+ ## 1.4.23.1  * Don't allow sending multiple cookies with the same name to the client, in accordance with [RFC 6265](https://tools.ietf.org/html/rfc6265). This fixes an issue where multiple CSRF tokens were sent to the client. [#1258](https://github.com/yesodweb/yesod/pull/1258)

@@ -214,6 +214,7 @@ import qualified Data.ByteString               as S import qualified Data.ByteString.Lazy          as L import qualified Data.Map                      as Map+import qualified Data.HashMap.Strict           as HM  import           Data.Byteable                 (constEqBytes) @@ -1002,12 +1003,14 @@        => m a        -> m a cached action = do-    gs <- get-    eres <- Cache.cached (ghsCache gs) action+    cache <- ghsCache <$> get+    eres <- Cache.cached cache action     case eres of       Right res -> return res       Left (newCache, res) -> do-          put $ gs { ghsCache = newCache }+          gs <- get+          let merged = newCache `HM.union` ghsCache gs+          put $ gs { ghsCache = merged }           return res  -- | a per-request cache. just like 'cached'.@@ -1022,12 +1025,14 @@ -- Since 1.4.0 cachedBy :: (MonadHandler m, Typeable a) => S.ByteString -> m a -> m a cachedBy k action = do-    gs <- get-    eres <- Cache.cachedBy (ghsCacheBy gs) k action+    cache <- ghsCacheBy <$> get+    eres <- Cache.cachedBy cache k action     case eres of       Right res -> return res       Left (newCache, res) -> do-          put $ gs { ghsCacheBy = newCache }+          gs <- get+          let merged = newCache `HM.union` ghsCacheBy gs+          put $ gs { ghsCacheBy = merged }           return res  -- | Get the list of supported languages supplied by the user.

@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Rank2Types #-} module YesodCoreTest.Cache (cacheTest, Widget) where  import Test.Hspec@@ -25,6 +26,8 @@ mkYesod "C" [parseRoutes| /    RootR GET /key KeyR GET+/nested NestedR GET+/nested-key NestedKeyR GET |]  instance Yesod C where@@ -55,6 +58,24 @@      return $ RepPlain $ toContent $ show [v1a, v1b, v2a, v2b, v3a, v3b] +getNestedR :: Handler RepPlain+getNestedR = getNested cached++getNestedKeyR :: Handler RepPlain+getNestedKeyR = getNested $ cachedBy "3"++-- | Issue #1266+getNested ::  (forall a. Typeable a => (Handler a -> Handler a)) -> Handler RepPlain+getNested cacheMethod = do+    ref <- newIORef 0+    let getV2 = atomicModifyIORef ref $ \i -> (i + 1, V2 $ i + 1)+    V1 _ <- cacheMethod $ do+      V2 val <- cacheMethod $ getV2+      return $ V1 val+    V2 v2 <- cacheMethod $ getV2++    return $ RepPlain $ toContent $ show v2+ cacheTest :: Spec cacheTest =   describe "Test.Cache" $ do@@ -67,6 +88,16 @@       res <- request defaultRequest { pathInfo = ["key"] }       assertStatus 200 res       assertBody (L8.pack $ show [1, 1, 2, 2, 3, 3 :: Int]) res++    it "nested cached" $ runner $ do+      res <- request defaultRequest { pathInfo = ["nested"] }+      assertStatus 200 res+      assertBody (L8.pack $ show (1 :: Int)) res++    it "nested cachedBy" $ runner $ do+      res <- request defaultRequest { pathInfo = ["nested-key"] }+      assertStatus 200 res+      assertBody (L8.pack $ show (1 :: Int)) res  runner :: Session () -> IO () runner f = toWaiApp C >>= runSession f

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