From 70b730cc4ef5fada41e031d4a6988cbe44fa8f8c Mon Sep 17 00:00:00 2001
From: nytopop <ericizoita@gmail.com>
Date: Mon, 29 Oct 2018 01:16:14 -0700
Subject: [PATCH] Use at most one valid session cookie per request

Makes `loadClientSession` ignore all sessions in a request if more than
a single session cookie decodes successfully. The prior behavior was to
merge all valid session cookies' values.

Bumps version to 1.6.12
---
 yesod-core/ChangeLog.md              |  4 ++++
 yesod-core/Yesod/Core/Class/Yesod.hs | 11 +++++++++--
 yesod-core/yesod-core.cabal          |  2 +-
 3 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md
index 09145551..1006d11e 100644
--- a/yesod-core/ChangeLog.md
+++ b/yesod-core/ChangeLog.md
@@ -1,5 +1,9 @@
 # ChangeLog for yesod-core
 
+## 1.6.12
+
+* Use at most one valid session cookie per request [#1581](https://github.com/yesodweb/yesod/pull/1581)
+
 ## 1.6.11
 
 * Deprecate insecure JSON parsing functions [#1576](https://github.com/yesodweb/yesod/pull/1576)
diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index 47764346..df7f079b 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -23,6 +23,7 @@ import qualified Data.ByteString.Lazy               as L
 import Data.Aeson (object, (.=))
 import           Data.List                          (foldl', nub)
 import qualified Data.Map                           as Map
+import           Data.Maybe                         (catMaybes)
 import           Data.Monoid
 import           Data.Text                          (Text)
 import qualified Data.Text                          as T
@@ -820,6 +821,12 @@ clientSessionBackend key getCachedDate =
     sbLoadSession = loadClientSession key getCachedDate "_SESSION"
   }
 
+justSingleton :: a -> [Maybe a] -> a
+justSingleton d = just . catMaybes
+  where
+    just [s] = s
+    just _   = d
+
 loadClientSession :: CS.Key
                   -> IO ClientSessionDateCache -- ^ See 'clientSessionDateCacher'
                   -> S8.ByteString -- ^ session name
@@ -830,11 +837,11 @@ loadClientSession key getCachedDate sessionName req = load
     load = do
       date <- getCachedDate
       return (sess date, save date)
-    sess date = Map.unions $ do
+    sess date = justSingleton Map.empty $ do
       raw <- [v | (k, v) <- W.requestHeaders req, k == "Cookie"]
       val <- [v | (k, v) <- parseCookies raw, k == sessionName]
       let host = "" -- fixme, properly lock sessions to client address
-      maybe [] return $ decodeClientSession key date host val
+      return $ decodeClientSession key date host val
     save date sess' = do
       -- We should never cache the IV!  Be careful!
       iv <- liftIO CS.randomIV
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index c0a1edff..9fc79e27 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.6.11
+version:         1.6.12
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>