From 881fab7ff0075966385e3bcaa4994169e57121c3 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 13 Oct 2010 15:52:52 +0200
Subject: [PATCH] Cache-Control and Expires header function

---
 Yesod/Content.hs |  5 +++++
 Yesod/Handler.hs | 31 ++++++++++++++++++++++++++++++-
 2 files changed, 35 insertions(+), 1 deletion(-)

diff --git a/Yesod/Content.hs b/Yesod/Content.hs
index 48ffd145..75e22d0f 100644
--- a/Yesod/Content.hs
+++ b/Yesod/Content.hs
@@ -44,6 +44,7 @@ module Yesod.Content
     , RepXml (..)
       -- * Utilities
     , formatW3
+    , formatRFC1123
 #if TEST
     , testSuite
 #endif
@@ -252,3 +253,7 @@ caseTypeByExt = do
 -- | Format a 'UTCTime' in W3 format; useful for setting cookies.
 formatW3 :: UTCTime -> String
 formatW3 = formatTime defaultTimeLocale "%FT%X-00:00"
+
+-- | Format as per RFC 1123.
+formatRFC1123 :: UTCTime -> String
+formatRFC1123 = formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
index 5dcbace9..f460f2cd 100644
--- a/Yesod/Handler.hs
+++ b/Yesod/Handler.hs
@@ -51,6 +51,11 @@ module Yesod.Handler
     , deleteCookie
     , setHeader
     , setLanguage
+      -- ** Content caching and expiration
+    , cacheSeconds
+    , neverExpires
+    , alreadyExpired
+    , expiresAt
       -- * Session
     , setSession
     , deleteSession
@@ -75,6 +80,7 @@ import Yesod.Content
 import Yesod.Internal
 import Data.List (foldl')
 import Data.Neither
+import Data.Time (UTCTime)
 
 import Control.Exception hiding (Handler, catch)
 import qualified Control.Exception as E
@@ -383,10 +389,33 @@ deleteCookie = addHeader . DeleteCookie
 setLanguage :: String -> GHandler sub master ()
 setLanguage = setSession langKey
 
--- | Set an arbitrary header on the client.
+-- | Set an arbitrary response header.
 setHeader :: String -> String -> GHandler sub master ()
 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.
 --
 -- The session is handled by the clientsession package: it sets an encrypted