Session -> BackendSession

This commit is contained in:
gregwebs 2012-03-25 13:28:31 -07:00
parent f147e76231
commit 3f0848121c
4 changed files with 29 additions and 19 deletions

View File

@ -33,6 +33,8 @@ module Yesod.Core
, clientSessionBackend
, saveClientSession
, loadClientSession
, Header(..)
, BackendSession
-- * JS loaders
, loadJsYepnope
, ScriptLoadPosition (..)
@ -50,6 +52,7 @@ module Yesod.Core
) where
import Yesod.Internal.Core
import Yesod.Internal (Header(..))
import Yesod.Content
import Yesod.Dispatch
import Yesod.Handler

View File

@ -31,6 +31,7 @@ module Yesod.Internal.Core
, clientSessionBackend
, saveClientSession
, loadClientSession
, BackendSession
-- * jsLoader
, ScriptLoadPosition (..)
, BottomOfHeadAsync
@ -323,20 +324,6 @@ $doctype 5
key <- CS.getKey CS.defaultKeyFile
return $ Just $ clientSessionBackend key 120
type Session = [(Text, S8.ByteString)]
data SessionBackend master = SessionBackend
{ sbSaveSession :: master
-> W.Request
-> UTCTime -- ^ The current time
-> Session -- ^ The old session (before running handler)
-> Session -- ^ The final session
-> IO [Header]
, sbLoadSession :: master
-> W.Request
-> UTCTime -- ^ The current time
-> IO Session
}
messageLoggerHandler :: Yesod m
=> Loc -> LogLevel -> Text -> GHandler s m ()
@ -724,7 +711,7 @@ loadClientSession :: Yesod master
-> master
-> W.Request
-> UTCTime
-> IO Session
-> IO BackendSession
loadClientSession key _ req now = return . fromMaybe [] $ do
raw <- lookup "Cookie" $ W.requestHeaders req
val <- lookup sessionName $ parseCookies raw
@ -737,12 +724,12 @@ saveClientSession :: Yesod master
-> master
-> W.Request
-> UTCTime
-> Session
-> Session
-> BackendSession
-> BackendSession
-> IO [Header]
saveClientSession key timeout master _ now _ sess = do
-- fixme should we be caching this?
iv <- liftIO $ CS.randomIV
iv <- liftIO CS.randomIV
return [AddCookie def
{ setCookieName = sessionName
, setCookieValue = sessionVal iv

View File

@ -1,8 +1,11 @@
module Yesod.Internal.Session
( encodeClientSession
, decodeClientSession
, BackendSession
, SessionBackend(..)
) where
import Yesod.Internal (Header(..))
import qualified Web.ClientSession as CS
import Data.Serialize
import Data.Time
@ -12,6 +15,24 @@ import Data.Text (Text, pack, unpack)
import Control.Arrow (first)
import Control.Applicative ((<$>))
import qualified Data.ByteString.Char8 as S8
import qualified Network.Wai as W
type BackendSession = [(Text, S8.ByteString)]
data SessionBackend master = SessionBackend
{ sbSaveSession :: master
-> W.Request
-> UTCTime -- ^ The current time
-> BackendSession -- ^ The old session (before running handler)
-> BackendSession -- ^ The final session
-> IO [Header]
, sbLoadSession :: master
-> W.Request
-> UTCTime -- ^ The current time
-> IO BackendSession
}
encodeClientSession :: CS.Key
-> CS.IV
-> UTCTime -- ^ expire time

View File

@ -4,7 +4,6 @@ module YesodCoreTest.WaiSubsite (specs, Widget) where
import YesodCoreTest.YesodTest
import Yesod.Core
import qualified Network.HTTP.Types as H
import Network.Wai
myApp :: Application
myApp _ = return $ responseLBS H.status200 [("Content-type", "text/plain")] "WAI"