Code from branch that lived on yesod's repo.

.gitignore

@@ -0,0 +1,13 @@
+*~
+*.o
+*.o_p
+*.hi
+dist
+*.swp
+cabal-dev/
+.hsenv/
+.cabal-sandbox/
+cabal.sandbox.config
+/vendor/
+.shelly/
+tarballs/

yesod-persistent-session/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.

yesod-persistent-session/README.md

@@ -0,0 +1,131 @@
+# yesod-persistent-session
+
+Server-side session backend using persistent.
+
+This package implement traditional server-side sessions.  Users
+who don't have a session yet are assigned a random 144-bit
+session ID that is the key on a database table kept by
+persistent.  All session data is saved on the database.
+
+The session ID stays fixed most of the time.  Anonymous users
+receive session IDs unless their session remains empty (as an
+optimization).  The session ID can be invalidated in order to
+prevent
+[session fixation attacks](http://www.acrossecurity.com/papers/session_fixation.pdf),
+either automatically (see below) or manually (via
+`forceInvalidate`).
+
+
+## Authentication integration
+
+We have special support for `yesod-auth`:
+
+  * The `_ID` session key used by `yesod-auth` is recognized and
+    saved separately on the database.  This allows you to quickly
+    identify all sessions of a given user.  For example, you're
+    able to implement a "log out everywhere" button.
+
+  * Whenever the `_ID` changes, the backend will also invalidate
+    the current session ID and migrate the session data to a new
+    ID.  This prevents session fixation attacks while still
+    allowing you to maintain session state accross login/logout
+    boundaries.
+
+If you wish to use a different authentication mechanism and still
+enjoy the advantages above, just use the same `_ID` session key.
+
+
+## Current limitations
+
+  * All sessions use persistent cookies.
+
+  * We support SQL backends only, such as
+    `persistent-postgresql`.  The code has to fix upfront which
+    persistent backend is used.
+
+
+## Background
+
+Yesod has always support client-side sessions via the
+[`clientsession`](http://hackage.haskell.org/package/clientsession)
+package: the session data is encrypted, signed, encoded and sent
+to the client inside a cookie.  When receiving a request, the
+cookie is decoded, verified and decrypted.  The server does not
+have to maintain any state, so the client-side session backend is
+as fast as the cryptographic primitives.
+
+However, there are some disadvantages to client-side sessions:
+
+  * _Replay attacks_.  It's not possible to invalidate a session,
+    for example.  When logging out, a new cookie is sent with
+    logged out session data.  However, as the server doesn't
+    maintain state about sessions, it will still accept the old,
+    logged in cookie until it expires.  One could set very small
+    expiration times to mitigate this, but this would force users
+    to relogin frequently.  This server-side backend allows you
+    to maintain long expiration times while still having secure
+    logouts.
+
+  * _Cookie size_.  As the cookie contain the whole session data
+    plus some overhead, care must be taken not to create too much
+    session data.  Yesod already saves the logged in user ID via
+    `yesod-auth` and a XSRF token via `yesod-form`.  This
+    server-side backend uses a cookie of fixed size (24 bytes).
+
+  * _No remote logout_.  In many instances it is desirable to
+    invalidate sessions other than the current one.  For example,
+    the user may have changed their password, or the the site
+    provides a button to cancel all logged in sessions besides
+    the current one.  This server-side backend allows you to
+    invalidate sessions other than the current one via
+    `forceInvalidate`.
+
+  * _Missing key rotation_.  Ideally, `clientsession`'s keys
+    should be rotated periodically.  In practice, support for key
+    rotation has never been implemented on `clientsession`.  This
+    server-side backend does not need to do key rotations, and
+    the session ID CPRNG is automatically reseeded.
+
+If you're concerned about any of the points above, you've come to
+the right package!
+
+
+## Comparision to other packages
+
+At the time of writing (2015-05-22), these are the session
+packages that do not use either `clientsession` or
+`serversession`:
+
+  * `mysnapsession` (via `Memory` module, also supports
+    `clientsession` mode): Server-side sessions.  Works for
+    `snap`.  Weak session ID generation.  Vulnerable to session
+    fixation attacks.  Cannot invalidate other sessions.
+
+  * `salvia-sessions`: Server-side sessions.  Works only for
+    `salvia`.  No built-in support for DB-backed sessions, only
+    memory-backed ones.  Weak session ID generation.  Vulnerable
+    to session fixation attacks.  Cannot invalidate other
+    sessions.
+
+  * `simple-session`: Client-side sessions.  Works for `simple`
+    framework.  No encryption.  Authentication vulnerable to
+    timing attacks.
+
+  * `Spock` (formely `scotty-session`): Server-side sessions.
+    Works for `Spock` (code is not packaged separately).  Only
+    supports memory-backed sessions persisted on a file.  Weak
+    session ID generation.  Vulnerable to session fixation
+    attacks.  Cannot invalidate other sessions.
+
+  * `wai-session`: Server-side sessions.  Works for `wai`
+    applications.  Weak session ID generation.  Vulnerable to
+    session fixation.  Cannot invalidate other sessions.
+    Out-of-the-box support for TokyoCabinet only.
+
+  * `yesod-session-redis`: Server-side sessions.  Works for
+    Yesod and Redis.  Weak session ID generation via `random`.
+    Vulnerable to session fixation.  Cannot invalidate other
+    sessions.
+
+We apologize in advance if any information above is incorrect.
+Please contact us about any errors.

yesod-persistent-session/src/Yesod/Persist/Session.hs

@@ -0,0 +1,18 @@
+-- | Server-side session backend.
+--
+-- This module is meant to be imported qualified:
+--
+-- @
+-- import qualified Yesod.Persist.Session as Session
+-- @
+--
+-- TODO: Usage
+module Yesod.Persist.Session
+  ( backend
+  , createState
+  , State
+  , forceInvalidate
+  , ForceInvalidate(..)
+  ) where
+
+import Yesod.Persist.Session.Internal.Backend

yesod-persistent-session/src/Yesod/Persist/Session/Internal/Backend.hs

@@ -0,0 +1,266 @@
+module Yesod.Persist.Session.Internal.Backend
+  ( State(..)
+  , createState
+  , backend
+  , loadSession
+  , invalidateIfNeeded
+  , DecomposedSession
+  , decomposeSession
+  , saveSessionOnDb
+  , createCookie
+  , findSessionId
+  , toSessionMap
+  , authKey
+  , forceInvalidateKey
+  , ForceInvalidate(..)
+  , forceInvalidate
+  ) where
+
+import Control.Monad (guard, when)
+import Control.Monad.IO.Class (MonadIO(..))
+import Data.ByteString (ByteString)
+import Data.Default (def)
+import Data.Maybe (isJust)
+import Data.Text (Text)
+import Data.Time (getCurrentTime)
+import Data.Typeable (Typeable)
+import Web.Cookie (parseCookies, SetCookie(..))
+import Web.PathPieces (fromPathPiece)
+import Yesod.Core (MonadHandler)
+import Yesod.Core.Handler (setSessionBS)
+import Yesod.Core.Types (Header(AddCookie), SaveSession, SessionBackend(..), SessionMap)
+
+import qualified Crypto.Nonce as N
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.Map as M
+import qualified Data.Text.Encoding as TE
+import qualified Network.Wai as W
+
+import Yesod.Persist.Session.Internal.Types
+
+-- TODO: expiration
+
+-- TODO: do not create empty sessions
+
+-- | The server-side session backend needs to maintain some state
+-- in order to work:
+--
+--   * A nonce generator for the session IDs.
+--
+--   * The storage backend.
+--
+-- Create a new 'State' using 'createState'.
+data State s =
+  State
+    { generator :: !N.Generator
+    , storage   :: !s
+    } deriving (Typeable)
+
+
+-- | Create a new 'State' for the server-side session backend
+-- using the given storage backend.
+createState :: MonadIO m => s -> m (State s)
+createState storage = State <$> N.new <*> return storage
+
+
+-- | Construct the server-side session backend from the given state.
+backend :: Storage s => State s -> SessionBackend
+backend state =
+  SessionBackend {
+    sbLoadSession = loadSession state "JSESSIONID" -- LOL :)
+  }
+
+
+-- | Load the session map from the DB from the ID on the request.
+-- Also provides a function to update the session when sending
+-- the response.
+loadSession :: forall s. Storage s => State s -> ByteString -> W.Request -> IO (SessionMap, SaveSession)
+loadSession state cookieName = load
+  where
+    runDB :: TransactionM s a -> IO a
+    runDB = runTransactionM (storage state)
+
+    load :: W.Request -> IO (SessionMap, SaveSession)
+    load req = do
+      -- Find 'SessionId' (if any) and load it from DB (if present).
+      let maybeInputId = findSessionId cookieName req
+      maybeInput <- maybe (return Nothing) (runDB . getSession (storage state)) maybeInputId
+      let inputSessionMap = maybe M.empty toSessionMap maybeInput
+      return (inputSessionMap, save maybeInput)
+
+    save :: Maybe Session -> SaveSession
+    save maybeInput wholeOutputSessionMap =
+      runDB $ do
+        let decomposedSessionMap = decomposeSession wholeOutputSessionMap
+        newMaybeInput <- invalidateIfNeeded state maybeInput decomposedSessionMap
+        key <- saveSessionOnDb state newMaybeInput decomposedSessionMap
+        return [createCookie cookieName key]
+
+
+-- | Invalidates an old session ID if needed.  Returns the
+-- 'Session' that should be replaced when saving the session, if any.
+--
+-- Currently we invalidate whenever the auth ID has changed
+-- (login, logout, different user) in order to prevent session
+-- fixation attacks.  We also invalidate when asked to via
+-- 'forceInvalidate'.
+invalidateIfNeeded
+  :: Storage s
+  => State s
+  -> Maybe Session
+  -> DecomposedSession
+  -> TransactionM s (Maybe Session)
+invalidateIfNeeded state maybeInput DecomposedSession {..} = do
+  -- Decide which action to take.
+  -- "invalidateOthers implies invalidateCurrent" should be true below.
+  let inputAuthId       = sessionAuthId =<< maybeInput
+      invalidateCurrent = dsForceInvalidate /= DoNotForceInvalidate || inputAuthId /= dsAuthId
+      invalidateOthers  = dsForceInvalidate == AllSessionIdsOfLoggedUser && isJust dsAuthId
+      whenMaybe b m f   = when b $ maybe (return ()) f m
+  -- Delete current and others, as requested.
+  whenMaybe invalidateCurrent maybeInput $ deleteSession (storage state) . sessionKey
+  whenMaybe invalidateOthers  dsAuthId   $ deleteAllSessionsOfAuthId (storage state)
+  -- Remember the input only if not invalidated.
+  return $ guard (not invalidateCurrent) >> maybeInput
+
+
+-- | A 'SessionMap' with its 'authKey' taken apart.
+data DecomposedSession =
+  DecomposedSession
+    { dsAuthId          :: !(Maybe ByteString)
+    , dsForceInvalidate :: !ForceInvalidate
+    , dsSessionMap      :: !SessionMap
+    } deriving (Show, Typeable)
+
+
+-- | Decompose a session (see 'DecomposedSession').
+decomposeSession :: SessionMap -> DecomposedSession
+decomposeSession sm1 =
+  let (authId, sm2) = M.updateLookupWithKey (\_ _ -> Nothing) authKey            sm1
+      (force,  sm3) = M.updateLookupWithKey (\_ _ -> Nothing) forceInvalidateKey sm2
+  in DecomposedSession
+       { dsAuthId          = authId
+       , dsForceInvalidate = maybe DoNotForceInvalidate (read . B8.unpack) force
+       , dsSessionMap      = sm3 }
+
+
+-- | Save a session on the database.  If an old session is
+-- supplied, it is replaced, otherwise a new session is
+-- generated.
+saveSessionOnDb
+  :: Storage s
+  => State s
+  -> Maybe Session            -- ^ The old session, if any.
+  -> DecomposedSession        -- ^ The session data to be saved.
+  -> TransactionM s SessionId -- ^ The ID of the saved session.
+saveSessionOnDb state maybeInput DecomposedSession {..} = do
+  -- Generate properties if needed or take them from previous
+  -- saved session.
+  (saveToDb, key, createdAt) <-
+    case maybeInput of
+      Nothing -> liftIO $
+        (,,) <$> return (insertSession $ storage state)
+             <*> generateSessionId (generator state)
+             <*> getCurrentTime
+      Just Session {..} ->
+        return ( replaceSession (storage state)
+               , sessionKey
+               , sessionCreatedAt)
+  -- Save to the database.
+  saveToDb $ Session key dsAuthId dsSessionMap createdAt
+  return key
+
+
+-- | Create a cookie for the given session ID.
+createCookie :: ByteString -> SessionId -> Header
+createCookie cookieName key =
+  -- Generate a cookie with the final session ID.
+  AddCookie def
+    { setCookieName     = cookieName
+    , setCookieValue    = TE.encodeUtf8 $ unS key
+    , setCookiePath     = Just "/"
+    , setCookieExpires  = Just undefined
+    , setCookieDomain   = Nothing
+    , setCookieHttpOnly = True
+    }
+
+
+-- | 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.
+--
+--   * The cookie's value isn't considered a 'SessionId'.  We're
+--   a bit strict here.
+findSessionId :: ByteString -> W.Request -> Maybe SessionId
+findSessionId cookieName req = do
+  let matching = do
+        ("Cookie", header) <- W.requestHeaders req
+        (k, v) <- parseCookies header
+        guard (k == cookieName)
+        return v
+  [raw] <- return matching
+  fromPathPiece (TE.decodeUtf8 raw)
+
+
+-- | Create a 'SessionMap' from a 'Session'.
+toSessionMap :: Session -> SessionMap
+toSessionMap Session {..} =
+  maybe id (M.insert authKey) sessionAuthId sessionData
+
+
+-- | The session key used by @yesod-auth@ without depending on it.
+authKey :: Text
+authKey = "_ID"
+
+
+-- | The session key used to signal that the session ID should be
+-- invalidated.
+forceInvalidateKey :: Text
+forceInvalidateKey = "yesod-persistent-session-force-invalidate"
+
+
+-- | Which session IDs should be invalidated.
+data ForceInvalidate =
+    CurrentSessionId
+    -- ^ Invalidate the current session ID.  The current session
+    -- ID is automatically invalidated on @yesod-auth@ login and
+    -- logout.
+  | AllSessionIdsOfLoggedUser
+    -- ^ Invalidate all session IDs beloging to the currently
+    -- logged in user.  Only the current session ID will be
+    -- renewed (the only one for which a cookie can be set).
+    --
+    -- This is useful, for example, if the user asks to change
+    -- their password.  It's also useful to provide a button to
+    -- clear all other sessions.
+    --
+    -- If the user is not logged in, this option behaves exactly
+    -- as 'CurrentSessionId' (i.e., it /does not/ invalidate the
+    -- sessions of all logged out users).
+    --
+    -- Note that, for the purposes of
+    -- 'AllSessionIdsOfLoggedUser', we consider \"logged user\"
+    -- the one that is logged in at the *end* of the handler
+    -- processing.  For example, if the user was logged in but
+    -- the current handler logged him out, the session IDs of the
+    -- user who was logged in will not be invalidated.
+  | DoNotForceInvalidate
+    -- ^ Do not force invalidate.  Invalidate only if
+    -- automatically.  This is the default.
+    deriving (Eq, Ord, Show, Read, Enum, Typeable)
+
+
+-- | 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.
+forceInvalidate :: MonadHandler m => ForceInvalidate -> m ()
+forceInvalidate = setSessionBS forceInvalidateKey . B8.pack . show

yesod-persistent-session/src/Yesod/Persist/Session/Internal/Sql.hs

@@ -0,0 +1,86 @@
+module Yesod.Persist.Session.Internal.Sql
+  ( PersistentSession(..)
+  , PersistentSessionId
+  , EntityField(..)
+  , persistentSessionDefs
+  , psKey
+  , toPersistentSession
+  , fromPersistentSession
+  , SqlStorage(..)
+  ) where
+
+import Control.Monad (void)
+import Data.Pool (Pool)
+import Data.Time (UTCTime)
+import Data.Typeable (Typeable)
+import Database.Persist (PersistEntity(..), toPersistValue)
+import Database.Persist.TH (mkPersist, mkSave, persistLowerCase, share, sqlSettings)
+
+import qualified Database.Persist as P
+import qualified Database.Persist.Sql as P
+
+import Yesod.Persist.Session.Internal.Types
+
+
+share
+  [mkPersist sqlSettings, mkSave "persistentSessionDefs"]
+  [persistLowerCase|
+    PersistentSession json
+      key       SessionId         -- Session ID, primary key.
+      authId    ByteStringJ Maybe -- Value of "_ID" session key.
+      session   SessionMapJ       -- Rest of the session data.
+      createdAt UTCTime           -- When this session was created.
+      Primary key
+      deriving Eq Ord Show Typeable
+  |]
+
+
+-- | Generate a key to the entity from the session ID.
+psKey :: SessionId -> Key PersistentSession
+psKey = unwrap . keyFromValues . return . toPersistValue
+  where
+    unwrap (Left e) = error $
+      "Yesod.Persist.Session.Internal.Entities.psKey: " ++
+      "unexpected error from keyFromValues: " ++ show e
+    unwrap (Right k) = k
+
+
+-- | Convert from 'Session' to 'PersistentSession'.
+toPersistentSession :: Session -> PersistentSession
+toPersistentSession Session {..} =
+  PersistentSession
+    { persistentSessionKey       = sessionKey
+    , persistentSessionAuthId    = fmap B sessionAuthId
+    , persistentSessionSession   = M sessionData
+    , persistentSessionCreatedAt = sessionCreatedAt
+    }
+
+
+-- | Convert from 'PersistentSession' to 'Session'.
+fromPersistentSession :: PersistentSession -> Session
+fromPersistentSession PersistentSession {..} =
+  Session
+    { sessionKey       = persistentSessionKey
+    , sessionAuthId    = fmap unB persistentSessionAuthId
+    , sessionData      = unM persistentSessionSession
+    , sessionCreatedAt = persistentSessionCreatedAt
+    }
+
+
+-- | SQL session storage backend using @persistent@.
+newtype SqlStorage =
+  SqlStorage
+    { connPool :: Pool P.SqlBackend
+      -- ^ Pool of DB connections.  You may use the same pool as
+      -- your application.
+    } deriving (Typeable)
+
+
+instance Storage SqlStorage where
+  type TransactionM SqlStorage = P.SqlPersistT IO
+  runTransactionM  = flip P.runSqlPool . connPool
+  getSession     _ = fmap (fmap fromPersistentSession) . P.get . psKey
+  deleteSession  _ = P.delete . psKey
+  deleteAllSessionsOfAuthId _ authId = P.deleteWhere [PersistentSessionAuthId P.==. Just (B authId)]
+  insertSession  _ = void . P.insert . toPersistentSession
+  replaceSession _ = \session -> P.replace (psKey $ sessionKey session) $ toPersistentSession session

yesod-persistent-session/src/Yesod/Persist/Session/Internal/Types.hs

@@ -0,0 +1,184 @@
+module Yesod.Persist.Session.Internal.Types
+  ( SessionId(..)
+  , generateSessionId
+  , Session(..)
+  , Storage(..)
+  , ByteStringJ(..)
+  , SessionMapJ(..)
+  ) where
+
+import Control.Monad ((>=>), guard, mzero)
+import Control.Monad.IO.Class (MonadIO)
+import Data.ByteString (ByteString)
+import Data.Text (Text)
+import Data.Time (UTCTime)
+import Data.Typeable (Typeable)
+import Database.Persist (PersistField(..))
+import Database.Persist.Sql (PersistFieldSql(..))
+import Web.PathPieces (PathPiece(..))
+import Yesod.Core (SessionMap)
+
+import qualified Crypto.Nonce as N
+import qualified Data.Aeson as A
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Base64.URL as B64URL
+import qualified Data.ByteString.Lazy as L
+import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+
+
+----------------------------------------------------------------------
+
+
+-- | The ID of a session.  Always 18 bytes base64url-encoded as
+-- 24 characters.
+--
+-- Implementation notes:
+--
+--   * Use 'fromPathPiece' for parsing untrusted input.
+--
+--   * Use 'generateSessionId' for securely generating new
+--   session IDs.
+newtype SessionId = S { unS :: Text }
+  deriving (Eq, Ord, Show, Read, Typeable)
+
+-- | Sanity checks input on 'fromPathPiece' (untrusted input).
+instance PathPiece SessionId where
+  toPathPiece = unS
+  fromPathPiece = checkSessionId
+
+-- | Does not do sanity checks (DB is trusted).
+instance PersistField SessionId where
+  toPersistValue = toPersistValue . unS
+  fromPersistValue = fmap S . fromPersistValue
+
+instance PersistFieldSql SessionId where
+  sqlType p = sqlType (fmap unS p)
+
+instance A.FromJSON SessionId where
+  parseJSON = fmap S . A.parseJSON
+
+instance A.ToJSON SessionId where
+  toJSON = A.toJSON . unS
+
+
+-- | (Internal) Check that the given text is a base64url-encoded
+-- representation of 18 bytes.
+checkSessionId :: Text -> Maybe SessionId
+checkSessionId text = do
+  guard (T.length text == 24)
+  let bs = TE.encodeUtf8 text
+  decoded <- either (const Nothing) Just $ B64URL.decode bs
+  guard (B.length decoded == 18)
+  return $ S $ T.toLower text
+
+
+-- | Securely generate a new SessionId.
+generateSessionId :: N.Generator -> IO SessionId
+generateSessionId = fmap S . N.nonce128urlT
+
+
+----------------------------------------------------------------------
+
+
+-- | Representation of a saved session.
+data Session =
+  Session
+    { sessionKey :: SessionId
+      -- ^ Session ID, primary key.
+    , sessionAuthId :: Maybe ByteString
+      -- ^ Value of "_ID" session key, separate from the rest.
+    , sessionData :: SessionMap
+      -- ^ Rest of the session data.
+    , sessionCreatedAt :: UTCTime
+      -- ^ When this session was created.
+    } deriving (Eq, Ord, Show, Typeable)
+
+
+----------------------------------------------------------------------
+
+
+-- | A storage backend for server-side sessions.
+class MonadIO (TransactionM s) => Storage s where
+  -- | Monad where transactions happen for this backend.
+  -- We do not require transactions to be ACID.
+  type TransactionM s :: * -> *
+
+  -- | Run a transaction on the IO monad.
+  runTransactionM :: s -> TransactionM s a -> IO a
+
+  -- | Get the session for the given session ID.
+  getSession :: s -> SessionId -> TransactionM s (Maybe Session)
+
+  -- | Delete the session with given session ID.
+  deleteSession :: s -> SessionId -> TransactionM s ()
+
+  -- | Delete all sessions of the given auth ID.
+  deleteAllSessionsOfAuthId :: s -> ByteString -> TransactionM s ()
+
+  -- | Insert a new session.
+  insertSession :: s -> Session -> TransactionM s ()
+
+  -- | Replace the contents of a session.
+  replaceSession :: s -> Session -> TransactionM s ()
+
+
+----------------------------------------------------------------------
+
+
+-- | Newtype of a 'ByteString' with JSON support via base64url.
+newtype ByteStringJ = B { unB :: ByteString }
+  deriving (Eq, Ord, Show, Read, Typeable)
+
+instance PersistField ByteStringJ where
+  toPersistValue = toPersistValue . unB
+  fromPersistValue = fmap B . fromPersistValue
+
+instance PersistFieldSql ByteStringJ where
+  sqlType p = sqlType (fmap unB p)
+
+instance A.FromJSON ByteStringJ where
+  parseJSON (A.String t) =
+    either (const mzero) (return . B) $
+    B64URL.decode $
+    TE.encodeUtf8 t
+  parseJSON _ = mzero
+
+instance A.ToJSON ByteStringJ where
+  toJSON = A.String . TE.decodeUtf8 . B64URL.encode . unB
+
+
+----------------------------------------------------------------------
+
+
+-- | Newtype of a 'SessionMap' that serializes as a JSON on
+-- the database.  We use JSON because it's easy to inspect for a
+-- human.
+newtype SessionMapJ = M { unM :: SessionMap }
+  deriving (Eq, Ord, Show, Read, Typeable)
+
+encodeT :: A.ToJSON a => a -> Text
+encodeT = TE.decodeUtf8 . L.toStrict . A.encode
+
+decodeT :: A.FromJSON a => Text -> Either Text a
+decodeT = either (Left . T.pack) Right . A.eitherDecode . L.fromStrict . TE.encodeUtf8
+
+instance PersistField SessionMapJ where
+  toPersistValue = toPersistValue . encodeT
+  fromPersistValue = fromPersistValue >=> decodeT
+
+instance PersistFieldSql SessionMapJ where
+  sqlType p = sqlType (fmap encodeT p)
+
+instance A.FromJSON SessionMapJ where
+  parseJSON = fmap fixup . A.parseJSON
+    where
+      fixup :: M.Map Text ByteStringJ -> SessionMapJ
+      fixup = M . fmap unB
+
+instance A.ToJSON SessionMapJ where
+  toJSON = A.toJSON . mangle
+    where
+      mangle :: SessionMapJ -> M.Map Text ByteStringJ
+      mangle = fmap B . unM

yesod-persistent-session/yesod-persistent-session.cabal

@@ -0,0 +1,59 @@
+name:            yesod-persistent-session
+version:         1.0
+license:         MIT
+license-file:    LICENSE
+author:          Felipe Lessa <felipe.lessa@gmail.com>
+maintainer:      Felipe Lessa <felipe.lessa@gmail.com>
+synopsis:        Server-side session backend using persistent.
+category:        Web, Yesod, Database
+stability:       Stable
+cabal-version:   >= 1.8
+build-type:      Simple
+homepage:        http://www.yesodweb.com/
+description:     API docs and the README are available at <http://www.stackage.org/package/yesod-persistent-session>
+extra-source-files: README.md ChangeLog.md
+
+library
+  hs-source-dirs: src
+  build-depends:
+      base                      == 4.*
+    , aeson
+    , base64-bytestring         == 1.0.*
+    , bytestring
+    , containers
+    , cookie                    >= 0.4
+    , data-default
+    , nonce                     == 1.0.*
+    , path-pieces
+    , persistent                == 2.1.*
+    , persistent-template       == 2.1.*
+    , resource-pool
+    , text
+    , time
+    , transformers
+    , wai
+    , yesod-core                == 1.4.*
+  exposed-modules:
+    Yesod.Persist.Session
+    Yesod.Persist.Session.Internal.Backend
+    Yesod.Persist.Session.Internal.Sql
+    Yesod.Persist.Session.Internal.Types
+  extensions:
+    DeriveDataTypeable
+    EmptyDataDecls
+    FlexibleContexts
+    FlexibleInstances
+    GADTs
+    GeneralizedNewtypeDeriving
+    OverloadedStrings
+    QuasiQuotes
+    RecordWildCards
+    ScopedTypeVariables
+    TemplateHaskell
+    TypeFamilies
+  ghc-options:     -Wall
+
+
+source-repository head
+  type:     git
+  location: https://github.com/yesodweb/yesod