diff --git a/Yesod/Content.hs b/Yesod/Content.hs index e8fe59b0..10a83557 100644 --- a/Yesod/Content.hs +++ b/Yesod/Content.hs @@ -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" diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index 27847cfc..174c707b 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -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") diff --git a/yesod.cabal b/yesod.cabal index fdff1e9b..136a3083 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -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