Using cookie package
This commit is contained in:
parent
b50cbd440d
commit
48e8b1d9ca
@ -45,7 +45,6 @@ module Yesod.Content
|
||||
-- * Utilities
|
||||
, formatW3
|
||||
, formatRFC1123
|
||||
, formatCookieExpires
|
||||
#if TEST
|
||||
, testSuite
|
||||
#endif
|
||||
@ -260,7 +259,3 @@ formatW3 = formatTime defaultTimeLocale "%FT%X-00:00"
|
||||
-- | Format as per RFC 1123.
|
||||
formatRFC1123 :: UTCTime -> String
|
||||
formatRFC1123 = formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
|
||||
|
||||
-- | Format a 'UTCTime' for a cookie.
|
||||
formatCookieExpires :: UTCTime -> String
|
||||
formatCookieExpires = formatTime defaultTimeLocale "%a, %d-%b-%Y %X GMT"
|
||||
|
||||
@ -52,6 +52,9 @@ import qualified Network.Wai.Handler.CGI as CGI
|
||||
import System.Environment (getEnvironment)
|
||||
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Blaze.ByteString.Builder (toLazyByteString)
|
||||
|
||||
import Control.Concurrent.MVar
|
||||
import Control.Arrow ((***))
|
||||
@ -63,6 +66,7 @@ import Data.Maybe
|
||||
import Web.ClientSession
|
||||
import qualified Web.ClientSession as CS
|
||||
import Data.Char (isUpper)
|
||||
import Web.Cookie (parseCookies, SetCookie (..), renderSetCookie)
|
||||
|
||||
import Data.Serialize
|
||||
import qualified Data.Serialize as Ser
|
||||
@ -447,10 +451,15 @@ headerToPair :: (Int -> UTCTime) -- ^ minutes -> expiration time
|
||||
-> Header
|
||||
-> (W.ResponseHeader, B.ByteString)
|
||||
headerToPair getExpires (AddCookie minutes key value) =
|
||||
let expires = getExpires minutes
|
||||
in ("Set-Cookie", charsToBs
|
||||
$ key ++ "=" ++ value ++"; path=/; expires="
|
||||
++ formatCookieExpires expires)
|
||||
("Set-Cookie", builderToBS $ renderSetCookie $ SetCookie
|
||||
{ setCookieName = B.pack key -- FIXME check for non-ASCII
|
||||
, setCookieValue = B.pack value -- FIXME check for non-ASCII
|
||||
, setCookiePath = Just "/" -- FIXME make a config option, or use approot?
|
||||
, setCookieExpires = Just $ getExpires minutes
|
||||
, setCookieDomain = Nothing
|
||||
})
|
||||
where
|
||||
builderToBS = S.concat . L.toChunks . toLazyByteString
|
||||
headerToPair _ (DeleteCookie key) =
|
||||
("Set-Cookie", charsToBs $
|
||||
key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
|
||||
|
||||
@ -56,6 +56,7 @@ library
|
||||
, containers >= 0.2 && < 0.5
|
||||
, monad-peel >= 0.1 && < 0.2
|
||||
, enumerator >= 0.4 && < 0.5
|
||||
, cookie >= 0.0 && < 0.1
|
||||
exposed-modules: Yesod
|
||||
Yesod.Content
|
||||
Yesod.Dispatch
|
||||
|
||||
Loading…
Reference in New Issue
Block a user