Using cookie package

This commit is contained in:
Michael Snoyman 2010-12-21 00:07:33 +02:00
parent b50cbd440d
commit 48e8b1d9ca
3 changed files with 14 additions and 9 deletions

View File

@ -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"

View File

@ -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")

View File

@ -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