clientsession 0.4
This commit is contained in:
parent
51f816cb27
commit
022ead8b31
@ -186,7 +186,7 @@ toWaiApp' y segments env = do
|
|||||||
let eurl' = either (const Nothing) Just eurl
|
let eurl' = either (const Nothing) Just eurl
|
||||||
let eh er = runHandler (errorHandler y er) render eurl' id y id
|
let eh er = runHandler (errorHandler y er) render eurl' id y id
|
||||||
(s, hs, ct, c, sessionFinal) <- unYesodApp ya eh rr types
|
(s, hs, ct, c, sessionFinal) <- unYesodApp ya eh rr types
|
||||||
sessionVal <- encodeSession key' exp' host sessionFinal
|
let sessionVal = encodeSession key' exp' host sessionFinal
|
||||||
let hs' = AddCookie (clientSessionDuration y) sessionName sessionVal
|
let hs' = AddCookie (clientSessionDuration y) sessionName sessionVal
|
||||||
: hs
|
: hs
|
||||||
hs'' = map (headerToPair getExpires) hs'
|
hs'' = map (headerToPair getExpires) hs'
|
||||||
@ -288,15 +288,15 @@ headerToPair _ (DeleteCookie key) =
|
|||||||
key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
|
key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
|
||||||
headerToPair _ (Header key value) = (W.responseHeaderFromBS $ cs key, cs value)
|
headerToPair _ (Header key value) = (W.responseHeaderFromBS $ cs key, cs value)
|
||||||
|
|
||||||
encodeSession :: B.ByteString -- ^ key
|
encodeSession :: Key
|
||||||
-> UTCTime -- ^ expire time
|
-> UTCTime -- ^ expire time
|
||||||
-> B.ByteString -- ^ remote host
|
-> B.ByteString -- ^ remote host
|
||||||
-> [(String, String)] -- ^ session
|
-> [(String, String)] -- ^ session
|
||||||
-> IO String -- ^ cookie value
|
-> String -- ^ cookie value
|
||||||
encodeSession key expire rhost session' =
|
encodeSession key expire rhost session' =
|
||||||
encrypt key $ cs $ encode $ SessionCookie expire rhost session'
|
encrypt key $ cs $ encode $ SessionCookie expire rhost session'
|
||||||
|
|
||||||
decodeSession :: B.ByteString -- ^ key
|
decodeSession :: Key
|
||||||
-> UTCTime -- ^ current time
|
-> UTCTime -- ^ current time
|
||||||
-> B.ByteString -- ^ remote host field
|
-> B.ByteString -- ^ remote host field
|
||||||
-> B.ByteString -- ^ cookie value
|
-> B.ByteString -- ^ cookie value
|
||||||
|
|||||||
@ -20,8 +20,7 @@ import Data.Convertible.Text
|
|||||||
import qualified Network.Wai as W
|
import qualified Network.Wai as W
|
||||||
import Yesod.Json
|
import Yesod.Json
|
||||||
import Yesod.Internal
|
import Yesod.Internal
|
||||||
import Web.ClientSession (getKey, defaultKeyFile)
|
import Web.ClientSession (getKey, defaultKeyFile, Key)
|
||||||
import Data.ByteString (ByteString)
|
|
||||||
|
|
||||||
import Web.Routes.Quasi (QuasiSite (..), Routes)
|
import Web.Routes.Quasi (QuasiSite (..), Routes)
|
||||||
|
|
||||||
@ -46,7 +45,7 @@ class Yesod a where
|
|||||||
approot :: a -> String
|
approot :: a -> String
|
||||||
|
|
||||||
-- | The encryption key to be used for encrypting client sessions.
|
-- | The encryption key to be used for encrypting client sessions.
|
||||||
encryptKey :: a -> IO ByteString
|
encryptKey :: a -> IO Key
|
||||||
encryptKey _ = getKey defaultKeyFile
|
encryptKey _ = getKey defaultKeyFile
|
||||||
|
|
||||||
-- | Number of minutes before a client session times out. Defaults to
|
-- | Number of minutes before a client session times out. Defaults to
|
||||||
|
|||||||
@ -45,7 +45,7 @@ library
|
|||||||
web-routes-quasi >= 0.2 && < 0.3,
|
web-routes-quasi >= 0.2 && < 0.3,
|
||||||
hamlet >= 0.2.2 && < 0.3,
|
hamlet >= 0.2.2 && < 0.3,
|
||||||
transformers >= 0.1 && < 0.3,
|
transformers >= 0.1 && < 0.3,
|
||||||
clientsession >= 0.3.0 && < 0.4,
|
clientsession >= 0.4.0 && < 0.5,
|
||||||
MonadCatchIO-transformers >= 0.2.2 && < 0.3,
|
MonadCatchIO-transformers >= 0.2.2 && < 0.3,
|
||||||
pureMD5 >= 1.1.0.0 && < 1.2,
|
pureMD5 >= 1.1.0.0 && < 1.2,
|
||||||
random >= 1.0.0.2 && < 1.1,
|
random >= 1.0.0.2 && < 1.1,
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user