Cache-Control and Expires header function

This commit is contained in:
Michael Snoyman 2010-10-13 15:52:52 +02:00
parent d9ebdfca13
commit 881fab7ff0
2 changed files with 35 additions and 1 deletions

View File

@ -44,6 +44,7 @@ module Yesod.Content
, RepXml (..) , RepXml (..)
-- * Utilities -- * Utilities
, formatW3 , formatW3
, formatRFC1123
#if TEST #if TEST
, testSuite , testSuite
#endif #endif
@ -252,3 +253,7 @@ caseTypeByExt = do
-- | Format a 'UTCTime' in W3 format; useful for setting cookies. -- | Format a 'UTCTime' in W3 format; useful for setting cookies.
formatW3 :: UTCTime -> String formatW3 :: UTCTime -> String
formatW3 = formatTime defaultTimeLocale "%FT%X-00:00" formatW3 = formatTime defaultTimeLocale "%FT%X-00:00"
-- | Format as per RFC 1123.
formatRFC1123 :: UTCTime -> String
formatRFC1123 = formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"

View File

@ -51,6 +51,11 @@ module Yesod.Handler
, deleteCookie , deleteCookie
, setHeader , setHeader
, setLanguage , setLanguage
-- ** Content caching and expiration
, cacheSeconds
, neverExpires
, alreadyExpired
, expiresAt
-- * Session -- * Session
, setSession , setSession
, deleteSession , deleteSession
@ -75,6 +80,7 @@ import Yesod.Content
import Yesod.Internal import Yesod.Internal
import Data.List (foldl') import Data.List (foldl')
import Data.Neither import Data.Neither
import Data.Time (UTCTime)
import Control.Exception hiding (Handler, catch) import Control.Exception hiding (Handler, catch)
import qualified Control.Exception as E import qualified Control.Exception as E
@ -383,10 +389,33 @@ deleteCookie = addHeader . DeleteCookie
setLanguage :: String -> GHandler sub master () setLanguage :: String -> GHandler sub master ()
setLanguage = setSession langKey setLanguage = setSession langKey
-- | Set an arbitrary header on the client. -- | Set an arbitrary response header.
setHeader :: String -> String -> GHandler sub master () setHeader :: String -> String -> GHandler sub master ()
setHeader a = addHeader . Header a setHeader a = addHeader . Header a
-- | Set the Cache-Control header to indicate this response should be cached
-- for the given number of seconds.
cacheSeconds :: Int -> GHandler s m ()
cacheSeconds i = setHeader "Cache-Control" $ concat
[ "max-age="
, show i
, ", public"
]
-- | Set the Expires header to some date in 2037. In other words, this content
-- is never (realistically) expired.
neverExpires :: GHandler s m ()
neverExpires = setHeader "Expires" "Thu, 31 Dec 2037 23:55:55 GMT"
-- | Set an Expires header in the past, meaning this content should not be
-- cached.
alreadyExpired :: GHandler s m ()
alreadyExpired = setHeader "Expires" "Thu, 01 Jan 1970 05:05:05 GMT"
-- | Set an Expires header to the given date.
expiresAt :: UTCTime -> GHandler s m ()
expiresAt = setHeader "Expires" . formatRFC1123
-- | Set a variable in the user's session. -- | Set a variable in the user's session.
-- --
-- The session is handled by the clientsession package: it sets an encrypted -- The session is handled by the clientsession package: it sets an encrypted