yesod-core 1.4.6.2 → 1.4.7

raw patch · 8 files changed

+158/−2 lines, 8 filesdep +hspec-expectationsdep ~clientsession

Dependencies added: hspec-expectations

Dependency ranges changed: clientsession

Files

• ChangeLog.md +4/−0
• Yesod/Core.hs +2/−0
• Yesod/Core/Class/Yesod.hs +39/−1
• test/YesodCoreTest.hs +3/−0
• test/YesodCoreTest/Ssl.hs +64/−0
• test/YesodCoreTest/StubSslOnly.hs +23/−0
• test/YesodCoreTest/StubUnsecured.hs +19/−0
• yesod-core.cabal +4/−1

@@ -1,3 +1,7 @@+## 1.4.7++SSL-only session security [#894](https://github.com/yesodweb/yesod/pull/894)+ ## 1.4.6.2  monad-control 1.0

@@ -47,6 +47,8 @@     , defaultClientSessionBackend     , envClientSessionBackend     , clientSessionBackend+    , sslOnlySessions+    , sslOnlyMiddleware     , clientSessionDateCacher     , loadClientSession     , Header(..)

@@ -310,6 +310,43 @@     authorizationCheck     handler +-- | Defends against session hijacking by setting the secure bit on session+-- cookies so that browsers will not transmit them over http. With this+-- setting on, it follows that the server will regard requests made over+-- http as sessionless, because the session cookie will not be included in+-- the request. Use this as part of a total security measure which also+-- includes disabling HTTP traffic to the site or issuing redirects from+-- HTTP urls, and composing 'sslOnlyMiddleware' with the site's+-- 'yesodMiddleware'.+--+-- Since 1.4.7+sslOnlySessions :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)+sslOnlySessions = (fmap . fmap) secureSessionCookies+  where+    setSecureBit cookie = cookie { setCookieSecure = True }+    secureSessionCookies = customizeSessionCookies setSecureBit++-- | Apply a Strict-Transport-Security header with the specified timeout to+-- all responses so that browsers will rewrite all http links to https+-- until the timeout expires. For security, the max-age of the STS header+-- should always equal or exceed the client sessions timeout. This defends+-- against hijacking attacks on the sessions of users who attempt to access+-- the site using an http url. This middleware makes a site functionally+-- inaccessible over vanilla http in all standard browsers.+--+-- Since 1.4.7+sslOnlyMiddleware :: Yesod site+                     => Int -- ^ minutes+                     -> HandlerT site IO res+                     -> HandlerT site IO res+sslOnlyMiddleware timeout handler = do+    addHeader "Strict-Transport-Security"+              $ T.pack $ concat [ "max-age="+                                , show $ timeout * 60+                                , "; includeSubDomains"+                                ]+    handler+ -- | Check if a given request is authorized via 'isAuthorized' and -- 'isWriteRequest'. --@@ -570,7 +607,8 @@ -- would work across many subdomains: -- -- @--- makeSessionBackend = fmap (customizeSessionCookie addDomain) ...+-- makeSessionBackend site =+--     (fmap . fmap) (customizeSessionCookies addDomain) ... --   where --     addDomain cookie = cookie { 'setCookieDomain' = Just \".example.com\" } -- @

@@ -20,6 +20,7 @@ import qualified YesodCoreTest.Reps as Reps import qualified YesodCoreTest.Auth as Auth import qualified YesodCoreTest.LiteApp as LiteApp+import qualified YesodCoreTest.Ssl as Ssl  import Test.Hspec @@ -44,3 +45,5 @@       Reps.specs       Auth.specs       LiteApp.specs+      Ssl.unsecSpec+      Ssl.sslOnlySpec

@@ -0,0 +1,64 @@+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}+module YesodCoreTest.Ssl ( sslOnlySpec, unsecSpec ) where+import qualified YesodCoreTest.StubSslOnly as Ssl+import qualified YesodCoreTest.StubUnsecured as Unsecured+import Yesod.Core+import Test.Hspec+import Network.Wai+import Network.Wai.Test+import qualified Data.ByteString.Char8 as C8+import qualified Web.Cookie as Cookie+import qualified Data.List as DL++type CookieSpec = Cookie.SetCookie -> Bool++type ResponseExpectation = SResponse -> Session ()++homeFixtureFor :: YesodDispatch a => a -> ResponseExpectation -> IO ()+homeFixtureFor app assertion = do+    wa <- toWaiApp app+    runSession (getHome >>= assertion) wa+  where+    getHome = request defaultRequest++cookieShouldSatisfy :: String -> CookieSpec -> ResponseExpectation+cookieShouldSatisfy name spec response =+    liftIO $+      case DL.filter matchesName $ cookiesIn response of+          [] -> expectationFailure $ DL.concat+            [ "Expected a cookie named "+            , name+            , " but none is set"+            ]+          [c] -> c `shouldSatisfy` spec+          _ -> expectationFailure $ DL.concat+            [ "Expected one cookie named "+            , name+            , " but found more than one"+            ]+  where+    matchesName c = (Cookie.setCookieName c) == C8.pack name+    cookiesIn r =+      DL.map+        (Cookie.parseSetCookie . snd)+        (DL.filter (("Set-Cookie"==) . fst) $ simpleHeaders r)++sslOnlySpec :: Spec+sslOnlySpec = describe "A Yesod application with sslOnly on" $ do+    it "serves a Strict-Transport-Security header in all responses" $+        atHome $ assertHeader "Strict-Transport-Security"+                              "max-age=7200; includeSubDomains"+    it "sets the Secure flag on its session cookie" $+        atHome $ "_SESSION" `cookieShouldSatisfy` Cookie.setCookieSecure+  where+    atHome = homeFixtureFor Ssl.App++unsecSpec :: Spec+unsecSpec = describe "A Yesod application with sslOnly off" $ do+    it "never serves a Strict-Transport-Security header" $ do+        atHome $ assertNoHeader "Strict-Transport-Security"+    it "does not set the Secure flag on its session cookie" $ do+        atHome $ "_SESSION" `cookieShouldSatisfy` isNotSecure+  where+    atHome = homeFixtureFor Unsecured.App+    isNotSecure c = not $ Cookie.setCookieSecure c

@@ -0,0 +1,23 @@+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}+module YesodCoreTest.StubSslOnly ( App ( App ) ) where++import Yesod.Core+import qualified Web.ClientSession                  as CS++data App = App++mkYesod "App" [parseRoutes|+/ HomeR GET+|]++instance Yesod App where+    yesodMiddleware = defaultYesodMiddleware . (sslOnlyMiddleware 120)+    makeSessionBackend _ = sslOnlySessions $+        fmap Just $ defaultClientSessionBackend 120 CS.defaultKeyFile++getHomeR :: Handler Html+getHomeR = defaultLayout+    [whamlet|+        <p>+            Welcome to my test application.+    |]

@@ -0,0 +1,19 @@+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}+module YesodCoreTest.StubUnsecured ( App ( App ) ) where++import Yesod.Core++data App = App++mkYesod "App" [parseRoutes|+/ HomeR GET+|]++instance Yesod App++getHomeR :: Handler Html+getHomeR = defaultLayout+    [whamlet|+        <p>+            Welcome to my test application.+    |]

@@ -1,5 +1,5 @@ name:            yesod-core-version:         1.4.6.2+version:         1.4.7 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -138,6 +138,8 @@     cpp-options:   -DTEST     build-depends: base                   ,hspec >= 1.3+                  ,hspec-expectations+                  ,clientsession                   ,wai >= 3.0                   ,yesod-core                   ,bytestring@@ -159,6 +161,7 @@                   , streaming-commons                   , wai-extra                   , mwc-random+                  , cookie >= 0.4.1    && < 0.5     ghc-options:     -Wall     extensions: TemplateHaskell