diff --git a/README.md b/README.md index eece065..9f94815 100644 --- a/README.md +++ b/README.md @@ -36,6 +36,10 @@ to be paired up with two companion packages: `Snap.Snaplet.Session.Backends.CookieSession` based on `clientsession`. + * `serversession-frontend-wai`: Generic support for WAI + applications via the `wai-session` package by using a + `vault`. + If your favorite storage backend or framework is not listed above, please send us a pull request! The `serversession` package should work for any session that may be represented as a diff --git a/serversession-frontend-wai/LICENSE b/serversession-frontend-wai/LICENSE new file mode 100644 index 0000000..cdf4661 --- /dev/null +++ b/serversession-frontend-wai/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Felipe Lessa + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/serversession-frontend-wai/README.md b/serversession-frontend-wai/README.md new file mode 100644 index 0000000..59f4ac3 --- /dev/null +++ b/serversession-frontend-wai/README.md @@ -0,0 +1,6 @@ +# serversession-frontend-wai + +This package provide WAI bindings for the `serversession` +package. Please +[read the main README file](https://github.com/yesodweb/serversession/blob/master/README.md) +for general information about the serversession packages. diff --git a/serversession-frontend-wai/serversession-frontend-wai.cabal b/serversession-frontend-wai/serversession-frontend-wai.cabal new file mode 100644 index 0000000..d56a5d9 --- /dev/null +++ b/serversession-frontend-wai/serversession-frontend-wai.cabal @@ -0,0 +1,42 @@ +name: serversession-frontend-wai +version: 1.0 +license: MIT +license-file: LICENSE +author: Felipe Lessa +maintainer: Felipe Lessa +synopsis: wai-session bindings for serversession. +category: Web +stability: Stable +cabal-version: >= 1.8 +build-type: Simple +homepage: https://github.com/yesodweb/serversession +description: API docs and the README are available at +extra-source-files: README.md + +library + hs-source-dirs: src + build-depends: + base >= 4.6 && < 5 + , bytestring + , containers + , cookie >= 0.4 + , data-default + , path-pieces + , text + , time + , transformers + , vault + , wai + , wai-session == 0.3.* + + , serversession == 1.0.* + exposed-modules: + Web.ServerSession.Frontend.Wai + Web.ServerSession.Frontend.Wai.Internal + extensions: + OverloadedStrings + ghc-options: -Wall + +source-repository head + type: git + location: https://github.com/yesodweb/serversession diff --git a/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai.hs b/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai.hs new file mode 100644 index 0000000..58f87f2 --- /dev/null +++ b/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai.hs @@ -0,0 +1,32 @@ +-- | @wai-session@ server-side session support. +-- +-- Please note that this frontend has some limitations: +-- +-- * Cookies use the @Max-age@ field instead of @Expires@. The +-- @Max-age@ field is not supported by all browsers: some +-- browsers will treat them as non-persistent cookies. +-- +-- * Also, the @Max-age@ is fixed and does not take a given a +-- session into consideration. +module Web.ServerSession.Frontend.Wai + ( -- * Simple interface + withServerSession + -- * Invalidating session IDs + , forceInvalidate + , ForceInvalidate(..) + -- * Flexible interface + , sessionStore + , createCookieTemplate + -- * State configuration + , setCookieName + , setAuthKey + , setIdleTimeout + , setAbsoluteTimeout + , setPersistentCookies + , setHttpOnlyCookies + , setSecureCookies + , State + ) where + +import Web.ServerSession.Core +import Web.ServerSession.Frontend.Wai.Internal diff --git a/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai/Internal.hs b/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai/Internal.hs new file mode 100644 index 0000000..56e53e5 --- /dev/null +++ b/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai/Internal.hs @@ -0,0 +1,122 @@ +-- | Internal module exposing the guts of the package. Use at +-- your own risk. No API stability guarantees apply. +module Web.ServerSession.Frontend.Wai.Internal + ( withServerSession + , sessionStore + , mkSession + , createCookieTemplate + , calculateMaxAge + , forceInvalidate + ) where + +import Control.Monad (guard) +import Control.Monad.IO.Class (MonadIO(..)) +import Data.ByteString (ByteString) +import Data.Default (def) +import Data.Text (Text) +import Web.PathPieces (toPathPiece) +import Web.ServerSession.Core +import Web.ServerSession.Core.Internal (absoluteTimeout, idleTimeout, persistentCookies) + +import qualified Data.ByteString.Char8 as B8 +import qualified Data.IORef as I +import qualified Data.Map as M +import qualified Data.Text.Encoding as TE +import qualified Data.Time as TI +import qualified Data.Vault.Lazy as V +import qualified Network.Wai as W +import qualified Network.Wai.Session as WS +import qualified Web.Cookie as C + + +-- | Construct the @wai-session@ middleware using the given +-- storage backend and options. This is a convenient function +-- that uses 'WS.withSession', 'createState', 'sessionStore', +-- 'getCookieName' and 'createCookieTemplate'. +withServerSession + :: (MonadIO m, MonadIO n, Storage s) + => V.Key (WS.Session m Text ByteString) -- ^ 'V.Vault' key to use when passing the session through. + -> (State s -> State s) -- ^ Set any options on the @serversession@ state. + -> s -- ^ Storage backend. + -> n W.Middleware +withServerSession key opts storage = liftIO $ do + st <- opts <$> createState storage + return $ + WS.withSession + (sessionStore st) + (TE.encodeUtf8 $ getCookieName st) + (createCookieTemplate st) + key + + +-- | Construct the @wai-session@ session store using the given +-- state. Note that keys and values types are fixed. +sessionStore + :: (MonadIO m, Storage s) + => State s -- ^ @serversession@ state, incl. storage backend. + -> WS.SessionStore m Text ByteString -- ^ @wai-session@ session store. +sessionStore state = + \mcookieVal -> do + (sessionMap, saveSessionToken) <- loadSession state mcookieVal + sessionRef <- I.newIORef sessionMap + let save = do + sessionMap' <- I.readIORef sessionRef + session <- saveSession state saveSessionToken sessionMap' + return $ TE.encodeUtf8 $ toPathPiece $ sessionKey session + return (mkSession sessionRef, save) + + +-- | Build a 'WS.Session' from an 'I.IORef' containing the +-- session data. +mkSession :: MonadIO m => I.IORef SessionMap -> WS.Session m Text ByteString +mkSession sessionRef = + ( \k -> M.lookup k <$> liftIO (I.readIORef sessionRef) + , \k v -> liftIO (I.atomicModifyIORef' sessionRef $ flip (,) () . M.insert k v) + ) + + +-- | Create a cookie template given a state. +-- +-- Since we don't have access to the 'Session', we can't fill the +-- @Expires@ field. Besides, as the template is constant, +-- eventually the @Expires@ field would become outdated. This is +-- a limitation of @wai-session@'s interface, not a +-- @serversession@ limitation. Other frontends support the +-- @Expires@ field. +-- +-- Instead, we fill only the @Max-age@ field. It works fine for +-- modern browsers, but many don't support it and will treat the +-- cookie as non-persistent (notably IE 6, 7 and 8). +createCookieTemplate :: State s -> C.SetCookie +createCookieTemplate state = + -- Generate a cookie with the final session ID. + def + { C.setCookiePath = Just "/" + , C.setCookieMaxAge = calculateMaxAge state + , C.setCookieDomain = Nothing + , C.setCookieHttpOnly = getHttpOnlyCookies state + , C.setCookieSecure = getSecureCookies state + } + + +-- | Calculate the @Max-age@ of a cookie template for the given +-- state. +-- +-- * If the state asks for non-persistent sessions, the result +-- is @Nothing@. +-- +-- * If no timeout is defined, the result is 10 years. +-- +-- * Otherwise, the max age is set as the maximum timeout. +calculateMaxAge :: State s -> Maybe TI.DiffTime +calculateMaxAge st = do + guard (persistentCookies st) + return $ maybe (60*60*24*3652) realToFrac + $ idleTimeout st `max` absoluteTimeout st + + +-- | Invalidate the current session ID (and possibly more, check +-- 'ForceInvalidate'). This is useful to avoid session fixation +-- attacks (cf. ). +forceInvalidate :: WS.Session m Text ByteString -> ForceInvalidate -> m () +forceInvalidate (_, insert) = insert forceInvalidateKey . B8.pack . show