{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecordWildCards, Rank2Types, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |

This module provides a simple session implementation which stores
session data on the client as a cookie value.

The cookie values are stored in an encrypted cookie to make it more
difficult for users to tamper with the values. However, this does not
prevent replay attacks, and should not be seen as a substitute for
using HTTPS. Additionally, the cryptography libraries used to encrypt
the cookie have never been audited. Hence you are encouraged to think
carefully about what data you put in the session data.

Another important thing to realize is client-side sessions do not
provide Isolation. Imagine if the browser makes multiple simultaneous
requests, which each modify the session data. The browser will submit
the same cookie for each the requests, and each request handling
thread will get their own copy of the session data. The threads will
then modify their local copies independently and send their modified
values back to the browser, overwriting each other. The final value
will be determined by which ever request is sent last, and any changes
made by the other request will be entirely lost.

This means that clientsessions would not be suitable for implementing
a request counter, because if overlapping requests are made, the count
will be off. The count will only be accurate if the requests are
processed sequentially. That said, the demo code implements a request
counter anyway, because it is short and sweet. Also, this caveat was
forgotten when the example code was being written.

If you only modify the session data for POST requests, but not GET
requests you are less likely to run into situations where you are
losing changes, because there are not a lot of cases where a client
will be submitting multiple POST requests in parallel. Though there is
no guarantee.

Alternatively, you can choose to /only/ store data where it is OK if
modifications are lost. For example, if the session data contains only
a userid and the time of the last request they made, then there is no
great loss if some of the modifications are lost, because the access
times are going to all be about the same anyway.

By default the client will need to submit the cookie that contains the
client session data for every request (including images, and other
static assets). So, storing a large amount of data in the client
session will make requests slower and is not recommended. If you have
assets which can be served with out examining the client session data
you can use the 'sessionPath' and 'sessionDomain' parameters of
'SessionConf' to limit when the browser sends the session data cookie.

The first thing you need to do is enable some extensions which can be
done via a @LANGUAGE@ pragma at the top of your app:

 {\-\# LANGUAGE DeriveDataTypeable, TemplateHaskell #\-\}

Then you will need some imports:

> module Main where
>
> import Happstack.Server   (ServerPartT, Response, simpleHTTP
>                          , nullConf, nullDir, ok, toResponse
>                          )
> import Happstack.Server.ClientSession
>                           ( ClientSession(..), ClientSessionT(..)
>                          , getDefaultKey, mkSessionConf
>                          , liftSessionStateT, withClientSessionT
>                          )
> import Data.Data          (Data, Typeable)
> import Data.Lens          ((+=))
> import Data.Lens.Template (makeLens)
> import Data.SafeCopy      (base, deriveSafeCopy)

Next you will want to create a type to hold your session data. Here we
use a simple record which we will update using @data-lens-fd@. But,
you could also store a, @Map Text Text@, or whatever suits your fancy
as long as it can be serialized. (So no data types that include
functions, existential types, etc).

> data SessionData = SessionData
>     { _count    :: Integer
>     }
>    deriving (Eq, Ord, Read, Show, Data, Typeable)
>
> -- | here we make it a lens, but that is not required
> $(makeLens ''SessionData)

We use the @safecopy@ library to serialize the data so we can encrypt
it and store it in a cookie. @safecopy@ provides version migration,
which means that we will be able to read-in old session data if we
change the data type. The easiest way to create a 'SafeCopy' instance
is with 'deriveSafeCopy':

> $(deriveSafeCopy 0 'base ''SessionData)

We also need to define what an 'emptySession' looks like. This will be
used for creating new sessions when the client does not already have
one:

> instance ClientSession SessionData where
>     emptySession = SessionData { _count = 0 }

Next we have a function which reads a client-specific page counter and returns
the number of times the page has been reloaded.

In this function we use, 'liftSessionStateT' to lift the '+=' lens
function into 'ClientSessionT' to increment and return the value
stored in the client session.

Alternatively, we could have used the 'getSession' and 'putSession'
functions from 'MonadClientSession'. Those functions do not require
the use of 'liftSessionStateT'.

> routes :: ClientSessionT SessionData (ServerPartT IO) Response
> routes =
>     do nullDir
>        c <- liftSessionStateT $ count += 1
>        ok $ toResponse $ "you have viewed this page " ++ (show c) ++ " time(s)."

Finally, we unwrap the 'ClientSessionT' monad transformer using 'withClientSessionT'.

The 'SessionConf' type requires an encryption key. You can generate
the key using 'getDefaultKey' uses a default filename. Alternatively,
you can specific the name you want to use explicitly using
'getKey'. The key will be created automatically if it does not already
exist.

If you change the key, all existing client sessions will be invalidated.

> main :: IO ()
> main =
>     do key <- getDefaultKey
>        let sessionConf = mkSessionConf key
>        simpleHTTP nullConf $ withClientSessionT sessionConf $ routes

In a real application you might want to use a @newtype@ wrapper around
'ClientSessionT' to keep your type signatures sane. An alternative
version of this demo which does that can be found here:

<http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-clientsession/demo/demo.hs>

-}
module Happstack.Server.ClientSession
  ( -- * Happstack.Server.ClientSession
    ClientSession(..)
  , SessionStatus(..)
  , MonadClientSession(getSession, putSession, expireSession)
  , SessionConf(..)
  , mkSessionConf
  , ClientSessionT(..)
  , mapClientSessionT
  , runClientSessionT
  , withClientSessionT
  , SessionStateT
  , mapSessionStateT
  , liftSessionStateT
  , askSessionConf
    -- * Exported from @Web.ClientSession@
  , Key
  , getKey
  , getDefaultKey
  , randomKey
  ) where

import Control.Applicative   (Applicative, Alternative, optional)
import Control.Monad         (MonadPlus(..), liftM)
import Control.Monad.Base    (MonadBase)
import Control.Monad.Cont    (MonadCont, ContT)
import Control.Monad.Error   (MonadError, ErrorT, Error)
import Control.Monad.Fix     (MonadFix)
import Control.Monad.Reader  (MonadReader(ask, local), ReaderT(..), mapReaderT)
import Control.Monad.State   (MonadState(get,put), StateT(..), mapStateT)
import Control.Monad.Writer  (MonadWriter(tell, listen, pass), WriterT(..))
import Control.Monad.RWS     (MonadRWS, RWST)
import Control.Monad.Trans   (MonadIO(liftIO), MonadTrans(lift))
import Control.Monad.Trans.Control               ( MonadTransControl(..)
                                                 , MonadBaseControl(..)
                                                 , ComposeSt, defaultLiftBaseWith, defaultRestoreM
                                                 )
import Data.ByteString.Char8 (pack, unpack)
import Data.Semigroup        (Semigroup(..))
import Data.Monoid           (Monoid(..))
import Data.SafeCopy         (SafeCopy(getCopy, putCopy), contain, safeGet, safePut)
import Data.Serialize        (runGet, runPut)
import Happstack.Server      ( HasRqData, FilterMonad, WebMonad, ServerMonad, Happstack, Response
                             , CookieLife(Session), Cookie(secure,cookiePath, cookieDomain, httpOnly)
                             , lookCookieValue, addCookie, mkCookie, expireCookie
                             )
import Web.ClientSession     (Key, getKey, getDefaultKey, randomKey, decrypt, encryptIO)

import qualified Data.Serialize as S

instance SafeCopy Key where
    getCopy :: Contained (Get Key)
getCopy = Get Key -> Contained (Get Key)
forall a. a -> Contained a
contain (Get Key -> Contained (Get Key)) -> Get Key -> Contained (Get Key)
forall a b. (a -> b) -> a -> b
$ Get Key
forall t. Serialize t => Get t
S.get
    putCopy :: Key -> Contained Put
putCopy = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put) -> (Key -> Put) -> Key -> Contained Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Put
forall t. Serialize t => Putter t
S.put

------------------------------------------------------------------------------
-- class ClientSession
------------------------------------------------------------------------------

-- | Your session type must have an instance for this class.
class SafeCopy st => ClientSession st where
  -- | An empty session, i.e. what you get when there is no existing
  -- session stored.
  emptySession :: st

------------------------------------------------------------------------------
-- SessionConf
------------------------------------------------------------------------------

-- | Configuration for the session cookie for passing to 'runClientSessionT' or 'withClientSessionT'.
data SessionConf = SessionConf
    { SessionConf -> String
sessionCookieName :: String      -- ^ Name of the cookie to hold your session data.
    , SessionConf -> CookieLife
sessionCookieLife :: CookieLife  -- ^ Lifetime of that cookie.
    , SessionConf -> Key
sessionKey        :: Key         -- ^ Encryption key, usually from one of 'getKey', 'getDefaultKey' and 'randomKey'.
    , SessionConf -> String
sessionDomain     :: String      -- ^ cookie domain
    , SessionConf -> String
sessionPath       :: String      -- ^ cookie path
    , SessionConf -> Bool
sessionSecure     :: Bool        -- ^ Only use a session over secure transports.
    , SessionConf -> Bool
sessionHttpOnly   :: Bool        -- ^ Only use session over HTTP (to prevent it from being stolen via cross-site scripting)
    }

-- | Create a 'SessionConf' using defaults for everything except
-- 'sessionKey'.  You can use record update syntax to override individual
-- fields.
--
-- > main = do key <- getDefaultKey
-- >           let sessConf = (mkSessionConf key) { sessionCookieLife = oneWeek }
-- >           simpleHTTP nullConf $ withClientSessionT sessConf handlers
-- >   where
-- >     oneWeek  = MaxAge $ 60 * 60 * 24 * 7
-- >     handlers = msum [...]
--
-- 'mkSessionConf' is currently defined as:
--
-- > mkSessionConf :: Key -> SessionConf
-- > mkSessionConf key = SessionConf
-- >    { sessionCookieName = "Happstack.ClientSession"
-- >    , sessionCookieLife = Session
-- >    , sessionKey        = key
-- >    , sessionDomain     = ""
-- >    , sessionPath       = "/"
-- >    , sessionSecure     = False
-- >    , sessionHttpOnly   = True
-- >    }
--
-- see also: 'getKey', 'getDefaultKey'
mkSessionConf :: Key -> SessionConf
mkSessionConf :: Key -> SessionConf
mkSessionConf Key
key = SessionConf :: String
-> CookieLife
-> Key
-> String
-> String
-> Bool
-> Bool
-> SessionConf
SessionConf
    { sessionCookieName :: String
sessionCookieName = String
"Happstack.ClientSession"
    , sessionCookieLife :: CookieLife
sessionCookieLife = CookieLife
Session
    , sessionKey :: Key
sessionKey        = Key
key
    , sessionDomain :: String
sessionDomain     = String
""
    , sessionPath :: String
sessionPath       = String
"/"
    , sessionSecure :: Bool
sessionSecure     = Bool
False
    , sessionHttpOnly :: Bool
sessionHttpOnly   = Bool
True
    }

------------------------------------------------------------------------------
-- SessionStateT
------------------------------------------------------------------------------

-- | Wrapper around the sessionData which tracks it state so we can
-- avoid decoding or encoding/sending the cookie when not required
data SessionStatus sessionData = Unread | NoChange sessionData | Modified sessionData  | Expired
      deriving (SessionStatus sessionData -> SessionStatus sessionData -> Bool
(SessionStatus sessionData -> SessionStatus sessionData -> Bool)
-> (SessionStatus sessionData -> SessionStatus sessionData -> Bool)
-> Eq (SessionStatus sessionData)
forall sessionData.
Eq sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionStatus sessionData -> SessionStatus sessionData -> Bool
$c/= :: forall sessionData.
Eq sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Bool
== :: SessionStatus sessionData -> SessionStatus sessionData -> Bool
$c== :: forall sessionData.
Eq sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Bool
Eq, Eq (SessionStatus sessionData)
Eq (SessionStatus sessionData)
-> (SessionStatus sessionData
    -> SessionStatus sessionData -> Ordering)
-> (SessionStatus sessionData -> SessionStatus sessionData -> Bool)
-> (SessionStatus sessionData -> SessionStatus sessionData -> Bool)
-> (SessionStatus sessionData -> SessionStatus sessionData -> Bool)
-> (SessionStatus sessionData -> SessionStatus sessionData -> Bool)
-> (SessionStatus sessionData
    -> SessionStatus sessionData -> SessionStatus sessionData)
-> (SessionStatus sessionData
    -> SessionStatus sessionData -> SessionStatus sessionData)
-> Ord (SessionStatus sessionData)
SessionStatus sessionData -> SessionStatus sessionData -> Bool
SessionStatus sessionData -> SessionStatus sessionData -> Ordering
SessionStatus sessionData
-> SessionStatus sessionData -> SessionStatus sessionData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall sessionData.
Ord sessionData =>
Eq (SessionStatus sessionData)
forall sessionData.
Ord sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Bool
forall sessionData.
Ord sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Ordering
forall sessionData.
Ord sessionData =>
SessionStatus sessionData
-> SessionStatus sessionData -> SessionStatus sessionData
min :: SessionStatus sessionData
-> SessionStatus sessionData -> SessionStatus sessionData
$cmin :: forall sessionData.
Ord sessionData =>
SessionStatus sessionData
-> SessionStatus sessionData -> SessionStatus sessionData
max :: SessionStatus sessionData
-> SessionStatus sessionData -> SessionStatus sessionData
$cmax :: forall sessionData.
Ord sessionData =>
SessionStatus sessionData
-> SessionStatus sessionData -> SessionStatus sessionData
>= :: SessionStatus sessionData -> SessionStatus sessionData -> Bool
$c>= :: forall sessionData.
Ord sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Bool
> :: SessionStatus sessionData -> SessionStatus sessionData -> Bool
$c> :: forall sessionData.
Ord sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Bool
<= :: SessionStatus sessionData -> SessionStatus sessionData -> Bool
$c<= :: forall sessionData.
Ord sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Bool
< :: SessionStatus sessionData -> SessionStatus sessionData -> Bool
$c< :: forall sessionData.
Ord sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Bool
compare :: SessionStatus sessionData -> SessionStatus sessionData -> Ordering
$ccompare :: forall sessionData.
Ord sessionData =>
SessionStatus sessionData -> SessionStatus sessionData -> Ordering
$cp1Ord :: forall sessionData.
Ord sessionData =>
Eq (SessionStatus sessionData)
Ord, ReadPrec [SessionStatus sessionData]
ReadPrec (SessionStatus sessionData)
Int -> ReadS (SessionStatus sessionData)
ReadS [SessionStatus sessionData]
(Int -> ReadS (SessionStatus sessionData))
-> ReadS [SessionStatus sessionData]
-> ReadPrec (SessionStatus sessionData)
-> ReadPrec [SessionStatus sessionData]
-> Read (SessionStatus sessionData)
forall sessionData.
Read sessionData =>
ReadPrec [SessionStatus sessionData]
forall sessionData.
Read sessionData =>
ReadPrec (SessionStatus sessionData)
forall sessionData.
Read sessionData =>
Int -> ReadS (SessionStatus sessionData)
forall sessionData.
Read sessionData =>
ReadS [SessionStatus sessionData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SessionStatus sessionData]
$creadListPrec :: forall sessionData.
Read sessionData =>
ReadPrec [SessionStatus sessionData]
readPrec :: ReadPrec (SessionStatus sessionData)
$creadPrec :: forall sessionData.
Read sessionData =>
ReadPrec (SessionStatus sessionData)
readList :: ReadS [SessionStatus sessionData]
$creadList :: forall sessionData.
Read sessionData =>
ReadS [SessionStatus sessionData]
readsPrec :: Int -> ReadS (SessionStatus sessionData)
$creadsPrec :: forall sessionData.
Read sessionData =>
Int -> ReadS (SessionStatus sessionData)
Read, Int -> SessionStatus sessionData -> ShowS
[SessionStatus sessionData] -> ShowS
SessionStatus sessionData -> String
(Int -> SessionStatus sessionData -> ShowS)
-> (SessionStatus sessionData -> String)
-> ([SessionStatus sessionData] -> ShowS)
-> Show (SessionStatus sessionData)
forall sessionData.
Show sessionData =>
Int -> SessionStatus sessionData -> ShowS
forall sessionData.
Show sessionData =>
[SessionStatus sessionData] -> ShowS
forall sessionData.
Show sessionData =>
SessionStatus sessionData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionStatus sessionData] -> ShowS
$cshowList :: forall sessionData.
Show sessionData =>
[SessionStatus sessionData] -> ShowS
show :: SessionStatus sessionData -> String
$cshow :: forall sessionData.
Show sessionData =>
SessionStatus sessionData -> String
showsPrec :: Int -> SessionStatus sessionData -> ShowS
$cshowsPrec :: forall sessionData.
Show sessionData =>
Int -> SessionStatus sessionData -> ShowS
Show)

-- | 'SessionStateT' is like 'StateT', except it records if 'put' was ever called
newtype SessionStateT s m a = SessionStateT { SessionStateT s m a -> StateT (SessionStatus s) m a
unSessionStateT :: StateT (SessionStatus s) m a }
    deriving ( a -> SessionStateT s m b -> SessionStateT s m a
(a -> b) -> SessionStateT s m a -> SessionStateT s m b
(forall a b.
 (a -> b) -> SessionStateT s m a -> SessionStateT s m b)
-> (forall a b. a -> SessionStateT s m b -> SessionStateT s m a)
-> Functor (SessionStateT s m)
forall a b. a -> SessionStateT s m b -> SessionStateT s m a
forall a b. (a -> b) -> SessionStateT s m a -> SessionStateT s m b
forall s (m :: * -> *) a b.
Functor m =>
a -> SessionStateT s m b -> SessionStateT s m a
forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> SessionStateT s m a -> SessionStateT s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SessionStateT s m b -> SessionStateT s m a
$c<$ :: forall s (m :: * -> *) a b.
Functor m =>
a -> SessionStateT s m b -> SessionStateT s m a
fmap :: (a -> b) -> SessionStateT s m a -> SessionStateT s m b
$cfmap :: forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> SessionStateT s m a -> SessionStateT s m b
Functor, Functor (SessionStateT s m)
a -> SessionStateT s m a
Functor (SessionStateT s m)
-> (forall a. a -> SessionStateT s m a)
-> (forall a b.
    SessionStateT s m (a -> b)
    -> SessionStateT s m a -> SessionStateT s m b)
-> (forall a b c.
    (a -> b -> c)
    -> SessionStateT s m a
    -> SessionStateT s m b
    -> SessionStateT s m c)
-> (forall a b.
    SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b)
-> (forall a b.
    SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m a)
-> Applicative (SessionStateT s m)
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m a
SessionStateT s m (a -> b)
-> SessionStateT s m a -> SessionStateT s m b
(a -> b -> c)
-> SessionStateT s m a
-> SessionStateT s m b
-> SessionStateT s m c
forall a. a -> SessionStateT s m a
forall a b.
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m a
forall a b.
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
forall a b.
SessionStateT s m (a -> b)
-> SessionStateT s m a -> SessionStateT s m b
forall a b c.
(a -> b -> c)
-> SessionStateT s m a
-> SessionStateT s m b
-> SessionStateT s m c
forall s (m :: * -> *). Monad m => Functor (SessionStateT s m)
forall s (m :: * -> *) a. Monad m => a -> SessionStateT s m a
forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m a
forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m (a -> b)
-> SessionStateT s m a -> SessionStateT s m b
forall s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SessionStateT s m a
-> SessionStateT s m b
-> SessionStateT s m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m a
$c<* :: forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m a
*> :: SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
$c*> :: forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
liftA2 :: (a -> b -> c)
-> SessionStateT s m a
-> SessionStateT s m b
-> SessionStateT s m c
$cliftA2 :: forall s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SessionStateT s m a
-> SessionStateT s m b
-> SessionStateT s m c
<*> :: SessionStateT s m (a -> b)
-> SessionStateT s m a -> SessionStateT s m b
$c<*> :: forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m (a -> b)
-> SessionStateT s m a -> SessionStateT s m b
pure :: a -> SessionStateT s m a
$cpure :: forall s (m :: * -> *) a. Monad m => a -> SessionStateT s m a
$cp1Applicative :: forall s (m :: * -> *). Monad m => Functor (SessionStateT s m)
Applicative, Applicative (SessionStateT s m)
SessionStateT s m a
Applicative (SessionStateT s m)
-> (forall a. SessionStateT s m a)
-> (forall a.
    SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a)
-> (forall a. SessionStateT s m a -> SessionStateT s m [a])
-> (forall a. SessionStateT s m a -> SessionStateT s m [a])
-> Alternative (SessionStateT s m)
SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
SessionStateT s m a -> SessionStateT s m [a]
SessionStateT s m a -> SessionStateT s m [a]
forall a. SessionStateT s m a
forall a. SessionStateT s m a -> SessionStateT s m [a]
forall a.
SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
forall s (m :: * -> *).
MonadPlus m =>
Applicative (SessionStateT s m)
forall s (m :: * -> *) a. MonadPlus m => SessionStateT s m a
forall s (m :: * -> *) a.
MonadPlus m =>
SessionStateT s m a -> SessionStateT s m [a]
forall s (m :: * -> *) a.
MonadPlus m =>
SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: SessionStateT s m a -> SessionStateT s m [a]
$cmany :: forall s (m :: * -> *) a.
MonadPlus m =>
SessionStateT s m a -> SessionStateT s m [a]
some :: SessionStateT s m a -> SessionStateT s m [a]
$csome :: forall s (m :: * -> *) a.
MonadPlus m =>
SessionStateT s m a -> SessionStateT s m [a]
<|> :: SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
$c<|> :: forall s (m :: * -> *) a.
MonadPlus m =>
SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
empty :: SessionStateT s m a
$cempty :: forall s (m :: * -> *) a. MonadPlus m => SessionStateT s m a
$cp1Alternative :: forall s (m :: * -> *).
MonadPlus m =>
Applicative (SessionStateT s m)
Alternative, Applicative (SessionStateT s m)
a -> SessionStateT s m a
Applicative (SessionStateT s m)
-> (forall a b.
    SessionStateT s m a
    -> (a -> SessionStateT s m b) -> SessionStateT s m b)
-> (forall a b.
    SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b)
-> (forall a. a -> SessionStateT s m a)
-> Monad (SessionStateT s m)
SessionStateT s m a
-> (a -> SessionStateT s m b) -> SessionStateT s m b
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
forall a. a -> SessionStateT s m a
forall a b.
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
forall a b.
SessionStateT s m a
-> (a -> SessionStateT s m b) -> SessionStateT s m b
forall s (m :: * -> *). Monad m => Applicative (SessionStateT s m)
forall s (m :: * -> *) a. Monad m => a -> SessionStateT s m a
forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m a
-> (a -> SessionStateT s m b) -> SessionStateT s m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SessionStateT s m a
$creturn :: forall s (m :: * -> *) a. Monad m => a -> SessionStateT s m a
>> :: SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
$c>> :: forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m a -> SessionStateT s m b -> SessionStateT s m b
>>= :: SessionStateT s m a
-> (a -> SessionStateT s m b) -> SessionStateT s m b
$c>>= :: forall s (m :: * -> *) a b.
Monad m =>
SessionStateT s m a
-> (a -> SessionStateT s m b) -> SessionStateT s m b
$cp1Monad :: forall s (m :: * -> *). Monad m => Applicative (SessionStateT s m)
Monad, Monad (SessionStateT s m)
Alternative (SessionStateT s m)
SessionStateT s m a
Alternative (SessionStateT s m)
-> Monad (SessionStateT s m)
-> (forall a. SessionStateT s m a)
-> (forall a.
    SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a)
-> MonadPlus (SessionStateT s m)
SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
forall a. SessionStateT s m a
forall a.
SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
forall s (m :: * -> *). MonadPlus m => Monad (SessionStateT s m)
forall s (m :: * -> *).
MonadPlus m =>
Alternative (SessionStateT s m)
forall s (m :: * -> *) a. MonadPlus m => SessionStateT s m a
forall s (m :: * -> *) a.
MonadPlus m =>
SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
$cmplus :: forall s (m :: * -> *) a.
MonadPlus m =>
SessionStateT s m a -> SessionStateT s m a -> SessionStateT s m a
mzero :: SessionStateT s m a
$cmzero :: forall s (m :: * -> *) a. MonadPlus m => SessionStateT s m a
$cp2MonadPlus :: forall s (m :: * -> *). MonadPlus m => Monad (SessionStateT s m)
$cp1MonadPlus :: forall s (m :: * -> *).
MonadPlus m =>
Alternative (SessionStateT s m)
MonadPlus, MonadBase b, Monad (SessionStateT s m)
Monad (SessionStateT s m)
-> (forall a. IO a -> SessionStateT s m a)
-> MonadIO (SessionStateT s m)
IO a -> SessionStateT s m a
forall a. IO a -> SessionStateT s m a
forall s (m :: * -> *). MonadIO m => Monad (SessionStateT s m)
forall s (m :: * -> *) a. MonadIO m => IO a -> SessionStateT s m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SessionStateT s m a
$cliftIO :: forall s (m :: * -> *) a. MonadIO m => IO a -> SessionStateT s m a
$cp1MonadIO :: forall s (m :: * -> *). MonadIO m => Monad (SessionStateT s m)
MonadIO, Monad (SessionStateT s m)
Monad (SessionStateT s m)
-> (forall a. (a -> SessionStateT s m a) -> SessionStateT s m a)
-> MonadFix (SessionStateT s m)
(a -> SessionStateT s m a) -> SessionStateT s m a
forall a. (a -> SessionStateT s m a) -> SessionStateT s m a
forall s (m :: * -> *). MonadFix m => Monad (SessionStateT s m)
forall s (m :: * -> *) a.
MonadFix m =>
(a -> SessionStateT s m a) -> SessionStateT s m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SessionStateT s m a) -> SessionStateT s m a
$cmfix :: forall s (m :: * -> *) a.
MonadFix m =>
(a -> SessionStateT s m a) -> SessionStateT s m a
$cp1MonadFix :: forall s (m :: * -> *). MonadFix m => Monad (SessionStateT s m)
MonadFix, MonadError e, Monad (SessionStateT s m)
Monad (SessionStateT s m)
-> (forall a b.
    ((a -> SessionStateT s m b) -> SessionStateT s m a)
    -> SessionStateT s m a)
-> MonadCont (SessionStateT s m)
((a -> SessionStateT s m b) -> SessionStateT s m a)
-> SessionStateT s m a
forall a b.
((a -> SessionStateT s m b) -> SessionStateT s m a)
-> SessionStateT s m a
forall s (m :: * -> *). MonadCont m => Monad (SessionStateT s m)
forall s (m :: * -> *) a b.
MonadCont m =>
((a -> SessionStateT s m b) -> SessionStateT s m a)
-> SessionStateT s m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
callCC :: ((a -> SessionStateT s m b) -> SessionStateT s m a)
-> SessionStateT s m a
$ccallCC :: forall s (m :: * -> *) a b.
MonadCont m =>
((a -> SessionStateT s m b) -> SessionStateT s m a)
-> SessionStateT s m a
$cp1MonadCont :: forall s (m :: * -> *). MonadCont m => Monad (SessionStateT s m)
MonadCont
             , m a -> SessionStateT s m a
(forall (m :: * -> *) a. Monad m => m a -> SessionStateT s m a)
-> MonadTrans (SessionStateT s)
forall s (m :: * -> *) a. Monad m => m a -> SessionStateT s m a
forall (m :: * -> *) a. Monad m => m a -> SessionStateT s m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> SessionStateT s m a
$clift :: forall s (m :: * -> *) a. Monad m => m a -> SessionStateT s m a
MonadTrans, SessionStateT s m RqEnv
Errors String -> SessionStateT s m a
SessionStateT s m RqEnv
-> (forall a.
    (RqEnv -> RqEnv) -> SessionStateT s m a -> SessionStateT s m a)
-> (forall a. Errors String -> SessionStateT s m a)
-> HasRqData (SessionStateT s m)
(RqEnv -> RqEnv) -> SessionStateT s m a -> SessionStateT s m a
forall a. Errors String -> SessionStateT s m a
forall a.
(RqEnv -> RqEnv) -> SessionStateT s m a -> SessionStateT s m a
forall s (m :: * -> *).
(Monad m, HasRqData m) =>
SessionStateT s m RqEnv
forall s (m :: * -> *) a.
(Monad m, HasRqData m) =>
Errors String -> SessionStateT s m a
forall s (m :: * -> *) a.
(Monad m, HasRqData m) =>
(RqEnv -> RqEnv) -> SessionStateT s m a -> SessionStateT s m a
forall (m :: * -> *).
m RqEnv
-> (forall a. (RqEnv -> RqEnv) -> m a -> m a)
-> (forall a. Errors String -> m a)
-> HasRqData m
rqDataError :: Errors String -> SessionStateT s m a
$crqDataError :: forall s (m :: * -> *) a.
(Monad m, HasRqData m) =>
Errors String -> SessionStateT s m a
localRqEnv :: (RqEnv -> RqEnv) -> SessionStateT s m a -> SessionStateT s m a
$clocalRqEnv :: forall s (m :: * -> *) a.
(Monad m, HasRqData m) =>
(RqEnv -> RqEnv) -> SessionStateT s m a -> SessionStateT s m a
askRqEnv :: SessionStateT s m RqEnv
$caskRqEnv :: forall s (m :: * -> *).
(Monad m, HasRqData m) =>
SessionStateT s m RqEnv
HasRqData, FilterMonad r, WebMonad r, Monad (SessionStateT s m)
SessionStateT s m Request
Monad (SessionStateT s m)
-> SessionStateT s m Request
-> (forall a.
    (Request -> Request) -> SessionStateT s m a -> SessionStateT s m a)
-> ServerMonad (SessionStateT s m)
(Request -> Request) -> SessionStateT s m a -> SessionStateT s m a
forall a.
(Request -> Request) -> SessionStateT s m a -> SessionStateT s m a
forall s (m :: * -> *). ServerMonad m => Monad (SessionStateT s m)
forall s (m :: * -> *). ServerMonad m => SessionStateT s m Request
forall s (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> SessionStateT s m a -> SessionStateT s m a
forall (m :: * -> *).
Monad m
-> m Request
-> (forall a. (Request -> Request) -> m a -> m a)
-> ServerMonad m
localRq :: (Request -> Request) -> SessionStateT s m a -> SessionStateT s m a
$clocalRq :: forall s (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> SessionStateT s m a -> SessionStateT s m a
askRq :: SessionStateT s m Request
$caskRq :: forall s (m :: * -> *). ServerMonad m => SessionStateT s m Request
$cp1ServerMonad :: forall s (m :: * -> *). ServerMonad m => Monad (SessionStateT s m)
ServerMonad)

instance Happstack m => Happstack (SessionStateT sessionData m)

instance (MonadPlus m) => Semigroup (SessionStateT sessionData m a) where
    <> :: SessionStateT sessionData m a
-> SessionStateT sessionData m a -> SessionStateT sessionData m a
(<>) = SessionStateT sessionData m a
-> SessionStateT sessionData m a -> SessionStateT sessionData m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance (MonadPlus m) => Monoid (SessionStateT sessionData m a) where
    mempty :: SessionStateT sessionData m a
mempty  = SessionStateT sessionData m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    mappend :: SessionStateT sessionData m a
-> SessionStateT sessionData m a -> SessionStateT sessionData m a
mappend = SessionStateT sessionData m a
-> SessionStateT sessionData m a -> SessionStateT sessionData m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance (Monad m, ClientSession sessionData) => MonadState sessionData (SessionStateT sessionData m)  where
    get :: SessionStateT sessionData m sessionData
get   = StateT (SessionStatus sessionData) m sessionData
-> SessionStateT sessionData m sessionData
forall s (m :: * -> *) a.
StateT (SessionStatus s) m a -> SessionStateT s m a
SessionStateT (StateT (SessionStatus sessionData) m sessionData
 -> SessionStateT sessionData m sessionData)
-> StateT (SessionStatus sessionData) m sessionData
-> SessionStateT sessionData m sessionData
forall a b. (a -> b) -> a -> b
$ do SessionStatus sessionData
sd <- StateT (SessionStatus sessionData) m (SessionStatus sessionData)
forall s (m :: * -> *). MonadState s m => m s
get
                               case SessionStatus sessionData
sd of
                                 (NoChange sessionData
sd') -> sessionData -> StateT (SessionStatus sessionData) m sessionData
forall (m :: * -> *) a. Monad m => a -> m a
return sessionData
sd'
                                 (Modified sessionData
sd') -> sessionData -> StateT (SessionStatus sessionData) m sessionData
forall (m :: * -> *) a. Monad m => a -> m a
return sessionData
sd'
                                 SessionStatus sessionData
_              -> sessionData -> StateT (SessionStatus sessionData) m sessionData
forall (m :: * -> *) a. Monad m => a -> m a
return sessionData
forall st. ClientSession st => st
emptySession
    put :: sessionData -> SessionStateT sessionData m ()
put sessionData
a = StateT (SessionStatus sessionData) m ()
-> SessionStateT sessionData m ()
forall s (m :: * -> *) a.
StateT (SessionStatus s) m a -> SessionStateT s m a
SessionStateT (StateT (SessionStatus sessionData) m ()
 -> SessionStateT sessionData m ())
-> StateT (SessionStatus sessionData) m ()
-> SessionStateT sessionData m ()
forall a b. (a -> b) -> a -> b
$ SessionStatus sessionData
-> StateT (SessionStatus sessionData) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (sessionData -> SessionStatus sessionData
forall sessionData. sessionData -> SessionStatus sessionData
Modified sessionData
a)

instance MonadTransControl (SessionStateT s) where
    type StT (SessionStateT s) a = StT (StateT (SessionStatus s)) a
    liftWith :: (Run (SessionStateT s) -> m a) -> SessionStateT s m a
liftWith Run (SessionStateT s) -> m a
f =
        (Run (SessionStateT s) -> m a) -> SessionStateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (SessionStateT s) -> m a) -> SessionStateT s m a)
-> (Run (SessionStateT s) -> m a) -> SessionStateT s m a
forall a b. (a -> b) -> a -> b
$ \Run (SessionStateT s)
runStateT' ->
            Run (SessionStateT s) -> m a
f (Run (SessionStateT s) -> m a) -> Run (SessionStateT s) -> m a
forall a b. (a -> b) -> a -> b
$ Run (SessionStateT s)
runStateT'
    restoreT :: m (StT (SessionStateT s) a) -> SessionStateT s m a
restoreT = m (StT (SessionStateT s) a) -> SessionStateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT

instance MonadBaseControl b m => MonadBaseControl b (SessionStateT s m) where
    type StM (SessionStateT s m) a = ComposeSt (SessionStateT s) m a
    liftBaseWith :: (RunInBase (SessionStateT s m) b -> b a) -> SessionStateT s m a
liftBaseWith = (RunInBase (SessionStateT s m) b -> b a) -> SessionStateT s m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
    restoreM :: StM (SessionStateT s m) a -> SessionStateT s m a
restoreM     = StM (SessionStateT s m) a -> SessionStateT s m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

-- | run 'SessionStateT' and get the result, plus the final @SessionStatus sessionData@
runSessionStateT :: SessionStateT sessionData m a -> SessionStatus sessionData -> m (a, SessionStatus sessionData)
runSessionStateT :: SessionStateT sessionData m a
-> SessionStatus sessionData -> m (a, SessionStatus sessionData)
runSessionStateT = StateT (SessionStatus sessionData) m a
-> SessionStatus sessionData -> m (a, SessionStatus sessionData)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT (SessionStatus sessionData) m a
 -> SessionStatus sessionData -> m (a, SessionStatus sessionData))
-> (SessionStateT sessionData m a
    -> StateT (SessionStatus sessionData) m a)
-> SessionStateT sessionData m a
-> SessionStatus sessionData
-> m (a, SessionStatus sessionData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionStateT sessionData m a
-> StateT (SessionStatus sessionData) m a
forall s (m :: * -> *) a.
SessionStateT s m a -> StateT (SessionStatus s) m a
unSessionStateT

-- | Transform the inner monad. (similar to 'mapStateT')
--
-- The @forall s.@ is to prevent you from modifying the session state.
--
-- In theory we want this function to have the type:
--
-- > mapSessionStateT :: (m a -> n b) -> SessionStateT s m a -> SessionStateT s n b
--
-- But that can not be done, so this is the next best thing.
--
mapSessionStateT :: (forall s. m (a, s) -> n (b, s))
                 -> SessionStateT sessionData m a
                 -> SessionStateT sessionData n b
mapSessionStateT :: (forall s. m (a, s) -> n (b, s))
-> SessionStateT sessionData m a -> SessionStateT sessionData n b
mapSessionStateT forall s. m (a, s) -> n (b, s)
f (SessionStateT StateT (SessionStatus sessionData) m a
m) =
    StateT (SessionStatus sessionData) n b
-> SessionStateT sessionData n b
forall s (m :: * -> *) a.
StateT (SessionStatus s) m a -> SessionStateT s m a
SessionStateT (StateT (SessionStatus sessionData) n b
 -> SessionStateT sessionData n b)
-> StateT (SessionStatus sessionData) n b
-> SessionStateT sessionData n b
forall a b. (a -> b) -> a -> b
$ (m (a, SessionStatus sessionData)
 -> n (b, SessionStatus sessionData))
-> StateT (SessionStatus sessionData) m a
-> StateT (SessionStatus sessionData) n b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (a, SessionStatus sessionData)
-> n (b, SessionStatus sessionData)
forall s. m (a, s) -> n (b, s)
f StateT (SessionStatus sessionData) m a
m

-- | similar to 'mapStateT'. This version allows modification of the session data
mapSessionStateT_ :: (m (a, SessionStatus s) -> n (b, SessionStatus s))
                 -> SessionStateT s m a
                 -> SessionStateT s n b
mapSessionStateT_ :: (m (a, SessionStatus s) -> n (b, SessionStatus s))
-> SessionStateT s m a -> SessionStateT s n b
mapSessionStateT_ m (a, SessionStatus s) -> n (b, SessionStatus s)
f (SessionStateT StateT (SessionStatus s) m a
m) = StateT (SessionStatus s) n b -> SessionStateT s n b
forall s (m :: * -> *) a.
StateT (SessionStatus s) m a -> SessionStateT s m a
SessionStateT (StateT (SessionStatus s) n b -> SessionStateT s n b)
-> StateT (SessionStatus s) n b -> SessionStateT s n b
forall a b. (a -> b) -> a -> b
$ (m (a, SessionStatus s) -> n (b, SessionStatus s))
-> StateT (SessionStatus s) m a -> StateT (SessionStatus s) n b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (a, SessionStatus s) -> n (b, SessionStatus s)
f StateT (SessionStatus s) m a
m

------------------------------------------------------------------------------
-- ClientSessionT
------------------------------------------------------------------------------

-- | 'ClientSessionT' provides an environment in which we can access and update the client-side session state
--
-- The inner monad needs to provide an instance of 'Happstack' so that
-- the cookie value can be read and set. According 'ClientSessionT'
-- must appear outside 'ServerPartT' not inside it.
newtype ClientSessionT sessionData m a = ClientSessionT { ClientSessionT sessionData m a
-> ReaderT SessionConf (SessionStateT sessionData m) a
unClientSessionT :: ReaderT SessionConf (SessionStateT sessionData m) a }
    deriving ( a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
(a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
(forall a b.
 (a -> b)
 -> ClientSessionT sessionData m a
 -> ClientSessionT sessionData m b)
-> (forall a b.
    a
    -> ClientSessionT sessionData m b
    -> ClientSessionT sessionData m a)
-> Functor (ClientSessionT sessionData m)
forall a b.
a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
forall a b.
(a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
forall sessionData (m :: * -> *) a b.
Functor m =>
a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *) a b.
Functor m =>
(a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
$c<$ :: forall sessionData (m :: * -> *) a b.
Functor m =>
a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
fmap :: (a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
$cfmap :: forall sessionData (m :: * -> *) a b.
Functor m =>
(a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
Functor, Functor (ClientSessionT sessionData m)
a -> ClientSessionT sessionData m a
Functor (ClientSessionT sessionData m)
-> (forall a. a -> ClientSessionT sessionData m a)
-> (forall a b.
    ClientSessionT sessionData m (a -> b)
    -> ClientSessionT sessionData m a
    -> ClientSessionT sessionData m b)
-> (forall a b c.
    (a -> b -> c)
    -> ClientSessionT sessionData m a
    -> ClientSessionT sessionData m b
    -> ClientSessionT sessionData m c)
-> (forall a b.
    ClientSessionT sessionData m a
    -> ClientSessionT sessionData m b
    -> ClientSessionT sessionData m b)
-> (forall a b.
    ClientSessionT sessionData m a
    -> ClientSessionT sessionData m b
    -> ClientSessionT sessionData m a)
-> Applicative (ClientSessionT sessionData m)
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
ClientSessionT sessionData m (a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
(a -> b -> c)
-> ClientSessionT sessionData m a
-> ClientSessionT sessionData m b
-> ClientSessionT sessionData m c
forall a. a -> ClientSessionT sessionData m a
forall a b.
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
forall a b.
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
forall a b.
ClientSessionT sessionData m (a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
forall a b c.
(a -> b -> c)
-> ClientSessionT sessionData m a
-> ClientSessionT sessionData m b
-> ClientSessionT sessionData m c
forall sessionData (m :: * -> *).
Monad m =>
Functor (ClientSessionT sessionData m)
forall sessionData (m :: * -> *) a.
Monad m =>
a -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m (a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
forall sessionData (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ClientSessionT sessionData m a
-> ClientSessionT sessionData m b
-> ClientSessionT sessionData m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
$c<* :: forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m a
*> :: ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
$c*> :: forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
liftA2 :: (a -> b -> c)
-> ClientSessionT sessionData m a
-> ClientSessionT sessionData m b
-> ClientSessionT sessionData m c
$cliftA2 :: forall sessionData (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ClientSessionT sessionData m a
-> ClientSessionT sessionData m b
-> ClientSessionT sessionData m c
<*> :: ClientSessionT sessionData m (a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
$c<*> :: forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m (a -> b)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m b
pure :: a -> ClientSessionT sessionData m a
$cpure :: forall sessionData (m :: * -> *) a.
Monad m =>
a -> ClientSessionT sessionData m a
$cp1Applicative :: forall sessionData (m :: * -> *).
Monad m =>
Functor (ClientSessionT sessionData m)
Applicative, Applicative (ClientSessionT sessionData m)
ClientSessionT sessionData m a
Applicative (ClientSessionT sessionData m)
-> (forall a. ClientSessionT sessionData m a)
-> (forall a.
    ClientSessionT sessionData m a
    -> ClientSessionT sessionData m a
    -> ClientSessionT sessionData m a)
-> (forall a.
    ClientSessionT sessionData m a -> ClientSessionT sessionData m [a])
-> (forall a.
    ClientSessionT sessionData m a -> ClientSessionT sessionData m [a])
-> Alternative (ClientSessionT sessionData m)
ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
ClientSessionT sessionData m a -> ClientSessionT sessionData m [a]
ClientSessionT sessionData m a -> ClientSessionT sessionData m [a]
forall a. ClientSessionT sessionData m a
forall a.
ClientSessionT sessionData m a -> ClientSessionT sessionData m [a]
forall a.
ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *).
MonadPlus m =>
Applicative (ClientSessionT sessionData m)
forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a
forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a -> ClientSessionT sessionData m [a]
forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: ClientSessionT sessionData m a -> ClientSessionT sessionData m [a]
$cmany :: forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a -> ClientSessionT sessionData m [a]
some :: ClientSessionT sessionData m a -> ClientSessionT sessionData m [a]
$csome :: forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a -> ClientSessionT sessionData m [a]
<|> :: ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
$c<|> :: forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
empty :: ClientSessionT sessionData m a
$cempty :: forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a
$cp1Alternative :: forall sessionData (m :: * -> *).
MonadPlus m =>
Applicative (ClientSessionT sessionData m)
Alternative, Applicative (ClientSessionT sessionData m)
a -> ClientSessionT sessionData m a
Applicative (ClientSessionT sessionData m)
-> (forall a b.
    ClientSessionT sessionData m a
    -> (a -> ClientSessionT sessionData m b)
    -> ClientSessionT sessionData m b)
-> (forall a b.
    ClientSessionT sessionData m a
    -> ClientSessionT sessionData m b
    -> ClientSessionT sessionData m b)
-> (forall a. a -> ClientSessionT sessionData m a)
-> Monad (ClientSessionT sessionData m)
ClientSessionT sessionData m a
-> (a -> ClientSessionT sessionData m b)
-> ClientSessionT sessionData m b
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
forall a. a -> ClientSessionT sessionData m a
forall a b.
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
forall a b.
ClientSessionT sessionData m a
-> (a -> ClientSessionT sessionData m b)
-> ClientSessionT sessionData m b
forall sessionData (m :: * -> *).
Monad m =>
Applicative (ClientSessionT sessionData m)
forall sessionData (m :: * -> *) a.
Monad m =>
a -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m a
-> (a -> ClientSessionT sessionData m b)
-> ClientSessionT sessionData m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ClientSessionT sessionData m a
$creturn :: forall sessionData (m :: * -> *) a.
Monad m =>
a -> ClientSessionT sessionData m a
>> :: ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
$c>> :: forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m b -> ClientSessionT sessionData m b
>>= :: ClientSessionT sessionData m a
-> (a -> ClientSessionT sessionData m b)
-> ClientSessionT sessionData m b
$c>>= :: forall sessionData (m :: * -> *) a b.
Monad m =>
ClientSessionT sessionData m a
-> (a -> ClientSessionT sessionData m b)
-> ClientSessionT sessionData m b
$cp1Monad :: forall sessionData (m :: * -> *).
Monad m =>
Applicative (ClientSessionT sessionData m)
Monad, MonadBase b, Monad (ClientSessionT sessionData m)
Alternative (ClientSessionT sessionData m)
ClientSessionT sessionData m a
Alternative (ClientSessionT sessionData m)
-> Monad (ClientSessionT sessionData m)
-> (forall a. ClientSessionT sessionData m a)
-> (forall a.
    ClientSessionT sessionData m a
    -> ClientSessionT sessionData m a
    -> ClientSessionT sessionData m a)
-> MonadPlus (ClientSessionT sessionData m)
ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall a. ClientSessionT sessionData m a
forall a.
ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *).
MonadPlus m =>
Monad (ClientSessionT sessionData m)
forall sessionData (m :: * -> *).
MonadPlus m =>
Alternative (ClientSessionT sessionData m)
forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a
forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
$cmplus :: forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
mzero :: ClientSessionT sessionData m a
$cmzero :: forall sessionData (m :: * -> *) a.
MonadPlus m =>
ClientSessionT sessionData m a
$cp2MonadPlus :: forall sessionData (m :: * -> *).
MonadPlus m =>
Monad (ClientSessionT sessionData m)
$cp1MonadPlus :: forall sessionData (m :: * -> *).
MonadPlus m =>
Alternative (ClientSessionT sessionData m)
MonadPlus, Monad (ClientSessionT sessionData m)
Monad (ClientSessionT sessionData m)
-> (forall a. IO a -> ClientSessionT sessionData m a)
-> MonadIO (ClientSessionT sessionData m)
IO a -> ClientSessionT sessionData m a
forall a. IO a -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *).
MonadIO m =>
Monad (ClientSessionT sessionData m)
forall sessionData (m :: * -> *) a.
MonadIO m =>
IO a -> ClientSessionT sessionData m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ClientSessionT sessionData m a
$cliftIO :: forall sessionData (m :: * -> *) a.
MonadIO m =>
IO a -> ClientSessionT sessionData m a
$cp1MonadIO :: forall sessionData (m :: * -> *).
MonadIO m =>
Monad (ClientSessionT sessionData m)
MonadIO, Monad (ClientSessionT sessionData m)
Monad (ClientSessionT sessionData m)
-> (forall a.
    (a -> ClientSessionT sessionData m a)
    -> ClientSessionT sessionData m a)
-> MonadFix (ClientSessionT sessionData m)
(a -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
forall a.
(a -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
forall sessionData (m :: * -> *).
MonadFix m =>
Monad (ClientSessionT sessionData m)
forall sessionData (m :: * -> *) a.
MonadFix m =>
(a -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
$cmfix :: forall sessionData (m :: * -> *) a.
MonadFix m =>
(a -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
$cp1MonadFix :: forall sessionData (m :: * -> *).
MonadFix m =>
Monad (ClientSessionT sessionData m)
MonadFix, MonadError e, Monad (ClientSessionT sessionData m)
Monad (ClientSessionT sessionData m)
-> (forall a b.
    ((a -> ClientSessionT sessionData m b)
     -> ClientSessionT sessionData m a)
    -> ClientSessionT sessionData m a)
-> MonadCont (ClientSessionT sessionData m)
((a -> ClientSessionT sessionData m b)
 -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
forall a b.
((a -> ClientSessionT sessionData m b)
 -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
forall sessionData (m :: * -> *).
MonadCont m =>
Monad (ClientSessionT sessionData m)
forall sessionData (m :: * -> *) a b.
MonadCont m =>
((a -> ClientSessionT sessionData m b)
 -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
callCC :: ((a -> ClientSessionT sessionData m b)
 -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
$ccallCC :: forall sessionData (m :: * -> *) a b.
MonadCont m =>
((a -> ClientSessionT sessionData m b)
 -> ClientSessionT sessionData m a)
-> ClientSessionT sessionData m a
$cp1MonadCont :: forall sessionData (m :: * -> *).
MonadCont m =>
Monad (ClientSessionT sessionData m)
MonadCont
             , ClientSessionT sessionData m RqEnv
Errors String -> ClientSessionT sessionData m a
ClientSessionT sessionData m RqEnv
-> (forall a.
    (RqEnv -> RqEnv)
    -> ClientSessionT sessionData m a
    -> ClientSessionT sessionData m a)
-> (forall a. Errors String -> ClientSessionT sessionData m a)
-> HasRqData (ClientSessionT sessionData m)
(RqEnv -> RqEnv)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall a. Errors String -> ClientSessionT sessionData m a
forall a.
(RqEnv -> RqEnv)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *).
(Monad m, HasRqData m) =>
ClientSessionT sessionData m RqEnv
forall sessionData (m :: * -> *) a.
(Monad m, HasRqData m) =>
Errors String -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *) a.
(Monad m, HasRqData m) =>
(RqEnv -> RqEnv)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall (m :: * -> *).
m RqEnv
-> (forall a. (RqEnv -> RqEnv) -> m a -> m a)
-> (forall a. Errors String -> m a)
-> HasRqData m
rqDataError :: Errors String -> ClientSessionT sessionData m a
$crqDataError :: forall sessionData (m :: * -> *) a.
(Monad m, HasRqData m) =>
Errors String -> ClientSessionT sessionData m a
localRqEnv :: (RqEnv -> RqEnv)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
$clocalRqEnv :: forall sessionData (m :: * -> *) a.
(Monad m, HasRqData m) =>
(RqEnv -> RqEnv)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
askRqEnv :: ClientSessionT sessionData m RqEnv
$caskRqEnv :: forall sessionData (m :: * -> *).
(Monad m, HasRqData m) =>
ClientSessionT sessionData m RqEnv
HasRqData, FilterMonad r, WebMonad r, Monad (ClientSessionT sessionData m)
ClientSessionT sessionData m Request
Monad (ClientSessionT sessionData m)
-> ClientSessionT sessionData m Request
-> (forall a.
    (Request -> Request)
    -> ClientSessionT sessionData m a
    -> ClientSessionT sessionData m a)
-> ServerMonad (ClientSessionT sessionData m)
(Request -> Request)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall a.
(Request -> Request)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall sessionData (m :: * -> *).
ServerMonad m =>
Monad (ClientSessionT sessionData m)
forall sessionData (m :: * -> *).
ServerMonad m =>
ClientSessionT sessionData m Request
forall sessionData (m :: * -> *) a.
ServerMonad m =>
(Request -> Request)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall (m :: * -> *).
Monad m
-> m Request
-> (forall a. (Request -> Request) -> m a -> m a)
-> ServerMonad m
localRq :: (Request -> Request)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
$clocalRq :: forall sessionData (m :: * -> *) a.
ServerMonad m =>
(Request -> Request)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
askRq :: ClientSessionT sessionData m Request
$caskRq :: forall sessionData (m :: * -> *).
ServerMonad m =>
ClientSessionT sessionData m Request
$cp1ServerMonad :: forall sessionData (m :: * -> *).
ServerMonad m =>
Monad (ClientSessionT sessionData m)
ServerMonad)

-- | run the 'ClientSessionT' monad and get the result plus the final @SessionStatus sessionData@
--
-- This function does /not/ automatically update the cookie if the
-- session has been modified. It is up to you to do that. You probably
-- want to use 'withClientSessionT' instead.
--
-- see also: 'withClientSessionT', 'mkSessionConf'
runClientSessionT :: ClientSessionT sessionData m a -> SessionConf -> m (a, SessionStatus sessionData)
runClientSessionT :: ClientSessionT sessionData m a
-> SessionConf -> m (a, SessionStatus sessionData)
runClientSessionT ClientSessionT sessionData m a
cs SessionConf
sc = SessionStateT sessionData m a
-> SessionStatus sessionData -> m (a, SessionStatus sessionData)
forall sessionData (m :: * -> *) a.
SessionStateT sessionData m a
-> SessionStatus sessionData -> m (a, SessionStatus sessionData)
runSessionStateT (ReaderT SessionConf (SessionStateT sessionData m) a
-> SessionConf -> SessionStateT sessionData m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ClientSessionT sessionData m a
-> ReaderT SessionConf (SessionStateT sessionData m) a
forall sessionData (m :: * -> *) a.
ClientSessionT sessionData m a
-> ReaderT SessionConf (SessionStateT sessionData m) a
unClientSessionT ClientSessionT sessionData m a
cs) SessionConf
sc) SessionStatus sessionData
forall sessionData. SessionStatus sessionData
Unread

instance Happstack m => Happstack (ClientSessionT sessionData m)

instance (MonadPlus m) => Semigroup (ClientSessionT sessionData m a) where
    <> :: ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
(<>) = ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance (MonadPlus m) => Monoid (ClientSessionT sessionData m a) where
    mempty :: ClientSessionT sessionData m a
mempty  = ClientSessionT sessionData m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    mappend :: ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
mappend = ClientSessionT sessionData m a
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance MonadTrans (ClientSessionT sessionData) where
    lift :: m a -> ClientSessionT sessionData m a
lift = ReaderT SessionConf (SessionStateT sessionData m) a
-> ClientSessionT sessionData m a
forall sessionData (m :: * -> *) a.
ReaderT SessionConf (SessionStateT sessionData m) a
-> ClientSessionT sessionData m a
ClientSessionT (ReaderT SessionConf (SessionStateT sessionData m) a
 -> ClientSessionT sessionData m a)
-> (m a -> ReaderT SessionConf (SessionStateT sessionData m) a)
-> m a
-> ClientSessionT sessionData m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionStateT sessionData m a
-> ReaderT SessionConf (SessionStateT sessionData m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SessionStateT sessionData m a
 -> ReaderT SessionConf (SessionStateT sessionData m) a)
-> (m a -> SessionStateT sessionData m a)
-> m a
-> ReaderT SessionConf (SessionStateT sessionData m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> SessionStateT sessionData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MonadTransControl (ClientSessionT s) where
    type StT (ClientSessionT s) a = StT (SessionStateT s) (StT (ReaderT SessionConf) a)

    liftWith :: (Run (ClientSessionT s) -> m a) -> ClientSessionT s m a
liftWith Run (ClientSessionT s) -> m a
f =
        ReaderT SessionConf (SessionStateT s m) a -> ClientSessionT s m a
forall sessionData (m :: * -> *) a.
ReaderT SessionConf (SessionStateT sessionData m) a
-> ClientSessionT sessionData m a
ClientSessionT (ReaderT SessionConf (SessionStateT s m) a -> ClientSessionT s m a)
-> ReaderT SessionConf (SessionStateT s m) a
-> ClientSessionT s m a
forall a b. (a -> b) -> a -> b
$ (Run (ReaderT SessionConf) -> SessionStateT s m a)
-> ReaderT SessionConf (SessionStateT s m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (ReaderT SessionConf) -> SessionStateT s m a)
 -> ReaderT SessionConf (SessionStateT s m) a)
-> (Run (ReaderT SessionConf) -> SessionStateT s m a)
-> ReaderT SessionConf (SessionStateT s m) a
forall a b. (a -> b) -> a -> b
$ \Run (ReaderT SessionConf)
runSessionStateT' ->
            (Run (SessionStateT s) -> m a) -> SessionStateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (SessionStateT s) -> m a) -> SessionStateT s m a)
-> (Run (SessionStateT s) -> m a) -> SessionStateT s m a
forall a b. (a -> b) -> a -> b
$ \Run (SessionStateT s)
runReaderT' ->
            Run (ClientSessionT s) -> m a
f (Run (ClientSessionT s) -> m a) -> Run (ClientSessionT s) -> m a
forall a b. (a -> b) -> a -> b
$ SessionStateT s n b -> n (b, SessionStatus s)
Run (SessionStateT s)
runReaderT' (SessionStateT s n b -> n (b, SessionStatus s))
-> (ClientSessionT s n b -> SessionStateT s n b)
-> ClientSessionT s n b
-> n (b, SessionStatus s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SessionConf (SessionStateT s n) b -> SessionStateT s n b
Run (ReaderT SessionConf)
runSessionStateT' (ReaderT SessionConf (SessionStateT s n) b -> SessionStateT s n b)
-> (ClientSessionT s n b
    -> ReaderT SessionConf (SessionStateT s n) b)
-> ClientSessionT s n b
-> SessionStateT s n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientSessionT s n b -> ReaderT SessionConf (SessionStateT s n) b
forall sessionData (m :: * -> *) a.
ClientSessionT sessionData m a
-> ReaderT SessionConf (SessionStateT sessionData m) a
unClientSessionT

    restoreT :: m (StT (ClientSessionT s) a) -> ClientSessionT s m a
restoreT = ReaderT SessionConf (SessionStateT s m) a -> ClientSessionT s m a
forall sessionData (m :: * -> *) a.
ReaderT SessionConf (SessionStateT sessionData m) a
-> ClientSessionT sessionData m a
ClientSessionT (ReaderT SessionConf (SessionStateT s m) a -> ClientSessionT s m a)
-> (m (a, SessionStatus s)
    -> ReaderT SessionConf (SessionStateT s m) a)
-> m (a, SessionStatus s)
-> ClientSessionT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionStateT s m a -> ReaderT SessionConf (SessionStateT s m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (SessionStateT s m a -> ReaderT SessionConf (SessionStateT s m) a)
-> (m (a, SessionStatus s) -> SessionStateT s m a)
-> m (a, SessionStatus s)
-> ReaderT SessionConf (SessionStateT s m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a, SessionStatus s) -> SessionStateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT

instance MonadBaseControl b m => MonadBaseControl b (ClientSessionT s m) where
    type StM (ClientSessionT s m) a = ComposeSt (ClientSessionT s) m a
    liftBaseWith :: (RunInBase (ClientSessionT s m) b -> b a) -> ClientSessionT s m a
liftBaseWith = (RunInBase (ClientSessionT s m) b -> b a) -> ClientSessionT s m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
    restoreM :: StM (ClientSessionT s m) a -> ClientSessionT s m a
restoreM     = StM (ClientSessionT s m) a -> ClientSessionT s m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

-- | transform the inner monad, but leave the session data alone.
mapClientSessionT :: (forall s. m (a, s) -> n (b, s))
                  -> ClientSessionT sessionData m a
                  -> ClientSessionT sessionData n b
mapClientSessionT :: (forall s. m (a, s) -> n (b, s))
-> ClientSessionT sessionData m a -> ClientSessionT sessionData n b
mapClientSessionT forall s. m (a, s) -> n (b, s)
f (ClientSessionT ReaderT SessionConf (SessionStateT sessionData m) a
m) = ReaderT SessionConf (SessionStateT sessionData n) b
-> ClientSessionT sessionData n b
forall sessionData (m :: * -> *) a.
ReaderT SessionConf (SessionStateT sessionData m) a
-> ClientSessionT sessionData m a
ClientSessionT (ReaderT SessionConf (SessionStateT sessionData n) b
 -> ClientSessionT sessionData n b)
-> ReaderT SessionConf (SessionStateT sessionData n) b
-> ClientSessionT sessionData n b
forall a b. (a -> b) -> a -> b
$ (SessionStateT sessionData m a -> SessionStateT sessionData n b)
-> ReaderT SessionConf (SessionStateT sessionData m) a
-> ReaderT SessionConf (SessionStateT sessionData n) b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((forall s. m (a, s) -> n (b, s))
-> SessionStateT sessionData m a -> SessionStateT sessionData n b
forall (m :: * -> *) a (n :: * -> *) b sessionData.
(forall s. m (a, s) -> n (b, s))
-> SessionStateT sessionData m a -> SessionStateT sessionData n b
mapSessionStateT forall s. m (a, s) -> n (b, s)
f) ReaderT SessionConf (SessionStateT sessionData m) a
m

-- | transform the inner monad
mapClientSessionT_ :: (m (a, SessionStatus sessionData) -> n (b, SessionStatus sessionData))
                  -> ClientSessionT sessionData m a
                  -> ClientSessionT sessionData n b
mapClientSessionT_ :: (m (a, SessionStatus sessionData)
 -> n (b, SessionStatus sessionData))
-> ClientSessionT sessionData m a -> ClientSessionT sessionData n b
mapClientSessionT_ m (a, SessionStatus sessionData)
-> n (b, SessionStatus sessionData)
f (ClientSessionT ReaderT SessionConf (SessionStateT sessionData m) a
m) = ReaderT SessionConf (SessionStateT sessionData n) b
-> ClientSessionT sessionData n b
forall sessionData (m :: * -> *) a.
ReaderT SessionConf (SessionStateT sessionData m) a
-> ClientSessionT sessionData m a
ClientSessionT (ReaderT SessionConf (SessionStateT sessionData n) b
 -> ClientSessionT sessionData n b)
-> ReaderT SessionConf (SessionStateT sessionData n) b
-> ClientSessionT sessionData n b
forall a b. (a -> b) -> a -> b
$ (SessionStateT sessionData m a -> SessionStateT sessionData n b)
-> ReaderT SessionConf (SessionStateT sessionData m) a
-> ReaderT SessionConf (SessionStateT sessionData n) b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((m (a, SessionStatus sessionData)
 -> n (b, SessionStatus sessionData))
-> SessionStateT sessionData m a -> SessionStateT sessionData n b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, SessionStatus s) -> n (b, SessionStatus s))
-> SessionStateT s m a -> SessionStateT s n b
mapSessionStateT_ m (a, SessionStatus sessionData)
-> n (b, SessionStatus sessionData)
f) ReaderT SessionConf (SessionStateT sessionData m) a
m

instance (MonadReader r m) => MonadReader r (ClientSessionT sessionData m) where
    ask :: ClientSessionT sessionData m r
ask = m r -> ClientSessionT sessionData m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: (r -> r)
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
local = (m (a, SessionStatus sessionData)
 -> m (a, SessionStatus sessionData))
-> ClientSessionT sessionData m a -> ClientSessionT sessionData m a
forall (m :: * -> *) a sessionData (n :: * -> *) b.
(m (a, SessionStatus sessionData)
 -> n (b, SessionStatus sessionData))
-> ClientSessionT sessionData m a -> ClientSessionT sessionData n b
mapClientSessionT_ ((m (a, SessionStatus sessionData)
  -> m (a, SessionStatus sessionData))
 -> ClientSessionT sessionData m a
 -> ClientSessionT sessionData m a)
-> ((r -> r)
    -> m (a, SessionStatus sessionData)
    -> m (a, SessionStatus sessionData))
-> (r -> r)
-> ClientSessionT sessionData m a
-> ClientSessionT sessionData m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r)
-> m (a, SessionStatus sessionData)
-> m (a, SessionStatus sessionData)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local

instance (MonadWriter w m) => MonadWriter w (ClientSessionT sessionData m) where
    tell :: w -> ClientSessionT sessionData m ()
tell     = m () -> ClientSessionT sessionData m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ClientSessionT sessionData m ())
-> (w -> m ()) -> w -> ClientSessionT sessionData m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell

    listen :: ClientSessionT sessionData m a
-> ClientSessionT sessionData m (a, w)
listen = (forall s. m (a, s) -> m ((a, w), s))
-> ClientSessionT sessionData m a
-> ClientSessionT sessionData m (a, w)
forall (m :: * -> *) a (n :: * -> *) b sessionData.
(forall s. m (a, s) -> n (b, s))
-> ClientSessionT sessionData m a -> ClientSessionT sessionData n b
mapClientSessionT forall s. m (a, s) -> m ((a, w), s)
forall a s. m (a, s) -> m ((a, w), s)
listen'
        where
          listen' :: m (a, s) -> m ((a, w), s)
          listen' :: m (a, s) -> m ((a, w), s)
listen' m (a, s)
m =
              do ((a
a, s
s), w
w') <- m (a, s) -> m ((a, s), w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (a, s)
m
                 ((a, w), s) -> m ((a, w), s)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a, w
w'), s
s)
    pass :: ClientSessionT sessionData m (a, w -> w)
-> ClientSessionT sessionData m a
pass = (forall s. m ((a, w -> w), s) -> m (a, s))
-> ClientSessionT sessionData m (a, w -> w)
-> ClientSessionT sessionData m a
forall (m :: * -> *) a (n :: * -> *) b sessionData.
(forall s. m (a, s) -> n (b, s))
-> ClientSessionT sessionData m a -> ClientSessionT sessionData n b
mapClientSessionT forall s. m ((a, w -> w), s) -> m (a, s)
forall a s. m ((a, w -> w), s) -> m (a, s)
pass'
        where
          pass' :: m ((a, w -> w), s) -> m (a, s)
          pass' :: m ((a, w -> w), s) -> m (a, s)
pass' m ((a, w -> w), s)
m =
              do ((a
a, w -> w
f), s
st) <- m ((a, w -> w), s)
m
                 a
a' <- m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (a, w -> w) -> m a) -> m (a, w -> w) -> m a
forall a b. (a -> b) -> a -> b
$ (a, w -> w) -> m (a, w -> w)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, w -> w
f)
                 (a, s) -> m (a, s)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a', s
st)

instance (MonadState s m) => MonadState s (ClientSessionT sessionData m) where
    get :: ClientSessionT sessionData m s
get   = m s -> ClientSessionT sessionData m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> ClientSessionT sessionData m ()
put s
a = m () -> ClientSessionT sessionData m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
a)

instance (MonadRWS r w s m) => MonadRWS r w s (ClientSessionT sessionData m)

------------------------------------------------------------------------------
-- Internals
------------------------------------------------------------------------------

-- | Fetch the 'SessionConf'
askSessionConf :: (Monad m) => ClientSessionT sessionData m SessionConf
askSessionConf :: ClientSessionT sessionData m SessionConf
askSessionConf = ReaderT SessionConf (SessionStateT sessionData m) SessionConf
-> ClientSessionT sessionData m SessionConf
forall sessionData (m :: * -> *) a.
ReaderT SessionConf (SessionStateT sessionData m) a
-> ClientSessionT sessionData m a
ClientSessionT ReaderT SessionConf (SessionStateT sessionData m) SessionConf
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Fetch the 'SessionConf' and apply a function to it
asksSessionConf :: (Monad m) => (SessionConf -> a) -> ClientSessionT sessionData m a
asksSessionConf :: (SessionConf -> a) -> ClientSessionT sessionData m a
asksSessionConf SessionConf -> a
f = do
    SessionConf
sc <- ClientSessionT sessionData m SessionConf
forall (m :: * -> *) sessionData.
Monad m =>
ClientSessionT sessionData m SessionConf
askSessionConf
    a -> ClientSessionT sessionData m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionConf -> a
f SessionConf
sc)

-- | Fetch the current value of the state within the monad.
getSessionStatus :: (Monad m) => ClientSessionT sessionData m (SessionStatus sessionData)
getSessionStatus :: ClientSessionT sessionData m (SessionStatus sessionData)
getSessionStatus =
    ReaderT
  SessionConf
  (SessionStateT sessionData m)
  (SessionStatus sessionData)
-> ClientSessionT sessionData m (SessionStatus sessionData)
forall sessionData (m :: * -> *) a.
ReaderT SessionConf (SessionStateT sessionData m) a
-> ClientSessionT sessionData m a
ClientSessionT (ReaderT
   SessionConf
   (SessionStateT sessionData m)
   (SessionStatus sessionData)
 -> ClientSessionT sessionData m (SessionStatus sessionData))
-> ReaderT
     SessionConf
     (SessionStateT sessionData m)
     (SessionStatus sessionData)
-> ClientSessionT sessionData m (SessionStatus sessionData)
forall a b. (a -> b) -> a -> b
$ (SessionConf
 -> SessionStateT sessionData m (SessionStatus sessionData))
-> ReaderT
     SessionConf
     (SessionStateT sessionData m)
     (SessionStatus sessionData)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SessionConf
  -> SessionStateT sessionData m (SessionStatus sessionData))
 -> ReaderT
      SessionConf
      (SessionStateT sessionData m)
      (SessionStatus sessionData))
-> (SessionConf
    -> SessionStateT sessionData m (SessionStatus sessionData))
-> ReaderT
     SessionConf
     (SessionStateT sessionData m)
     (SessionStatus sessionData)
forall a b. (a -> b) -> a -> b
$ \SessionConf
_ -> StateT (SessionStatus sessionData) m (SessionStatus sessionData)
-> SessionStateT sessionData m (SessionStatus sessionData)
forall s (m :: * -> *) a.
StateT (SessionStatus s) m a -> SessionStateT s m a
SessionStateT StateT (SessionStatus sessionData) m (SessionStatus sessionData)
forall s (m :: * -> *). MonadState s m => m s
get

-- | @'put' s@ sets the state within the monad to @s@.
putSessionStatus :: Monad m => SessionStatus sessionData -> ClientSessionT sessionData m ()
putSessionStatus :: SessionStatus sessionData -> ClientSessionT sessionData m ()
putSessionStatus SessionStatus sessionData
sd =
    ReaderT SessionConf (SessionStateT sessionData m) ()
-> ClientSessionT sessionData m ()
forall sessionData (m :: * -> *) a.
ReaderT SessionConf (SessionStateT sessionData m) a
-> ClientSessionT sessionData m a
ClientSessionT (ReaderT SessionConf (SessionStateT sessionData m) ()
 -> ClientSessionT sessionData m ())
-> ReaderT SessionConf (SessionStateT sessionData m) ()
-> ClientSessionT sessionData m ()
forall a b. (a -> b) -> a -> b
$ (SessionConf -> SessionStateT sessionData m ())
-> ReaderT SessionConf (SessionStateT sessionData m) ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SessionConf -> SessionStateT sessionData m ())
 -> ReaderT SessionConf (SessionStateT sessionData m) ())
-> (SessionConf -> SessionStateT sessionData m ())
-> ReaderT SessionConf (SessionStateT sessionData m) ()
forall a b. (a -> b) -> a -> b
$ \SessionConf
_ -> StateT (SessionStatus sessionData) m ()
-> SessionStateT sessionData m ()
forall s (m :: * -> *) a.
StateT (SessionStatus s) m a -> SessionStateT s m a
SessionStateT (StateT (SessionStatus sessionData) m ()
 -> SessionStateT sessionData m ())
-> StateT (SessionStatus sessionData) m ()
-> SessionStateT sessionData m ()
forall a b. (a -> b) -> a -> b
$ SessionStatus sessionData
-> StateT (SessionStatus sessionData) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put SessionStatus sessionData
sd

-- | create a new session by calling 'emptySession'
newSession :: (Monad m, ClientSession st) => m st
newSession :: m st
newSession = st -> m st
forall (m :: * -> *) a. Monad m => a -> m a
return st
forall st. ClientSession st => st
emptySession

-- | decode the encypted cookie string
decode :: (Monad m, ClientSession sessionData) =>
          String
       -> ClientSessionT sessionData m sessionData
decode :: String -> ClientSessionT sessionData m sessionData
decode String
v = do Key
key <- (SessionConf -> Key) -> ClientSessionT sessionData m Key
forall (m :: * -> *) a sessionData.
Monad m =>
(SessionConf -> a) -> ClientSessionT sessionData m a
asksSessionConf SessionConf -> Key
sessionKey
              ClientSessionT sessionData m sessionData
-> (ByteString -> ClientSessionT sessionData m sessionData)
-> Maybe ByteString
-> ClientSessionT sessionData m sessionData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ClientSessionT sessionData m sessionData
forall (m :: * -> *) st. (Monad m, ClientSession st) => m st
newSession ((String -> ClientSessionT sessionData m sessionData)
-> (sessionData -> ClientSessionT sessionData m sessionData)
-> Either String sessionData
-> ClientSessionT sessionData m sessionData
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ClientSessionT sessionData m sessionData
-> String -> ClientSessionT sessionData m sessionData
forall a b. a -> b -> a
const ClientSessionT sessionData m sessionData
forall (m :: * -> *) st. (Monad m, ClientSession st) => m st
newSession) sessionData -> ClientSessionT sessionData m sessionData
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String sessionData
 -> ClientSessionT sessionData m sessionData)
-> (ByteString -> Either String sessionData)
-> ByteString
-> ClientSessionT sessionData m sessionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get sessionData -> ByteString -> Either String sessionData
forall a. Get a -> ByteString -> Either String a
runGet Get sessionData
forall a. SafeCopy a => Get a
safeGet)
                     (Maybe ByteString -> ClientSessionT sessionData m sessionData)
-> (ByteString -> Maybe ByteString)
-> ByteString
-> ClientSessionT sessionData m sessionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ByteString -> Maybe ByteString
decrypt Key
key (ByteString -> ClientSessionT sessionData m sessionData)
-> ByteString -> ClientSessionT sessionData m sessionData
forall a b. (a -> b) -> a -> b
$ String -> ByteString
pack String
v

-- | get the session cookie and decrypt it. If no cookie is found, return a new 'emptySession'.
getValue :: (Functor m, Monad m, MonadPlus m, HasRqData m, ClientSession sessionData) =>
            ClientSessionT sessionData m sessionData
getValue :: ClientSessionT sessionData m sessionData
getValue = do String
name <- (SessionConf -> String) -> ClientSessionT sessionData m String
forall (m :: * -> *) a sessionData.
Monad m =>
(SessionConf -> a) -> ClientSessionT sessionData m a
asksSessionConf SessionConf -> String
sessionCookieName
              Maybe String
value <- ClientSessionT sessionData m String
-> ClientSessionT sessionData m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ClientSessionT sessionData m String
 -> ClientSessionT sessionData m (Maybe String))
-> ClientSessionT sessionData m String
-> ClientSessionT sessionData m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> ClientSessionT sessionData m String
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m String
lookCookieValue String
name
              ClientSessionT sessionData m sessionData
-> (String -> ClientSessionT sessionData m sessionData)
-> Maybe String
-> ClientSessionT sessionData m sessionData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ClientSessionT sessionData m sessionData
forall (m :: * -> *) st. (Monad m, ClientSession st) => m st
newSession String -> ClientSessionT sessionData m sessionData
forall (m :: * -> *) sessionData.
(Monad m, ClientSession sessionData) =>
String -> ClientSessionT sessionData m sessionData
decode Maybe String
value

-- | get the @sessionData@
getSessionCST :: (Functor m, MonadPlus m, HasRqData m, ClientSession sessionData)
           => ClientSessionT sessionData m sessionData
getSessionCST :: ClientSessionT sessionData m sessionData
getSessionCST =
    do SessionStatus sessionData
sd <- ClientSessionT sessionData m (SessionStatus sessionData)
forall (m :: * -> *) sessionData.
Monad m =>
ClientSessionT sessionData m (SessionStatus sessionData)
getSessionStatus
       case SessionStatus sessionData
sd of
         SessionStatus sessionData
Unread ->
             do sessionData
a <- ClientSessionT sessionData m sessionData
forall (m :: * -> *) sessionData.
(Functor m, Monad m, MonadPlus m, HasRqData m,
 ClientSession sessionData) =>
ClientSessionT sessionData m sessionData
getValue
                SessionStatus sessionData -> ClientSessionT sessionData m ()
forall (m :: * -> *) sessionData.
Monad m =>
SessionStatus sessionData -> ClientSessionT sessionData m ()
putSessionStatus (sessionData -> SessionStatus sessionData
forall sessionData. sessionData -> SessionStatus sessionData
NoChange sessionData
a)
                sessionData -> ClientSessionT sessionData m sessionData
forall (m :: * -> *) a. Monad m => a -> m a
return sessionData
a
         NoChange sessionData
a  ->
             sessionData -> ClientSessionT sessionData m sessionData
forall (m :: * -> *) a. Monad m => a -> m a
return sessionData
a
         Modified sessionData
a ->
             sessionData -> ClientSessionT sessionData m sessionData
forall (m :: * -> *) a. Monad m => a -> m a
return sessionData
a
         SessionStatus sessionData
Expired ->
             ClientSessionT sessionData m sessionData
forall (m :: * -> *) st. (Monad m, ClientSession st) => m st
newSession

-- | Put a new value in the session.
putSessionCST :: (Monad m, ClientSession sessionData) => sessionData -> ClientSessionT sessionData m ()
putSessionCST :: sessionData -> ClientSessionT sessionData m ()
putSessionCST sessionData
sd = SessionStatus sessionData -> ClientSessionT sessionData m ()
forall (m :: * -> *) sessionData.
Monad m =>
SessionStatus sessionData -> ClientSessionT sessionData m ()
putSessionStatus (sessionData -> SessionStatus sessionData
forall sessionData. sessionData -> SessionStatus sessionData
Modified sessionData
sd)

-- | Expire the session, i.e. the cookie holding it.
expireSessionCST :: Monad m => ClientSessionT st m ()
expireSessionCST :: ClientSessionT st m ()
expireSessionCST = SessionStatus st -> ClientSessionT st m ()
forall (m :: * -> *) sessionData.
Monad m =>
SessionStatus sessionData -> ClientSessionT sessionData m ()
putSessionStatus SessionStatus st
forall sessionData. SessionStatus sessionData
Expired

------------------------------------------------------------------------------
-- MonadClientSession
------------------------------------------------------------------------------

-- | 'MonadClientSession' provides the primary interface to get @sessionData@, put @sessionData@ or expire @sessionData@.
--
-- This is a class so you can use newtype deriving to make the functions available in your custom server monad.
class MonadClientSession sessionData m | m -> sessionData where
    getSession    :: m sessionData         -- ^ get the current @sessionData@
    putSession    :: sessionData -> m ()   -- ^ set the @sessionData@
    expireSession :: m ()                  -- ^ expire the session (deletes the cookie)

instance (Functor m , MonadPlus m, HasRqData m, ClientSession sessionData) =>
    (MonadClientSession sessionData (ClientSessionT sessionData m)) where
    getSession :: ClientSessionT sessionData m sessionData
getSession    = ClientSessionT sessionData m sessionData
forall (m :: * -> *) sessionData.
(Functor m, MonadPlus m, HasRqData m, ClientSession sessionData) =>
ClientSessionT sessionData m sessionData
getSessionCST
    putSession :: sessionData -> ClientSessionT sessionData m ()
putSession    = sessionData -> ClientSessionT sessionData m ()
forall (m :: * -> *) sessionData.
(Monad m, ClientSession sessionData) =>
sessionData -> ClientSessionT sessionData m ()
putSessionCST
    expireSession :: ClientSessionT sessionData m ()
expireSession = ClientSessionT sessionData m ()
forall (m :: * -> *) st. Monad m => ClientSessionT st m ()
expireSessionCST

instance (Monad m, MonadClientSession sessionData m) => MonadClientSession sessionData (ContT c m) where
    getSession :: ContT c m sessionData
getSession    = m sessionData -> ContT c m sessionData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m sessionData
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m sessionData
getSession
    putSession :: sessionData -> ContT c m ()
putSession    = m () -> ContT c m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ContT c m ())
-> (sessionData -> m ()) -> sessionData -> ContT c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sessionData -> m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
sessionData -> m ()
putSession
    expireSession :: ContT c m ()
expireSession = m () -> ContT c m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m ()
expireSession

instance (Monad m, MonadClientSession sessionData m, Error e) => MonadClientSession sessionData (ErrorT e m) where
    getSession :: ErrorT e m sessionData
getSession    = m sessionData -> ErrorT e m sessionData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m sessionData
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m sessionData
getSession
    putSession :: sessionData -> ErrorT e m ()
putSession    = m () -> ErrorT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ErrorT e m ())
-> (sessionData -> m ()) -> sessionData -> ErrorT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sessionData -> m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
sessionData -> m ()
putSession
    expireSession :: ErrorT e m ()
expireSession = m () -> ErrorT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m ()
expireSession

instance (Monad m, MonadClientSession sessionData m) => MonadClientSession sessionData (ReaderT r m) where
    getSession :: ReaderT r m sessionData
getSession    = m sessionData -> ReaderT r m sessionData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m sessionData
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m sessionData
getSession
    putSession :: sessionData -> ReaderT r m ()
putSession    = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (sessionData -> m ()) -> sessionData -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sessionData -> m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
sessionData -> m ()
putSession
    expireSession :: ReaderT r m ()
expireSession = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m ()
expireSession

instance (Monad m, MonadClientSession sessionData m) => MonadClientSession sessionData (StateT s m) where
    getSession :: StateT s m sessionData
getSession    = m sessionData -> StateT s m sessionData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m sessionData
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m sessionData
getSession
    putSession :: sessionData -> StateT s m ()
putSession    = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (sessionData -> m ()) -> sessionData -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sessionData -> m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
sessionData -> m ()
putSession
    expireSession :: StateT s m ()
expireSession = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m ()
expireSession

instance (Monad m, MonadClientSession sessionData m, Monoid w) => MonadClientSession sessionData (WriterT w m) where
    getSession :: WriterT w m sessionData
getSession    = m sessionData -> WriterT w m sessionData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m sessionData
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m sessionData
getSession
    putSession :: sessionData -> WriterT w m ()
putSession    = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ())
-> (sessionData -> m ()) -> sessionData -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sessionData -> m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
sessionData -> m ()
putSession
    expireSession :: WriterT w m ()
expireSession = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m ()
expireSession

instance (Monad m, MonadClientSession sessionData m, Monoid w) => MonadClientSession sessionData (RWST r w s m) where
    getSession :: RWST r w s m sessionData
getSession    = m sessionData -> RWST r w s m sessionData
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m sessionData
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m sessionData
getSession
    putSession :: sessionData -> RWST r w s m ()
putSession    = m () -> RWST r w s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ())
-> (sessionData -> m ()) -> sessionData -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sessionData -> m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
sessionData -> m ()
putSession
    expireSession :: RWST r w s m ()
expireSession = m () -> RWST r w s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m ()
expireSession

------------------------------------------------------------------------------
-- liftSessionStateT
------------------------------------------------------------------------------

-- | lift a computation from the 'SessionStateT' monad
--
-- The primary purpose of this function is to make it possible to use
-- the 'MonadState' functions such as 'get' and 'set' to get and set
-- the current session data.
--
-- That makes it possible to use the 'MonadState' based functions provided by 'Data.Lens', e.g.:
--
-- > do c <- liftSessionStateT $ count += 1
--
liftSessionStateT :: (Monad m, MonadTrans t, MonadClientSession sessionData (t m), Monad (t m)) =>
                     SessionStateT sessionData m a
                  -> t m a
liftSessionStateT :: SessionStateT sessionData m a -> t m a
liftSessionStateT SessionStateT sessionData m a
m =
    do sessionData
sd <- t m sessionData
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
m sessionData
getSession
       (a
a, SessionStatus sessionData
sd') <- m (a, SessionStatus sessionData)
-> t m (a, SessionStatus sessionData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, SessionStatus sessionData)
 -> t m (a, SessionStatus sessionData))
-> m (a, SessionStatus sessionData)
-> t m (a, SessionStatus sessionData)
forall a b. (a -> b) -> a -> b
$ SessionStateT sessionData m a
-> SessionStatus sessionData -> m (a, SessionStatus sessionData)
forall sessionData (m :: * -> *) a.
SessionStateT sessionData m a
-> SessionStatus sessionData -> m (a, SessionStatus sessionData)
runSessionStateT SessionStateT sessionData m a
m (sessionData -> SessionStatus sessionData
forall sessionData. sessionData -> SessionStatus sessionData
NoChange sessionData
sd)
       case SessionStatus sessionData
sd' of
         (Modified sessionData
sd'') -> sessionData -> t m ()
forall sessionData (m :: * -> *).
MonadClientSession sessionData m =>
sessionData -> m ()
putSession sessionData
sd''
         (NoChange sessionData
_   ) -> () -> t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         SessionStatus sessionData
Unread          -> String -> t m ()
forall a. HasCallStack => String -> a
error String
"liftSessionStateT: session data came back Unread. How did that happen?"
         SessionStatus sessionData
Expired         -> String -> t m ()
forall a. HasCallStack => String -> a
error String
"liftSessionStateT: session data came back Expired. How did that happen?"
       a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

------------------------------------------------------------------------------
-- withClientSessionT
------------------------------------------------------------------------------

-- | Wrapper around your handlers that use the session.
--
-- This function automatically takes care of expiring or updating the
-- cookie if the 'expireSession' or 'modifySession' is called.
--
-- If no changes are made to the session, then the cookie will not be
-- resent (because there is no need to).
withClientSessionT :: (Happstack m, Functor m, Monad m, FilterMonad Response m, ClientSession sessionData) =>
                      SessionConf
                   -> ClientSessionT sessionData m a
                   -> m a
withClientSessionT :: SessionConf -> ClientSessionT sessionData m a -> m a
withClientSessionT sessionConf :: SessionConf
sessionConf@SessionConf{Bool
String
Key
CookieLife
sessionHttpOnly :: Bool
sessionSecure :: Bool
sessionPath :: String
sessionDomain :: String
sessionKey :: Key
sessionCookieLife :: CookieLife
sessionCookieName :: String
sessionHttpOnly :: SessionConf -> Bool
sessionSecure :: SessionConf -> Bool
sessionPath :: SessionConf -> String
sessionDomain :: SessionConf -> String
sessionKey :: SessionConf -> Key
sessionCookieLife :: SessionConf -> CookieLife
sessionCookieName :: SessionConf -> String
..} ClientSessionT sessionData m a
part =
  do (a
a, SessionStatus sessionData
sd) <- ClientSessionT sessionData m a
-> SessionConf -> m (a, SessionStatus sessionData)
forall sessionData (m :: * -> *) a.
ClientSessionT sessionData m a
-> SessionConf -> m (a, SessionStatus sessionData)
runClientSessionT ClientSessionT sessionData m a
part SessionConf
sessionConf
     case SessionStatus sessionData
sd of
      Modified sessionData
sd' -> sessionData -> m ()
encode sessionData
sd'
      SessionStatus sessionData
Expired      -> m ()
expire
      SessionStatus sessionData
_            -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  where
    encode :: sessionData -> m ()
encode sessionData
sd = do ByteString
bytes <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString)
-> (sessionData -> IO ByteString) -> sessionData -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ByteString -> IO ByteString
encryptIO Key
sessionKey (ByteString -> IO ByteString)
-> (sessionData -> ByteString) -> sessionData -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString)
-> (sessionData -> Put) -> sessionData -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sessionData -> Put
forall a. SafeCopy a => a -> Put
safePut (sessionData -> m ByteString) -> sessionData -> m ByteString
forall a b. (a -> b) -> a -> b
$ sessionData
sd
                   let cookie :: Cookie
cookie = (String -> String -> Cookie
mkCookie String
sessionCookieName (String -> Cookie) -> String -> Cookie
forall a b. (a -> b) -> a -> b
$ ByteString -> String
unpack ByteString
bytes) { cookieDomain :: String
cookieDomain = String
sessionDomain
                                                                            , cookiePath :: String
cookiePath   = String
sessionPath
                                                                            , secure :: Bool
secure       = Bool
sessionSecure
                                                                            , httpOnly :: Bool
httpOnly     = Bool
sessionHttpOnly
                                                                            }
                   CookieLife -> Cookie -> m ()
forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
CookieLife -> Cookie -> m ()
addCookie CookieLife
sessionCookieLife Cookie
cookie
    expire :: m ()
expire = String -> m ()
forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
String -> m ()
expireCookie String
sessionCookieName