Skip to content
Browse files

Set cache headers on media resources

  • Loading branch information...
1 parent 301c59b commit 04eeb6bb76eaa935252be9946a1732d9e65c10a3 @gregorycollins gregorycollins committed Sep 14, 2010
Showing with 20 additions and 2 deletions.
  1. +1 −0 snap-website.cabal
  2. +19 −2 src/Main.hs
View
1 snap-website.cabal
@@ -31,6 +31,7 @@ Executable snap-website
snap-server >= 0.2.12 && <0.3,
snap-static-pages >= 0.0.1 && <0.1,
text,
+ time,
transformers,
unix,
utf8-string,
View
21 src/Main.hs
@@ -10,6 +10,7 @@ import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Text as T
+import Data.Time.Clock.POSIX
import Data.Typeable
import Control.Applicative
import Control.Concurrent
@@ -18,6 +19,7 @@ import Control.Monad
import Control.Monad.CatchIO
import "monads-fd" Control.Monad.Trans
import "monads-fd" Control.Monad.Reader
+import Foreign.C.Types
import Prelude hiding (catch)
import Snap.Http.Server
import Snap.StaticPages
@@ -47,6 +49,12 @@ data SiteState = SiteState {
type Site a = ReaderT SiteState Snap a
+epochTime :: IO CTime
+epochTime = do
+ t <- getPOSIXTime
+ return $ fromInteger $ truncate t
+
+
initSiteState :: IO SiteState
initSiteState = do
setLocaleToUTF8
@@ -124,9 +132,18 @@ site ss =
, ("admin/reload", runReaderT reload ss)
, ("blog/", serveStaticPages (_blogState ss)) ] <|>
templateServe (_currentTs ss) <|>
- fileServe "static"
-
+ (setCache $ fileServe "static")
+ where
+ setCache act = do
+ pi <- liftM rqPathInfo getRequest
+ act
+ when ("media" `B.isPrefixOf` pi) $ do
+ expTime <- liftM (+604800) $ liftIO epochTime
+ s <- liftIO $ formatHttpTime expTime
+ modifyResponse $
+ setHeader "Cache-Control" "public, max-age=604800" .
+ setHeader "Expires" s
catch500 :: Snap a -> Snap ()
catch500 m = (m >> return ()) `catch` \(e::SomeException) -> do

0 comments on commit 04eeb6b

Please sign in to comment.
Something went wrong with that request. Please try again.