packages feed

serversession-frontend-yesod (empty) → 1.0

raw patch · 6 files changed

+301/−0 lines, 6 filesdep +basedep +bytestringdep +containerssetup-changed

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

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-yesod++This package provide Yesod 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-yesod.cabal view
@@ -0,0 +1,44 @@+name:            serversession-frontend-yesod+version:         1.0+license:         MIT+license-file:    LICENSE+author:          Felipe Lessa <felipe.lessa@gmail.com>+maintainer:      Felipe Lessa <felipe.lessa@gmail.com>+synopsis:        Yesod 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-yesod>+extra-source-files: README.md++library+  hs-source-dirs: src+  build-depends:+      base                      == 4.*+    , bytestring+    , containers+    , cookie                    >= 0.4+    , data-default+    , path-pieces+    , text+    , time+    , transformers+    , unordered-containers+    , wai+    , yesod-core                == 1.4.*++    , serversession             == 1.0.*+  exposed-modules:+    Web.ServerSession.Frontend.Yesod+    Web.ServerSession.Frontend.Yesod.Internal+  extensions:+    FlexibleContexts+    OverloadedStrings+    TypeFamilies+  ghc-options:     -Wall++source-repository head+  type:     git+  location: https://github.com/yesodweb/serversession
+ src/Web/ServerSession/Frontend/Yesod.hs view
@@ -0,0 +1,33 @@+-- | Yesod server-side session support.+--+-- This package implements an Yesod @SessionBackend@, so it's a+-- drop-in replacement for the default @clientsession@.+--+-- Unfortunately, Yesod currently provides no way of accessing+-- the session other than via its own functions.  If you want to+-- use a custom data type as your session data (instead of the+-- default @SessionMap@), it will have to implement+-- 'IsSessionMap' and you'll have to continue using Yesod's+-- session interface.+module Web.ServerSession.Frontend.Yesod+  ( -- * Using server-side sessions+    simpleBackend+  , backend+  , IsSessionMap(..)+    -- * Invalidating session IDs+  , forceInvalidate+  , ForceInvalidate(..)+    -- * State configuration+  , setCookieName+  , setAuthKey+  , setIdleTimeout+  , setAbsoluteTimeout+  , setTimeoutResolution+  , setPersistentCookies+  , setHttpOnlyCookies+  , setSecureCookies+  , State+  ) where++import Web.ServerSession.Core+import Web.ServerSession.Frontend.Yesod.Internal
+ src/Web/ServerSession/Frontend/Yesod/Internal.hs view
@@ -0,0 +1,191 @@+-- | Internal module exposing the guts of the package.  Use at+-- your own risk.  No API stability guarantees apply.+module Web.ServerSession.Frontend.Yesod.Internal+  ( simpleBackend+  , backend+  , IsSessionMap(..)+  , createCookie+  , findSessionId+  , 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 Yesod.Core (MonadHandler)+import Yesod.Core.Handler (setSessionBS)+import Yesod.Core.Types (Header(AddCookie), SessionBackend(..))++import qualified Data.ByteString.Char8 as B8+import qualified Data.HashMap.Strict as HM+import qualified Data.Map as M+import qualified Data.Text.Encoding as TE+import qualified Data.Time as TI+import qualified Network.Wai as W+import qualified Web.Cookie as C+++-- | Construct the server-side session backend using+-- the given storage backend.+--+-- Example usage for the Yesod scaffold using+-- @serversession-backend-persistent@:+--+-- @+-- import Web.ServerSession.Backend.Persistent (SqlStorage(..))+-- import Web.ServerSession.Frontend.Yesod (simpleBackend)+--+-- instance Yesod App where+--   ...+--   makeSessionBackend = simpleBackend id . SqlStorage . appConnPool+--   -- Do not forget to add migration code to your Application.hs!+--   -- Please check serversession-backend-persistent's documentation.+--   ...+-- @+--+-- For example, if you wanted to disable the idle timeout,+-- decrease the absolute timeout to one day and mark cookies as+-- \"Secure\", you could change that line to:+--+-- @+--   makeSessionBackend = simpleBackend opts . SqlStorage . appConnPool+--     where opts = setIdleTimeout Nothing+--                . setAbsoluteTimeout (Just $ 60*60*24)+--                . setSecureCookies True+-- @+--+-- This is a simple version of 'backend' specialized for using+-- 'SessionMap' as 'SessionData'.  If you want to use a different+-- session data type, please use 'backend' directly (tip: take a+-- peek at this function's source).+simpleBackend+  :: (MonadIO m, Storage sto, SessionData sto ~ SessionMap)+  => (State sto -> State sto) -- ^ Set any options on the @serversession@ state.+  -> sto                      -- ^ Storage backend.+  -> m (Maybe SessionBackend) -- ^ Yesod session backend (always @Just@).+simpleBackend opts s =+  return . Just . backend . opts =<< createState s+++-- | Construct the server-side session backend using the given+-- state.  This is a generalized version of 'simpleBackend'.+--+-- In order to use the Yesod frontend, you 'SessionData' needs to+-- implement 'IsSessionMap'.+backend+  :: (Storage sto, IsSessionMap (SessionData sto))+  => State sto      -- ^ @serversession@ state, incl. storage backend.+  -> SessionBackend -- ^ Yesod session backend.+backend state = SessionBackend { sbLoadSession = load }+  where+    load req = do+      let rawSessionId = findSessionId cookieNameBS req+      (data_, saveSessionToken) <- loadSession state rawSessionId+      let save =+            fmap ((:[]) . maybe (deleteCookie state cookieNameBS)+                                (createCookie state cookieNameBS)) .+            saveSession state saveSessionToken .+            fromSessionMap+      return (toSessionMap data_, save)++    cookieNameBS = TE.encodeUtf8 $ getCookieName state+++----------------------------------------------------------------------+++-- | Class for session data types meant to be used with the Yesod+-- frontend.  The only session interface Yesod provides is via+-- session variables, so your data type needs to be convertible+-- from/to a 'M.Map' of 'Text' to 'ByteString'.+class IsSessionMap sess where+  toSessionMap   :: sess -> M.Map Text ByteString+  fromSessionMap :: M.Map Text ByteString -> sess+++instance IsSessionMap SessionMap where+  toSessionMap   = M.fromList . HM.toList . unSessionMap+  fromSessionMap = SessionMap . HM.fromList . M.toList+++----------------------------------------------------------------------+++-- | Create a cookie for the given session.+--+-- The cookie expiration is set via 'nextExpires'.  Note that+-- this is just an optimization, as the expiration is checked on+-- the server-side as well.+createCookie :: State sto -> ByteString -> Session sess -> Header+createCookie state cookieNameBS session =+  -- Generate a cookie with the final session ID.+  AddCookie def+    { C.setCookieName     = cookieNameBS+    , C.setCookieValue    = TE.encodeUtf8 $ toPathPiece $ sessionKey session+    , C.setCookiePath     = Just "/"+    , C.setCookieExpires  = cookieExpires state session+    , C.setCookieDomain   = Nothing+    , C.setCookieHttpOnly = getHttpOnlyCookies state+    , C.setCookieSecure   = getSecureCookies state+    }+++-- | Remove the session cookie from the client.  This is used+-- when 'saveSession' returns @Nothing@:+--+--   * If the user didn't have a session cookie, this cookie+--   deletion will be harmless.+--+--   * If the user had a session cookie that was invalidated,+--   this will remove the invalid cookie from the client.+deleteCookie :: State sto -> ByteString -> Header+deleteCookie state cookieNameBS =+  AddCookie def+    { C.setCookieName     = cookieNameBS+    , C.setCookieValue    = ""+    , C.setCookiePath     = Just "/"+    , C.setCookieExpires  = Just aLongTimeAgo+    , C.setCookieMaxAge   = Just 0+    , C.setCookieDomain   = Nothing+    , C.setCookieHttpOnly = getHttpOnlyCookies state+    , C.setCookieSecure   = getSecureCookies state+    }+  where aLongTimeAgo = read "1970-01-01 00:00:01 UTC" :: TI.UTCTime+++-- | Fetch the 'SessionId' from the cookie with the given name.+-- Returns @Nothing@ if:+--+--   * There are zero cookies with the given name.+--+--   * There is more than one cookie with the given name.+findSessionId :: ByteString -> W.Request -> Maybe ByteString+findSessionId cookieNameBS req = do+  [raw] <- return $ do+    ("Cookie", header) <- W.requestHeaders req+    (k, v) <- C.parseCookies header+    guard (k == cookieNameBS)+    return v+  return raw+++-- | 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>).+--+-- Note that the invalidate /does not/ occur when the call to+-- this action is made!  The sessions will be invalidated on the+-- end of the handler processing.  This means that later calls to+-- 'forceInvalidate' on the same handler will override earlier+-- calls.+--+-- This function works by setting a session variable that is+-- checked when saving the session.  The session variable set by+-- this function is then discarded and is not persisted across+-- requests.+forceInvalidate :: MonadHandler m => ForceInvalidate -> m ()+forceInvalidate = setSessionBS forceInvalidateKey . B8.pack . show