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

@@ -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)

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

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>