packages feed

serversession-frontend-wai (empty) → 1.0

raw patch · 6 files changed

+265/−0 lines, 6 filesdep +basedep +bytestringdep +cookiesetup-changed

Dependencies added: base, bytestring, cookie, data-default, path-pieces, serversession, text, time, transformers, unordered-containers, vault, wai, wai-session

Files

+ LICENSE view
@@ -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.
+ README.md view
@@ -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.
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ serversession-frontend-wai.cabal view
@@ -0,0 +1,44 @@+name:            serversession-frontend-wai+version:         1.0+license:         MIT+license-file:    LICENSE+author:          Felipe Lessa <felipe.lessa@gmail.com>+maintainer:      Felipe Lessa <felipe.lessa@gmail.com>+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 <http://www.stackage.org/package/serversession-frontend-wai>+extra-source-files: README.md++library+  hs-source-dirs: src+  build-depends:+      base                      >= 4.6   && < 5+    , bytestring+    , cookie                    >= 0.4+    , data-default+    , path-pieces+    , text+    , time+    , transformers+    , unordered-containers+    , vault+    , wai+    , wai-session               == 0.3.*++    , serversession             == 1.0.*+  exposed-modules:+    Web.ServerSession.Frontend.Wai+    Web.ServerSession.Frontend.Wai.Internal+  extensions:+    FlexibleContexts+    OverloadedStrings+    TypeFamilies+  ghc-options:     -Wall++source-repository head+  type:     git+  location: https://github.com/yesodweb/serversession
+ src/Web/ServerSession/Frontend/Wai.hs view
@@ -0,0 +1,34 @@+-- | @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+  , KeyValue(..)+    -- * State configuration+  , setCookieName+  , setAuthKey+  , setIdleTimeout+  , setAbsoluteTimeout+  , setTimeoutResolution+  , setPersistentCookies+  , setHttpOnlyCookies+  , setSecureCookies+  , State+  ) where++import Web.ServerSession.Core+import Web.ServerSession.Frontend.Wai.Internal
+ src/Web/ServerSession/Frontend/Wai/Internal.hs view
@@ -0,0 +1,154 @@+-- | 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+  , KeyValue(..)+  , createCookieTemplate+  , calculateMaxAge+  , forceInvalidate+  ) where++import Control.Applicative ((<$>))+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.HashMap.Strict as HM+import qualified Data.IORef as I+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+  :: (Functor m, MonadIO m, MonadIO n, Storage sto, SessionData sto ~ SessionMap)+  => V.Key (WS.Session m Text ByteString) -- ^ 'V.Vault' key to use when passing the session through.+  -> (State sto -> State sto)             -- ^ Set any options on the @serversession@ state.+  -> sto                                  -- ^ 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.+--+-- As @wai-session@ always requires a value to be provided, we+-- return an empty @ByteString@ when the empty session was not+-- saved.+sessionStore+  :: (Functor m, MonadIO m, Storage sto, KeyValue (SessionData sto))+  => State sto -- ^ @serversession@ state, incl. storage backend.+  -> WS.SessionStore m (Key (SessionData sto)) (Value (SessionData sto))+     -- ^ @wai-session@ session store.+sessionStore state =+  \mcookieVal -> do+    (data1, saveSessionToken) <- loadSession state mcookieVal+    sessionRef <- I.newIORef data1+    let save = do+          data2 <- I.atomicModifyIORef' sessionRef $ \a -> (a, a)+          msession <- saveSession state saveSessionToken data2+          return $ maybe "" (TE.encodeUtf8 . toPathPiece . sessionKey) msession+    return (mkSession sessionRef, save)+++-- | Build a 'WS.Session' from an 'I.IORef' containing the+-- session data.+mkSession :: (Functor m, MonadIO m, KeyValue sess) => I.IORef sess -> WS.Session m (Key sess) (Value sess)+mkSession sessionRef =+  -- We need to use atomicModifyIORef instead of readIORef+  -- because latter may be reordered (cf. "Memory Model" on+  -- Data.IORef's documentation).+  ( \k   -> kvLookup k <$> liftIO (I.atomicModifyIORef' sessionRef $ \a -> (a, a))+  , \k v -> liftIO (I.atomicModifyIORef' sessionRef $ flip (,) () . kvInsert k v)+  )+++----------------------------------------------------------------------+++-- | Class for session data types that can be used as key-value+-- stores.+class IsSessionData sess => KeyValue sess where+  type Key   sess :: *+  type Value sess :: *+  kvLookup :: Key sess -> sess -> Maybe (Value sess)+  kvInsert :: Key sess -> Value sess -> sess -> sess+++instance KeyValue SessionMap where+  type Key   SessionMap = Text+  type Value SessionMap = ByteString+  kvLookup k = HM.lookup k . unSessionMap+  kvInsert k v (SessionMap m) = SessionMap (HM.insert k v m)+++----------------------------------------------------------------------+++-- | 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 sto -> 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 sto -> 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. <http://www.acrossecurity.com/papers/session_fixation.pdf>).+forceInvalidate :: WS.Session m Text ByteString -> ForceInvalidate -> m ()+forceInvalidate (_, insert) = insert forceInvalidateKey . B8.pack . show