2 kinds of static files- different cache headers

* Forever - for "static" assets with a hash paremeter
* ETag - for "public" assets without a hash parametes

Yesod/Helpers/Static.hs

@@ -27,11 +27,16 @@
 module Yesod.Helpers.Static
     ( -- * Subsite
       Static (..)
+    , Public (..)
     , StaticRoute (..)
+    , PublicRoute (..)
       -- * Smart constructor
     , static
+    , publicProduction
+    , publicDevel
       -- * Template Haskell helpers
     , staticFiles
+    , publicFiles
     {-
       -- * Embed files
     , getStaticHandler
@@ -44,6 +49,7 @@ module Yesod.Helpers.Static
     ) where
 
 import System.Directory
+import qualified System.Time
 import Control.Monad
 
 import Yesod.Handler
@@ -63,8 +69,11 @@ import Data.Text (Text, pack)
 import Data.Monoid (mempty)
 
 import Network.Wai.Application.Static
-    ( defaultMimeTypeByExt, StaticSettings (..), staticAppPieces
+    ( StaticSettings (..), CacheSettings (..)
-    , defaultListing
+    , defaultStaticSettings, defaultPublicSettings
+    , staticAppPieces
+    , pathFromPieces
+    , Pieces
     )
 
 #if TEST
@@ -73,15 +82,51 @@ import Test.Framework.Providers.HUnit
 import Test.HUnit hiding (Test)
 #endif
 
+-- | generally static assets referenced in html files
+-- assets get a checksum query parameter appended for perfect caching
+-- * a far future expire date is set
+-- * a given asset revision will only ever be downloaded once (if the browser maintains its cache)
+-- if you don't want to see a checksum in the url- use Public
 newtype Static = Static StaticSettings
+-- | same as Static, but there is no checksum query parameter appended
+-- generally html files and the favicon, but could be any file where you don't want the checksum parameter
+-- * the file checksum is used for an ETag.
+-- * this form of caching is not as good as the static- the browser can avoid downloading the file, but it always need to send a request with the etag value to the server to see if its copy is up to date
+newtype Public = Public StaticSettings
 
 -- | Default value of 'Static' for a given file folder.
 --
 -- Does not have index files, uses default directory listings and default mime
 -- type list.
-static :: FilePath -> Static
+static :: String -> FilePath -> IO Static
-static fp = Static $ StaticSettings fp [] (Just defaultListing)
+static root fp = do
-                     (return . defaultMimeTypeByExt)
+  hashes <- mkHashMap fp
+  return $ Static $ (defaultStaticSettings (Forever $ isStaticRequest hashes)) {
+    ssFolder = fp
+  , ssMkRedirect = \_ newPath -> S8.pack $ root ++ "/" ++ newPath
+  }
+  where
+    isStaticRequest hashes reqf reqh = case M.lookup reqf hashes of
+                               Nothing -> False
+                               Just h  -> h == reqh
+
+-- | no directory listing
+public :: String -> FilePath -> CacheSettings -> Public
+public root fp cache = Public $ (defaultPublicSettings cache) {
+    ssFolder = fp 
+  , ssMkRedirect = \_ newPath -> S8.pack $ root ++ "/" ++ newPath
+  }
+
+publicProduction :: String -> FilePath -> IO Public
+publicProduction root fp = do
+  etags <- mkPublicProductionEtag fp
+  return $ public root fp etags
+
+publicDevel :: String -> FilePath -> IO Public
+publicDevel root fp = do
+  etags <- mkPublicDevelEtag fp
+  return $ public root fp etags
+
 
 -- | Manually construct a static route.
 -- The first argument is a sub-path to the file being served whereas the second argument is the key value pairs in the query string.
@@ -92,16 +137,157 @@ static fp = Static $ StaticSettings fp [] (Just defaultListing)
 -- E.g. When generating image galleries.
 data StaticRoute = StaticRoute [Text] [(Text, Text)]
     deriving (Eq, Show, Read)
+data PublicRoute = PublicRoute [String] [(String, String)]
+    deriving (Eq, Show, Read)
 
 type instance Route Static = StaticRoute
+type instance Route Public = PublicRoute
 
 instance RenderRoute StaticRoute where
     renderRoute (StaticRoute x y) = (x, y)
+instance RenderRoute PublicRoute where
+    renderRoute (PublicRoute x y) = (x, y)
 
 instance Yesod master => YesodDispatch Static master where
     yesodDispatch (Static set) _ pieces  _ _ =
         Just $ staticAppPieces set pieces
 
+instance Yesod master => YesodDispatch Public master where
+    yesodDispatch (Public set) _ pieces  _ _ =
+        Just $ staticAppPieces set pieces
+
+notHidden :: FilePath -> Bool
+notHidden ('.':_) = False
+notHidden "tmp" = False
+notHidden _ = True
+
+getFileListPieces :: FilePath -> IO [[String]]
+getFileListPieces = flip go id
+  where
+    go :: String -> ([String] -> [String]) -> IO [[String]]
+    go fp front = do
+        allContents <- filter notHidden `fmap` getDirectoryContents fp
+        let fullPath :: String -> String
+            fullPath f = fp ++ '/' : f
+        files <- filterM (doesFileExist . fullPath) allContents
+        let files' = map (front . return) files
+        dirs <- filterM (doesDirectoryExist . fullPath) allContents
+        dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs
+        return $ concat $ files' : dirs'
+
+-- | This piece of Template Haskell will find all of the files in the given directory and create Haskell identifiers for them. For example, if you have the files \"static\/style.css\" and \"static\/js\/script.js\", it will essentailly create:
+--
+-- > style_css = StaticRoute ["style.css"] []
+-- > js_script_js = StaticRoute ["js/script.js"] []
+staticFiles :: FilePath -> Q [Dec]
+staticFiles dir = mkStaticFiles dir StaticSite
+
+publicFiles :: FilePath -> Q [Dec]
+publicFiles dir = mkStaticFiles dir PublicSite
+
+mkHashMap :: FilePath -> IO (M.Map FilePath S8.ByteString)
+mkHashMap dir = do
+    fs <- getFileListPieces dir
+    hashAlist fs >>= return . M.fromList
+  where
+    hashAlist :: [Pieces] -> IO [(FilePath, S8.ByteString)]
+    hashAlist fs = mapM hashPair fs
+      where
+        hashPair :: Pieces -> IO (FilePath, S8.ByteString)
+        hashPair pieces = do let file = pathFromPieces dir pieces
+                             h <- base64md5File file
+                             return (file, S8.pack h)
+
+mkPublicDevelEtag :: FilePath -> IO CacheSettings
+mkPublicDevelEtag dir = do
+    etags <- mkHashMap dir
+    mtimeVar <- newIORef (M.empty :: M.Map FilePath System.Time.ClockTime)
+    return $ ETag $ \f ->
+      case M.lookup f etags of
+        Nothing -> return Nothing
+        Just checksum -> do
+          newt <- getModificationTime f
+          mtimes <- readIORef mtimeVar
+          oldt <- case M.lookup f mtimes of
+            Nothing -> writeIORef mtimeVar (M.insert f newt mtimes) >> return newt
+            Just ot -> return ot
+          return $ if newt /= oldt then Nothing else Just checksum
+
+
+mkPublicProductionEtag :: FilePath -> IO CacheSettings
+mkPublicProductionEtag dir = do
+    etags <- mkHashMap dir
+    return $ ETag $ \f -> return . M.lookup f $ etags
+
+data StaticSite = StaticSite | PublicSite
+mkStaticFiles :: FilePath -> StaticSite -> Q [Dec]
+mkStaticFiles fp StaticSite = mkStaticFiles' fp "StaticRoute" True
+mkStaticFiles fp PublicSite = mkStaticFiles' fp "PublicRoute" False
+
+mkStaticFiles' :: FilePath -> -- ^ static directory
+                  String   -> -- ^ route constructor "StaticRoute"
+                  Bool     -> -- ^ append checksum query parameter
+                  Q [Dec]
+mkStaticFiles' fp routeConName makeHash = do
+    fs <- qRunIO $ getFileListPieces fp
+    concat `fmap` mapM mkRoute fs
+  where
+    replace' c
+        | 'A' <= c && c <= 'Z' = c
+        | 'a' <= c && c <= 'z' = c
+        | '0' <= c && c <= '9' = c
+        | otherwise = '_'
+    mkRoute f = do
+        let name = mkName $ intercalate "_" $ map (map replace') f
+        f' <- [|map pack $(lift f)|]
+        let route = mkName routeConName
+        pack' <- [|pack|]
+        qs <- if makeHash
+                    then do hash <- qRunIO $ base64md5File $ pathFromPieces fp f
+                            [|[(pack $(lift hash), mempty)]|]
+                    else return $ ListE []
+        return
+            [ SigD name $ ConT route
+            , FunD name
+                [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) []
+                ]
+            ]
+
+base64md5File :: FilePath -> IO String
+base64md5File file = do
+  contents <- L.readFile file
+  return $ base64md5 contents
+
+#if TEST
+
+testSuite :: Test
+testSuite = testGroup "Yesod.Helpers.Static"
+    [ testCase "get file list" caseGetFileList
+    ]
+
+caseGetFileList :: Assertion
+caseGetFileList = do
+    x <- getFileListPieces "test"
+    x @?= [["foo"], ["bar", "baz"]]
+
+#endif
+
+-- | md5-hashes the given lazy bytestring and returns the hash as
+-- base64url-encoded string.
+--
+-- This function returns the first 8 characters of the hash.
+base64md5 :: L.ByteString -> String
+base64md5 = map tr
+          . take 8
+          . S8.unpack
+          . Data.ByteString.Base64.encode
+          . Data.Serialize.encode
+          . md5
+  where
+    tr '+' = '-'
+    tr '/' = '_'
+    tr c   = c
+
 {- FIXME
 -- | Dispatch static route for a subsite
 --
@@ -124,83 +310,3 @@ getStaticHandler static toSubR pieces = do
         handler = fromMaybe notFound $ handleSite staticSite undefined route "GET"
 -}
 
-notHidden :: FilePath -> Bool
-notHidden ('.':_) = False
-notHidden "tmp" = False
-notHidden _ = True
-
-getFileList :: FilePath -> IO [[String]]
-getFileList = flip go id
-  where
-    go :: String -> ([String] -> [String]) -> IO [[String]]
-    go fp front = do
-        allContents <- filter notHidden `fmap` getDirectoryContents fp
-        let fullPath :: String -> String
-            fullPath f = fp ++ '/' : f
-        files <- filterM (doesFileExist . fullPath) allContents
-        let files' = map (front . return) files
-        dirs <- filterM (doesDirectoryExist . fullPath) allContents
-        dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs
-        return $ concat $ files' : dirs'
-
--- | This piece of Template Haskell will find all of the files in the given directory and create Haskell identifiers for them. For example, if you have the files \"static\/style.css\" and \"static\/js\/script.js\", it will essentailly create:
---
--- > style_css = StaticRoute ["style.css"] []
--- > js_script_js = StaticRoute ["js/script.js"] []
-staticFiles :: FilePath -> Q [Dec]
-staticFiles fp = do
-    fs <- qRunIO $ getFileList fp
-    concat `fmap` mapM go fs
-  where
-    replace' c
-        | 'A' <= c && c <= 'Z' = c
-        | 'a' <= c && c <= 'z' = c
-        | '0' <= c && c <= '9' = c
-        | otherwise = '_'
-    go f = do
-        let adjust [] = ""
-            adjust str@(x:xs) | isDigit x = '_' : x : xs
-                              | isUpper x = toLower x : xs
-                              | otherwise = str
-        let name = mkName $ intercalate "_" $ map (adjust . map replace') f
-        f' <- [|map pack $(lift f)|]
-        let sr = ConE $ mkName "StaticRoute"
-        hash <- qRunIO $ fmap base64md5 $ L.readFile $ fp ++ '/' : intercalate "/" f
-        pack' <- [|pack|]
-        qs <- [|[(pack $(lift hash), mempty)]|]
-        return
-            [ SigD name $ ConT ''Route `AppT` ConT ''Static
-            , FunD name
-                [ Clause [] (NormalB $ sr `AppE` f' `AppE` qs) []
-                ]
-            ]
-
-#if TEST
-
-testSuite :: Test
-testSuite = testGroup "Yesod.Helpers.Static"
-    [ testCase "get file list" caseGetFileList
-    ]
-
-caseGetFileList :: Assertion
-caseGetFileList = do
-    x <- getFileList "test"
-    x @?= [["foo"], ["bar", "baz"]]
-
-#endif
-
--- | md5-hashes the given lazy bytestring and returns the hash as
--- base64url-encoded string.
---
--- This function returns the first 8 characters of the hash.
-base64md5 :: L.ByteString -> String
-base64md5 = map go
-          . take 8
-          . S8.unpack
-          . Data.ByteString.Base64.encode
-          . Data.Serialize.encode
-          . md5
-  where
-    go '+' = '-'
-    go '/' = '_'
-    go c   = c

yesod-static.cabal

@@ -1,5 +1,9 @@
 name:            yesod-static
+<<<<<<< HEAD
 version:         0.1.0
+=======
+version:         0.1.0.0
+>>>>>>> update caching interface
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>